module Filter where

-- | F(ilter) a, the Filter algebra
-- Literal := in | eq | lt | gt | false | true
-- Term t   := Literal | And t t | Or t t | Not t
data F a
  -- Expression literals
  = InF [a]
  | EqF a
  | GtF a
  | LtF a
  | FFalse
  | FTrue

  -- Expression trees
  | AndF (F a) (F a)
  | OrF (F a) (F a)
  | NotF (F a)
  deriving Show

instance Functor F where
  fmap f (InF xs) = InF (fmap f xs)
  fmap f (EqF x) = EqF (f x)
  fmap f (GtF x) = GtF (f x)
  fmap f (LtF x) = LtF (f x)
  fmap _ FFalse = FFalse
  fmap _ FTrue = FTrue
  fmap f (AndF x1 x2) = AndF (fmap f x1) (fmap f x2)
  fmap f (OrF x1 x2) = OrF (fmap f x1) (fmap f x2)
  fmap f (NotF x) = NotF (fmap f x)

-- | Laws
-- 1. (<||>, 0) form a Monoid
-- 2. (<&&>) forms a Semigroup
-- 3. (x <&&> y) <&&> z = x <&&> (y <&&> z) , associative <&&>
-- 4. (x <|> y) <&&> z = (x <&&> z) <||> (y <&&> z) , <||> distributes over <&&>
-- 5. zero <&&> x = zero
class Semiring a where
  zero :: a               -- zero, 0
  one  :: a               -- one,  1
  (<||>)  :: a -> a -> a  -- sum,     (+)
  (<&&>)  :: a -> a -> a  -- product, (*)

instance Semiring (F a) where
  zero = FFalse
  one  = FTrue
  (<||>) = OrF
  (<&&>) = AndF

-- |
-- pure evaluator for Filter language
--   could `compile` filters to other languages,
--   e.g., SQL filters in WHERE clause
eval :: (Ord a, Eq a) => F a -> (a -> Bool)
eval (InF x) = (`elem` x)
eval (EqF x) = (== x)
eval (GtF x) = (> x)
eval (LtF x) = (< x)
eval FFalse = const False
eval FTrue = const True
eval (NotF x) = not . eval x
eval (AndF l r) = \x -> eval l x && eval r x
eval (OrF l r) = \x -> eval l x || eval r x

-- this compiles; give it a try!
test :: IO ()
test = print . filter (eval cond) $ xs
  where cond = (InF [30..40] <||> InF [1..10] <||> zero)
          <&&> fmap (+1) (GtF 33)
          <&&> LtF 38
          <&&> NotF (EqF 35)
          <&&> one
        xs = [1..100] :: [Int]