Query with regexes

app/Main.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 module Main where
 
 import Options.Applicative
@@ -10,17 +11,27 @@ import Data.Environment
 import UnliftIO.Directory
        (XdgDirectory(XdgData), getXdgDirectory)
 
+import Data.Foldable
+       (asum)
+
 import qualified Operations
 
+import Data.Query
+       (Field(..))
+
 commands :: Parser (BuukaM ())
 commands = subparser
-  (  command "insert" (info (insertOpts Operations.insert) (progDesc "Insert a new bookmark"))
-  <> command "list" (info (pure Operations.list) (progDesc "List all the bookmarks"))
+  (  command "insert" (info (insertOpts Operations.insert <**> helper) (progDesc "Insert a new bookmark"))
+  <> command "list" (info (pure Operations.list <**> helper) (progDesc "List all the bookmarks"))
+  <> command "query" (info (queryOpts Operations.query <**> helper) (progDesc "Query the bookmarks"))
   )
   where
     insertOpts f =
         f <$> strOption (long "url" <> short 'u' <> metavar "URL")
           <*> optional (strOption (long "title"))
+    queryOpts f =
+      uncurry f <$> asum [tagged Title "title", tagged Url "url"]
+    tagged t x = (t, ) <$> strOption (long x <> metavar "REGEX")
 
 main :: IO ()
 main = do

buuka.cabal

@@ -36,9 +36,10 @@ library
   exposed-modules:     MyLib
                      , Database.Migrations
                      , Control.Monad.Buuka
+                     , Operations.Format
                      , Operations.Insert
                      , Operations.List
-                     , Operations.Format
+                     , Operations.Query
                      , Operations
                      , Data.Environment
                      , Data.Buuka

src/Data/Query.hs

@@ -8,10 +8,12 @@ module Data.Query
     -- * Combinators
   , startsWith
   , endsWith
+  , regex
   , (.&&.)
 
     -- * Evaluating queries
   , evaluate
+  , predicate
   )
   where
 
@@ -25,7 +27,7 @@ import Text.Regex.TDFA
        ((=~))
 
 import Data.Functor.Foldable
-       (Fix(..))
+       (Fix(..), cata)
 
 data Field a where
   Url :: Field String
@@ -47,6 +49,9 @@ startsWith field x = Fix (StartsWith field x)
 endsWith :: Field String -> String -> Query
 endsWith field x = Fix (EndsWith field x)
 
+regex :: Field String -> String -> Query
+regex field x = Fix (Regex field x)
+
 (.&&.) :: Query -> Query -> Query
 a .&&. b = Fix (And a b)
 
@@ -59,3 +64,6 @@ evaluate = \case
   Regex Url x -> \BuukaEntry{url=URL u} -> u =~ x
   Regex Title x -> \BuukaEntry{title=t} -> maybe False (=~ x) t
   And a b -> \e -> a e && b e
+
+predicate :: Query -> BuukaEntry -> Bool
+predicate = cata evaluate

src/Operations.hs

@@ -1,6 +1,7 @@
 module Operations
   ( module Operations.Insert
   , module Operations.List
+  , module Operations.Query
   )
   where
 
@@ -8,3 +9,5 @@ import Operations.Insert
        (insert)
 import Operations.List
        (list)
+import Operations.Query
+       (query)

src/Operations/Query.hs

@@ -0,0 +1,23 @@
+module Operations.Query where
+
+import Data.Query
+
+import Control.Monad.Buuka
+import Control.Monad.Reader
+
+import Data.Foldable
+       (traverse_)
+
+import Data.Buuka
+       (Buuka)
+import qualified Data.Buuka as B
+
+import Operations.Format
+
+query :: Field String -> String -> BuukaM ()
+query field q =
+  buukaQ (asks go) >>= traverse_ (liftIO . putStrLn)
+  where
+    go :: Buuka -> [String]
+    go b = formatEntries b (filter (predicate (regex field q)) . B.elements $ b)
+