Query with regexes
This commit is contained in:
parent
527cc0a34c
commit
cee5ad8add
15
app/Main.hs
15
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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
23
src/Operations/Query.hs
Normal file
23
src/Operations/Query.hs
Normal 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)
|
||||
|
Loading…
Reference in New Issue
Block a user