73 lines
1.6 KiB
Haskell
73 lines
1.6 KiB
Haskell
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
module Data.Query
|
|
(
|
|
-- * AST
|
|
Field(..)
|
|
|
|
-- * Combinators
|
|
, startsWith
|
|
, endsWith
|
|
, regex
|
|
, (.&&.)
|
|
|
|
-- * Evaluating queries
|
|
, evaluate
|
|
, predicate
|
|
)
|
|
where
|
|
|
|
import Data.Buuka
|
|
(BuukaEntry, title, url, _URL)
|
|
|
|
import Control.Lens
|
|
|
|
import Text.Regex.TDFA
|
|
((=~))
|
|
|
|
import Data.Functor.Foldable
|
|
(Fix(..), cata)
|
|
|
|
import Data.Text
|
|
(Text)
|
|
import qualified Data.Text as T
|
|
|
|
data Field a where
|
|
Url :: Field Text
|
|
Title :: Field Text
|
|
|
|
data QueryF f where
|
|
StartsWith :: Field Text -> Text -> QueryF f
|
|
EndsWith :: Field Text -> Text -> QueryF f
|
|
Regex :: Field Text -> Text -> QueryF f
|
|
And :: f -> f -> QueryF f
|
|
|
|
deriving instance Functor QueryF
|
|
|
|
type Query = Fix QueryF
|
|
|
|
startsWith :: Field Text -> Text -> Query
|
|
startsWith field x = Fix (StartsWith field x)
|
|
|
|
endsWith :: Field Text -> Text -> Query
|
|
endsWith field x = Fix (EndsWith field x)
|
|
|
|
regex :: Field Text -> Text -> Query
|
|
regex field x = Fix (Regex field x)
|
|
|
|
(.&&.) :: Query -> Query -> Query
|
|
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
|
|
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
|
|
|
|
predicate :: Query -> BuukaEntry -> Bool
|
|
predicate = cata evaluate
|