56 lines
1.2 KiB
Haskell
56 lines
1.2 KiB
Haskell
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
module Data.Query
|
|
(
|
|
-- * AST
|
|
Field(..)
|
|
|
|
-- * Combinators
|
|
, startsWith
|
|
, endsWith
|
|
, (.&&.)
|
|
|
|
-- * Evaluating queries
|
|
, evaluate
|
|
)
|
|
where
|
|
|
|
import Data.Buuka
|
|
(BuukaEntry(..), URL(..))
|
|
|
|
import Data.List
|
|
(isPrefixOf, isSuffixOf)
|
|
|
|
import Data.Functor.Foldable
|
|
(Fix(..))
|
|
|
|
data Field a where
|
|
Url :: Field String
|
|
Title :: Field String
|
|
|
|
data QueryF f where
|
|
StartsWith :: Field a -> a -> QueryF f
|
|
EndsWith :: Field a -> a -> QueryF f
|
|
And :: f -> f -> QueryF f
|
|
|
|
deriving instance Functor QueryF
|
|
|
|
type Query = Fix QueryF
|
|
|
|
startsWith :: Field a -> a -> Query
|
|
startsWith field x = Fix (StartsWith field x)
|
|
|
|
endsWith :: Field a -> a -> Query
|
|
endsWith field x = Fix (EndsWith 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 `isPrefixOf` u
|
|
EndsWith Url x -> \BuukaEntry{url=URL u} -> x `isSuffixOf` u
|
|
StartsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `isPrefixOf`) t
|
|
EndsWith Title x -> \BuukaEntry{title=t} -> maybe False (x `isSuffixOf`) t
|
|
And a b -> \e -> a e && b e
|