71 lines
1.6 KiB
Haskell
71 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(..), URL(..))
|
|
|
|
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 -> \BuukaEntry{url=URL u} -> x `T.isPrefixOf` u
|
|
EndsWith Url x -> \BuukaEntry{url=URL u} -> x `T.isSuffixOf` u
|
|
StartsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `T.isPrefixOf`) t
|
|
EndsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `T.isSuffixOf`) t
|
|
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
|