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