buuka/src/Data/Query.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
module Data.Query
  (
    -- * AST
    Field(..)

    -- * Combinators
  , startsWith
  , endsWith
  , regex
  , (.&&.)

    -- * Evaluating queries
  , evaluate
  , predicate
  )
  where

import Data.Buuka
       (BuukaEntry(..), URL(..))

import Data.List
       (isPrefixOf, isSuffixOf)

import Text.Regex.TDFA
       ((=~))

import Data.Functor.Foldable
       (Fix(..), cata)

data Field a where
  Url :: Field String
  Title :: Field String

data QueryF f where
  StartsWith :: Field String -> String -> QueryF f
  EndsWith :: Field String -> String -> QueryF f
  Regex :: Field String -> String -> QueryF f
  And :: f -> f -> QueryF f

deriving instance Functor QueryF

type Query = Fix QueryF

startsWith :: Field String -> String -> Query
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)

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
  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