Initial query AST

src/Data/Functor/Foldable.hs

@@ -0,0 +1,36 @@
+{-|
+Module      : Data.Functor.Foldable
+Description : Simplified recursion schemes
+Copyright   : (c) Mats Rauhala, 2020
+License     : BSD-3-Clause
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+Simplified recursion schemes, providing only the minimal schemes
+-}
+module Data.Functor.Foldable
+  ( Fix(..)
+  , cata
+  , ana
+  , hylo
+  )
+  where
+
+newtype Fix f = Fix { getFix :: f (Fix f) }
+
+-- | Catamorphism or the fold
+--
+-- Fold a recursive structure into a value
+cata :: Functor f => (f a -> a) -> Fix f -> a
+cata f = a where a = f . fmap a . getFix
+
+-- | Anamorphism or the unfold
+--
+-- Unfold a seed into a recursive structure
+ana :: Functor f => (a -> f a) -> a -> Fix f
+ana f = a where a = Fix . fmap a . f
+
+-- | Combined fold and unfold
+hylo :: (Functor f) => (f a -> a) -> (b -> f b) -> b -> a
+hylo f u = a where a = f . fmap a . u

src/Data/Query.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+module Data.Query
+  (
+    -- * 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
+  = forall a. StartsWith (Field a) a
+  | forall a. EndsWith (Field a) a
+  | And f 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