From cee5ad8addbae0b38de754808daf16409a939718 Mon Sep 17 00:00:00 2001
From: Mats Rauhala <mats.rauhala@iki.fi>
Date: Sun, 3 Jan 2021 00:39:44 +0200
Subject: [PATCH] Query with regexes

---
 app/Main.hs             | 15 +++++++++++++--
 buuka.cabal             |  3 ++-
 src/Data/Query.hs       | 10 +++++++++-
 src/Operations.hs       |  3 +++
 src/Operations/Query.hs | 23 +++++++++++++++++++++++
 5 files changed, 50 insertions(+), 4 deletions(-)
 create mode 100644 src/Operations/Query.hs

diff --git a/app/Main.hs b/app/Main.hs
index 0a27393..d9c2016 100644
--- a/app/Main.hs
+++ b/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
diff --git a/buuka.cabal b/buuka.cabal
index 9657d69..8b64432 100644
--- a/buuka.cabal
+++ b/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
diff --git a/src/Data/Query.hs b/src/Data/Query.hs
index 747e47c..138ed12 100644
--- a/src/Data/Query.hs
+++ b/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
diff --git a/src/Operations.hs b/src/Operations.hs
index e026181..c0ed6d6 100644
--- a/src/Operations.hs
+++ b/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)
diff --git a/src/Operations/Query.hs b/src/Operations/Query.hs
new file mode 100644
index 0000000..0ed3a5e
--- /dev/null
+++ b/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)
+