module Language.Google.Search.Simple where
import Prelude
import Control.Monad.Free
import Data.Char (isSpace)
import Data.Monoid
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as B
instance (Functor f, IsString a) => IsString (Free f a) where
fromString = return . fromString
data Duration = Days | Months | Years deriving (Show)
data Size = Bytes | KBytes | MBytes deriving (Show)
data PrecBuilder = PrecBuilder Int Builder deriving (Show)
parentheses :: Int ->
((PrecBuilder -> Builder) -> Builder) -> PrecBuilder
parentheses outer f = PrecBuilder outer . f $ \ (PrecBuilder inner e) ->
if outer > inner then "(" <> e <> ")" else e
class SearchBuilder e where
searchBuilder :: e -> PrecBuilder
class SyntaxBuilder f where
syntaxBuilder :: f PrecBuilder -> PrecBuilder
instance (Functor f, SearchBuilder a, SyntaxBuilder f) =>
SearchBuilder (Free f a) where
searchBuilder = iter syntaxBuilder . fmap searchBuilder
infixr 2 \/
class DisjunctF f where disjunctF :: e -> e -> f e
class Disjunct e where (\/) :: e -> e -> e
instance (DisjunctF f) => Disjunct (Free f a) where
a \/ b = Free (disjunctF a b)
infixr 3 /\
class ConjunctF f where conjunctF :: e -> e -> f e
class Conjunct e where (/\) :: e -> e -> e
instance (ConjunctF f) => Conjunct (Free f a) where
a /\ b = Free (conjunctF a b)
class ComplementF f where complementF :: e -> f e
class Complement e where notB :: e -> e
instance (ComplementF f) => Complement (Free f a) where
notB = Free . complementF
andB :: (Conjunct e) => [e] -> e
andB = foldr1 (/\)
orB :: (Disjunct e) => [e] -> e
orB = foldr1 (\/)
data Term t = Fuzzy t | Exact t deriving (Functor, Show)
instance (IsString t) => IsString (Term t) where fromString = Fuzzy . fromString
instance SearchBuilder Text where
searchBuilder t = PrecBuilder prec (B.fromText t) where
prec = if T.any isSpace t then 2 else 11
instance SyntaxBuilder Term where
syntaxBuilder term = case term of
Fuzzy e -> e
Exact (PrecBuilder _ e) -> PrecBuilder 11 $ "\"" <> e <> "\""
instance (SearchBuilder a) => SearchBuilder (Term a) where
searchBuilder = syntaxBuilder . fmap searchBuilder
infixr 3 `AndB`
infixr 2 `OrB`
data BooleanF e = NotB e | e `AndB` e | e `OrB` e deriving (Functor, Show)
instance ConjunctF BooleanF where conjunctF = AndB
instance DisjunctF BooleanF where disjunctF = OrB
instance ComplementF BooleanF where complementF = NotB
instance SyntaxBuilder BooleanF where
syntaxBuilder bool = case bool of
NotB e -> parentheses 10 $ \ p -> "-" <> p e
a `AndB` b -> parentheses 2 $ \ p -> p a <> " " <> p b
a `OrB` b -> parentheses 3 $ \ p -> p a <> " OR " <> p b
type BooleanM = Free BooleanF
type Simple = BooleanM (Term Text)