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