google-search 0.0.1.0 → 0.1.0.0

raw patch · 3 files changed

+135/−66 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• google-search.cabal +1/−1
• src/Language/Google/Search/Mail.hs +30/−23
• src/Language/Google/Search/Simple.hs +104/−42

@@ -1,5 +1,5 @@ name:           google-search-version:        0.0.1.0+version:        0.1.0.0 synopsis:       EDSL for Google and GMail search expressions description:   Construct well-typed search expressions for use in various Google services.

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-}  -- | <https://support.google.com/mail/answer/7190>@@ -100,12 +99,12 @@  instance SearchBuilder MailOp where     searchBuilder operator = case operator of-        Plain s         -> searchBuilder s-        From s          -> "from:"          <> searchBuilder s-        To s            -> "to:"            <> searchBuilder s-        Subject s       -> "subject:"       <> searchBuilder s-        Label t         -> "label:"         <> B.fromText t-        Has ft          -> "has:"           <> case ft of+        Plain s         -> searchBuilder    s+        From s          -> "from:"          <>? s+        To s            -> "to:"            <>? s+        Subject s       -> "subject:"       <>? s+        Label t         -> "label:"         <>! B.fromText t+        Has ft          -> "has:"           <>! case ft of             Attachment      -> "attachment"             BlueInfo        -> "blue-info"             BlueStar        -> "blue-star"@@ -122,38 +121,46 @@             UserLabels      -> "userlabels"             YellowBang      -> "yellow-bang"             YellowStar      -> "yellow-star"-        List s          -> "list:"          <> searchBuilder s-        Filename s      -> "filename:"      <> searchBuilder s-        In l            -> "in:"            <> case l of+        List s          -> "list:"          <>? s+        Filename s      -> "filename:"      <>? s+        In l            -> "in:"            <>! case l of             Anywhere        -> "anywhere"             Inbox           -> "inbox"             Trash           -> "trash"             Spam            -> "spam"-        Is s            -> "is:"            <> case s of+        Is s            -> "is:"            <>! case s of             Important       -> "important"             Starred         -> "starred"             Unread          -> "unread"             Read            -> "read"             Chat            -> "chat"-        Cc s            -> "cc:"            <> searchBuilder s-        Bcc s           -> "bcc:"           <> searchBuilder s-        After d         -> "after:"         <> date d-        Before d        -> "before:"        <> date d-        Older n d       -> "older_than:"    <> duration n d-        Newer n d       -> "newer_than:"    <> duration n d-        DeliveredTo s   -> "deliveredto:"   <> searchBuilder s-        FromCircle s    -> "circle:"        <> searchBuilder s-        Category c      -> "category:"      <> case c of+        Cc s            -> "cc:"            <>? s+        Bcc s           -> "bcc:"           <>? s+        After d         -> "after:"         <>! date d+        Before d        -> "before:"        <>! date d+        Older n d       -> "older_than:"    <>! duration n d+        Newer n d       -> "newer_than:"    <>! duration n d+        DeliveredTo s   -> "deliveredto:"   <>? s+        FromCircle s    -> "circle:"        <>? s+        Category c      -> "category:"      <>! case c of             Forums          -> "forums"             Personal        -> "personal"             Promotions      -> "promotions"             Social          -> "social"             Updates         -> "updates"-        Larger n u      -> "larger:"        <> size n u-        Smaller n u     -> "smaller:"       <> size n u-        RFC822MsgId t   -> "rfc822msgid:"   <> B.fromText t+        Larger n u      -> "larger:"        <>! size n u+        Smaller n u     -> "smaller:"       <>! size n u+        RFC822MsgId t   -> "rfc822msgid:"   <>! B.fromText t        where+        infix 6 <>?, <>!++        (<>?) :: (SearchBuilder e) => Builder -> e -> PrecBuilder+        name <>? arg = parentheses 10 $ \ p -> name <> p (searchBuilder arg)++        (<>!) :: Builder -> Builder -> PrecBuilder+        name <>! arg = PrecBuilder 10 (name <> arg)+         date :: Day -> Builder         date = B.fromString . formatTime defaultTimeLocale "%Y/%m/%d" 

@@ -1,15 +1,20 @@ {-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | An orphan lives in this module,+--+-- @+-- instance ('Functor' f, 'IsString' a) => 'IsString' ('Free' f a)+-- @+--+-- so that we can write @\"simple queries\" :: 'Simple'@.+ module Language.Google.Search.Simple where  import Prelude import Control.Monad.Free import Data.Char (isSpace)-import Data.Foldable (fold)-import Data.List (intersperse) import Data.Monoid import Data.String (IsString (..)) import Data.Text (Text)@@ -17,68 +22,125 @@ 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++------------------------------------------------------------------------ -- * Units  data Duration = Days | Months | Years deriving (Show) data Size = Bytes | KBytes | MBytes deriving (Show) +------------------------------------------------------------------------+-- * Search expression construction++-- | 'Builder' with precedence, though ambiguous associativity.+-- (But that's okay because Google doesn't mind which way you lean.)+--+-- Note that at Google @OR@ binds tighter than conjunction, which is flipped+-- in contrast to everywhere else. We take the analogous Haskell fixities+-- when building search expressions:+--+-- * 11: atomic tokens or parenthesised expressions+--+-- * 10: complementation, search operators (cf. Haskell prefix application)+--+-- * 3: disjunction (@OR@ or @|@)+--+-- * 2: conjunction (by juxtaposition)+data PrecBuilder = PrecBuilder Int Builder deriving (Show)++-- | Give me the precedence of the piece of syntax you're building, and I'll+-- give you a function that parenthesise any sub-expressions when necessary.+parentheses :: Int ->+    ((PrecBuilder -> Builder) -> Builder) -> PrecBuilder+parentheses outer f = PrecBuilder outer . f $ \ (PrecBuilder inner e) ->+    if outer > inner then "(" <> e <> ")" else e+ -- | Render a search expression using Google search syntax. class SearchBuilder e where-    searchBuilder :: e -> Builder+    searchBuilder :: e -> PrecBuilder +-- | Higher-order version of 'SearchBuilder'.+class SyntaxBuilder f where+    syntaxBuilder :: f PrecBuilder -> PrecBuilder+ -- | 'SearchBuilder' for 'Free'!-instance (Functor f, SearchBuilder a, SearchBuilder (f Builder)) =>+instance (Functor f, SearchBuilder a, SyntaxBuilder f) =>         SearchBuilder (Free f a) where-    searchBuilder = iter searchBuilder . fmap searchBuilder+    searchBuilder = iter syntaxBuilder . fmap searchBuilder  ------------------------------------------------------------------------+-- * Generalised Boolean operators++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' is to '/\' what 'and' is to '&&'.+andB :: (Conjunct e) => [e] -> e+andB = foldr1 (/\)++-- | 'orB' is to '\/' what 'or' is to '||'.+orB :: (Conjunct e) => [e] -> e+orB = foldr1 (/\)++------------------------------------------------------------------------ -- * Primitive Terms  -- | 'Fuzzy' terms are grouped with parentheses (if necessary), while -- 'Exact' terms are always “double-quoted”. The 'IsString' instance--- defaults to 'Fuzzy', so a @\"literal string\" ∷ 'Term'@ may be used.-data Term = Fuzzy Text | Exact Text deriving (Show)-instance IsString Term where fromString = Fuzzy . T.pack+-- defaults to 'Fuzzy', so just writing @\"literal string\" ∷ 'Term' 'Text'@+-- is acceptable.+data Term t = Fuzzy t | Exact t deriving (Functor, Show)+instance (IsString t) => IsString (Term t) where fromString = Fuzzy . fromString -instance SearchBuilder Term where-    searchBuilder term = case term of-        Fuzzy s -> ($ B.fromText s) $-            if T.any isSpace s then ("(" <>) . (<> ")") else id-        Exact s -> ($ B.fromText s) $-            (B.singleton '"' <>) . (<> B.singleton '"')+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+ ------------------------------------------------------------------------+-- * Boolean expressions  -- | The shape of Boolean expressions.-data BooleanF e = Not e | And [e] | Or [e] deriving (Functor, Show)+infixr 3 `AndB`+infixr 2 `OrB`+data BooleanF e = NotB e | e `AndB` e | e `OrB` e deriving (Functor, Show) -instance SearchBuilder (BooleanF Builder) where-    searchBuilder b = case b of-        Not e -> "-" <> e-        And es -> ("(" <>) . (<> ")") . fold $ intersperse " " es-        Or es -> ("(" <>) . (<> ")") . fold $ intersperse " OR " es+instance ConjunctF BooleanF where conjunctF = AndB+instance DisjunctF BooleanF where disjunctF = OrB+instance ComplementF BooleanF where complementF = NotB --- | The free Boolean-shaped monad: comes with an 'IsString' instance--- so we can write @\"simple queries\" :: 'Simple'@. No refunds.-type BooleanM = Free BooleanF+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 -instance (IsString a) => IsString (BooleanM a) where-    fromString = return . fromString+-- | The free Boolean-shaped monad. No refunds.+type BooleanM = Free BooleanF  -- | Simple Boolean combinations of 'Term's.-type Simple = BooleanM Term------------------------------------------------------------------------------ | Conjunction on a list of 'BooleanM' expressions.-fAnd :: [BooleanM a] -> BooleanM a-fAnd = Free . And---- | Disjunction on a list of 'BooleanM' expressions.-fOr :: [BooleanM a] -> BooleanM a-fOr = Free . Or---- | Negation of a 'BooleanM' expression.-fNot :: BooleanM a -> BooleanM a-fNot = Free . Not+type Simple = BooleanM (Term Text)