Query with regexes

This commit is contained in:
Mats Rauhala 2021-01-03 00:39:44 +02:00
parent 527cc0a34c
commit cee5ad8add
5 changed files with 50 additions and 4 deletions

View File

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

View File

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

View File

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

View File

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

23
src/Operations/Query.hs Normal file
View File

@ -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)