google-search (empty) → 0.0.1.0
raw patch · 5 files changed
+321/−0 lines, 5 filesdep +basedep +freedep +natssetup-changed
Dependencies added: base, free, nats, old-locale, text, time
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- google-search.cabal +34/−0
- src/Language/Google/Search/Mail.hs +171/−0
- src/Language/Google/Search/Simple.hs +84/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Liyang HU++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Liyang HU nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ google-search.cabal view
@@ -0,0 +1,34 @@+name: google-search+version: 0.0.1.0+synopsis: EDSL for Google and GMail search expressions+description:+ Construct well-typed search expressions for use in various Google services.+homepage: https://github.com/liyang/google-search+license: BSD3+license-file: LICENSE+author: Liyang HU+maintainer: google-search@liyang.hu+copyright: © 2013 Liyang HU+category: Language, Text, Web+build-type: Simple+cabal-version: >= 1.8+stability: experimental++source-repository head+ type: git+ location: http://github.com/liyang/google-search++library+ hs-source-dirs: src+ exposed-modules:+ Language.Google.Search.Simple+ Language.Google.Search.Mail+ build-depends:+ base >= 4.5 && <= 9000,+ free >= 2.1,+ nats >= 0.1,+ old-locale >= 1.0,+ text >= 0.11,+ time >= 1.4+ ghc-options: -Wall+
+ src/Language/Google/Search/Mail.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE OverloadedStrings #-}++-- | <https://support.google.com/mail/answer/7190>++module Language.Google.Search.Mail where++import Prelude+import Data.Monoid+import Data.String+import Data.Text (Text)+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as B+import qualified Data.Text.Lazy.Builder.Int as B+import Data.Time.Calendar (Day)+import Data.Time.Format (formatTime)+import Numeric.Natural+import System.Locale (defaultTimeLocale)++import Language.Google.Search.Simple++-- | Features for the @has:@ operator.+data Feature+ = Attachment+ | NoUserLabels+ | UserLabels+ -- stars+ | BlueInfo+ | BlueStar+ | Circle+ | GreenCheck+ | GreenStar+ | OrangeGuillemet+ | OrangeStar+ | PurpleQuestion+ | PurpleStar+ | RedBang+ | RedStar+ | YellowBang+ | YellowStar+ deriving (Show)++-- | Locations for the @in:@ operator.+data Location+ = Anywhere+ | Inbox+ | Trash+ | Spam+ deriving (Show)++-- | Statuses for the @is:@ operator.+data Status+ = Important+ | Starred+ | Unread+ | Read+ | Chat+ deriving (Show)++-- | Categories for the @category:@ operator.+data Category+ = Forums+ | Personal+ | Promotions+ | Social+ | Updates+ deriving (Show)++-- | GMail search operators.+data MailOp+ = Plain Simple+ | From Simple+ | To Simple+ | Subject Simple+ | Label Text+ | Has Feature+ | List Simple+ | Filename Simple+ | In Location+ | Is Status+ | Cc Simple+ | Bcc Simple+ | After Day+ | Before Day+ | Older Natural Duration+ | Newer Natural Duration+ | DeliveredTo Simple+ | FromCircle Simple+ | Category Category+ | Larger Natural Size+ | Smaller Natural Size+ | RFC822MsgId Text+ deriving (Show)++instance IsString MailOp where+ fromString = Plain . fromString++-- | Boolean combinations of GMail operators or 'Plain' 'Simple' terms.+type Mail = BooleanM MailOp++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+ Attachment -> "attachment"+ BlueInfo -> "blue-info"+ BlueStar -> "blue-star"+ Circle -> "circle"+ GreenCheck -> "green-check"+ GreenStar -> "green-star"+ NoUserLabels -> "nouserlabels"+ OrangeGuillemet -> "orange-guillemet"+ OrangeStar -> "orange-star"+ PurpleQuestion -> "purple-question"+ PurpleStar -> "purple-star"+ RedBang -> "red-bang"+ RedStar -> "red-star"+ UserLabels -> "userlabels"+ YellowBang -> "yellow-bang"+ YellowStar -> "yellow-star"+ List s -> "list:" <> searchBuilder s+ Filename s -> "filename:" <> searchBuilder s+ In l -> "in:" <> case l of+ Anywhere -> "anywhere"+ Inbox -> "inbox"+ Trash -> "trash"+ Spam -> "spam"+ 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+ 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++ where+ date :: Day -> Builder+ date = B.fromString . formatTime defaultTimeLocale "%Y/%m/%d"++ duration :: Natural -> Duration -> Builder+ duration n d = B.decimal n <> case d of+ Days -> "d"+ Months -> "m"+ Years -> "y"++ size :: Natural -> Size -> Builder+ size n u = B.decimal n <> case u of+ Bytes -> mempty+ KBytes -> "k"+ MBytes -> "m"+
+ src/Language/Google/Search/Simple.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++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)+import qualified Data.Text as T+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as B++-- * Units++data Duration = Days | Months | Years deriving (Show)+data Size = Bytes | KBytes | MBytes deriving (Show)++-- | Render a search expression using Google search syntax.+class SearchBuilder e where+ searchBuilder :: e -> Builder++-- | 'SearchBuilder' for 'Free'!+instance (Functor f, SearchBuilder a, SearchBuilder (f Builder)) =>+ SearchBuilder (Free f a) where+ searchBuilder = iter searchBuilder . fmap searchBuilder++------------------------------------------------------------------------+-- * 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++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 '"')++------------------------------------------------------------------------++-- | The shape of Boolean expressions.+data BooleanF e = Not e | And [e] | Or [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++-- | The free Boolean-shaped monad: comes with an 'IsString' instance+-- so we can write @\"simple queries\" :: 'Simple'@. No refunds.+type BooleanM = Free BooleanF++instance (IsString a) => IsString (BooleanM a) where+ fromString = return . fromString++-- | 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+