Bump versions and multiple queries

src/Data/Buuka.hs

@@ -30,7 +30,7 @@ import Data.Hashable
 import GHC.Generics
        (Generic)
 
-import Data.Text
+import Data.Text (Text)
 
 import Control.Monad.Reader
 import Control.Monad.State
@@ -51,7 +51,16 @@ data BuukaEntry
                , _title :: Maybe Text
                }
   deriving stock (Show, Eq, Generic)
-  deriving anyclass (ToJSON, FromJSON, Hashable)
+  deriving anyclass (Hashable)
+
+opts :: Options
+opts = defaultOptions { fieldLabelModifier = dropWhile (== '_'), omitNothingFields = True }
+
+instance ToJSON BuukaEntry where
+  toJSON = genericToJSON opts
+
+instance FromJSON BuukaEntry where
+  parseJSON = genericParseJSON opts
 
 makeLenses ''BuukaEntry
 

src/Data/Query.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 module Data.Query
   (
     -- * AST
@@ -41,11 +43,20 @@ data QueryF f where
   EndsWith :: Field Text -> Text -> QueryF f
   Regex :: Field Text -> Text -> QueryF f
   And :: f -> f -> QueryF f
+  Pass :: QueryF f
 
 deriving instance Functor QueryF
 
 type Query = Fix QueryF
 
+-- Query is a semigroup over the &&
+instance Semigroup Query where
+  (<>) = (.&&.)
+
+-- Identity is the constant true
+instance Monoid Query where
+  mempty = Fix Pass
+
 startsWith :: Field Text -> Text -> Query
 startsWith field x = Fix (StartsWith field x)
 
@@ -60,13 +71,18 @@ a .&&. b = Fix (And a b)
 
 evaluate :: QueryF (BuukaEntry -> Bool) -> (BuukaEntry -> Bool)
 evaluate = \case
-  StartsWith Url x -> \e -> x `T.isPrefixOf` (e ^. url . _URL)
-  EndsWith Url x -> \e -> x `T.isSuffixOf` (e ^. url . _URL)
-  StartsWith Title x -> \e -> maybe False (x `T.isPrefixOf`) $ e ^. title
-  EndsWith Title x -> \e -> maybe False (x `T.isSuffixOf`) $ e ^. title
+  StartsWith Url x -> has (url . _URL . prefixed x)
+  EndsWith Url x -> has (url . _URL . suffixed x)
+  StartsWith Title x -> has (title . _Just . prefixed x)
+  EndsWith Title x -> has (title . _Just . suffixed x)
   Regex Url x -> \e -> (e ^. url . _URL) =~ x
   Regex Title x -> \e -> maybe False (=~ x) $ e ^. title
   And a b -> \e -> a e && b e
+  Pass -> const True
+  where
+    prefixed ps = prism' (ps <>) (T.stripPrefix ps)
+    suffixed qs = prism' (<> qs) (T.stripSuffix qs)
 
 predicate :: Query -> BuukaEntry -> Bool
 predicate = cata evaluate
+

src/Operations/Import/Firefox.hs

@@ -79,7 +79,7 @@ newtype ImportException
 
 data Firefox
   = Firefox { _url :: Text
-            , _title :: Text
+            , _title :: Maybe Text
             , _keywords :: [Text]
             }
   deriving stock (Show, Eq)
@@ -124,9 +124,9 @@ importFirefox = do
   -- exist in the set, will it be inserted to the store
   buukaU $ modify $ \oldState -> F.foldl' update (initialState oldState) fs ^. buuka
   where
-    toEntry Firefox{..} = B.BuukaEntry{ B._url = B.URL _url, B._title = Just _title }
+    toEntry Firefox{..} = B.BuukaEntry{ B._url = B.URL _url, B._title = _title }
     update acc f = acc
       & seen <>~ (f ^. url . to S.singleton)
-      & if has (seen . ix (f ^. url)) acc then id else buuka %~ (B.insert (toEntry f))
+      & if has (seen . ix (f ^. url)) acc then id else buuka %~ B.insert (toEntry f)
     initialState oldState = Update oldState (initialUrls oldState)
     initialUrls = foldMapOf (B._Buuka . folded . B.url . B._URL) S.singleton

src/Operations/Query.hs

@@ -17,11 +17,13 @@ import Operations.Format
 import Data.Text
        (Text)
 import qualified Data.Text.IO as T
+import Data.List.NonEmpty (NonEmpty)
 
-query :: Field Text -> Text -> BuukaM ()
-query field q =
+query :: NonEmpty (Field Text, Text) -> BuukaM ()
+query qs =
   buukaQ (asks go) >>= traverse_ (liftIO . T.putStrLn)
   where
+    q = foldMap (uncurry regex) qs
     go :: Buuka -> [Text]
-    go b = formatEntries b (filter (predicate (regex field q)) . B.elements $ b)
+    go b = formatEntries b (filter (predicate q) . B.elements $ b)