packages feed

google-mail-filters (empty) → 0.0.1.0

raw patch · 5 files changed

+237/−0 lines, 5 filesdep +basedep +containersdep +google-mail-filterssetup-changed

Dependencies added: base, containers, google-mail-filters, google-search, old-locale, text, time, xml-conduit

Files

+ 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
+ example.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings #-}++import Prelude+import Control.Applicative+import qualified Data.Text.Lazy.IO as TL+import Data.Time.Clock+import Text.XML as XML++import Language.Google.Search.Simple as Search+import Language.Google.Search.Mail as Search+import Data.Google.Mail.Filters as Filters++main :: IO ()+main = do+    now <- getCurrentTime+    TL.putStrLn . XML.renderText def {rsPretty = True} $+        Filters.toXML now ("Your Name", "you@example.com") filters++filters :: [Filter]+filters =++    [ Filter [Archive, LabelAs "shopping"] $ orB+        [ pure (From $ ("auto-confirm" \/ "noreply") /\ "amazon")+        , pure (From "no-reply@kickstarter.com")+        , pure (From $ "service" /\ "paypal")+        ]++    , Filter [Archive, LabelAs "haskell"]+        $  pure (List "haskell-cafe.haskell.org")+        /\ notB haskellWeeklyNews -- keep in inbox+    , Filter [LabelAs "haskell"] haskellWeeklyNews++    , Filter [LabelAs "notification", MarkAsImportant False, NeverSpam] $ orB+        [ pure $ From "plus.google.com"+        , pure $ From "facebookmail.com"+        , pure $ From "postmaster.twitter.com"+        , pure $ From "noreply@foursquare.com"+        ]++    ] where+    haskellWeeklyNews = pure . Subject $ Exact <$> "Haskell Weekly News"+
+ google-mail-filters.cabal view
@@ -0,0 +1,50 @@+name:           google-mail-filters+version:        0.0.1.0+synopsis:       Write GMail filters and output to importable XML+description:+    Organise your Google Mail filters as a Haskell EDSL, and produce XML+    output that can be imported from the GMail web interface.+    .+    See <http://github.com/liyang/google-mail-filters/example.hs>.+homepage:       https://github.com/liyang/google-mail-filters+license:        BSD3+license-file:   LICENSE+author:         Liyang HU+maintainer:     google-mail-filters@liyang.hu+copyright:      © 2013 Liyang HU+category:       Data, Web, XML+build-type:     Simple+cabal-version:  >= 1.8+stability:      experimental+extra-source-files:+    example.hs++source-repository head+    type:     git+    location: http://github.com/liyang/google-mail-filters++library+    hs-source-dirs: src+    exposed-modules:+        Data.Google.Mail.Filters+    build-depends:+        base >= 4.5 && <= 9000,+        containers >= 0.4,+        google-search >= 0.1,+        old-locale >= 1.0,+        text >= 0.11,+        time >= 1.4,+        xml-conduit >= 0.7+    ghc-options: -Wall++test-suite example+    type: exitcode-stdio-1.0+    main-is: example.hs+    build-depends:+        base,+        google-mail-filters,+        google-search,+        text,+        time,+        xml-conduit+
+ src/Data/Google/Mail/Filters.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Data.Google.Mail.Filters where++import Prelude+#if MIN_VERSION_xml_conduit(1,0,0)+import qualified Data.Map as Map+#endif+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as B+import Data.Time.Clock+import Data.Time.Format+import System.Locale+import Text.XML++import Language.Google.Search.Simple as Search+import Language.Google.Search.Mail as Search++data Action+    = Archive+    | Categorise Category+    | Delete+    | ForwardTo Text+    | LabelAs Text+    | MarkAsImportant Bool+    | MarkAsRead+    | NeverSpam+    | Star+    deriving (Show)++data Filter = Filter+    { actions :: [Action]+    , hasTheWord :: Search.Mail -- ^ subsumes other search operators+    } deriving (Show)++-- | (Name, Email) of author.+type Author = (Text, Text)++toXML :: UTCTime -> Author -> [Filter] -> Document+toXML now (author, account) filters = Document prologue root [] where+    prologue = Prologue [] Nothing []+    root = Element "feed" namespaces (preamble ++ zipWith entry [0 ..] filters)+    namespaces = toAttrs+        [ ("xmlns", "http://www.w3.org/2005/Atom")+        , ("xmlns:apps", "http://schemas.google.com/apps/2006") ]+    updated = noel "updated" [] [NodeContent $ utcText now]+    preamble =+        [ noel "title" [] [NodeContent "Mail Filters"]+        , noel "id" [] [ NodeContent . T.append tagFilters . T.intercalate "," $+            zipWith (const . showIdent) [0 ..] filters ]+        , updated+        , noel "author" []+            [ noel "name"  [] [NodeContent author]+            , noel "email" [] [NodeContent account]+            ]+        ]++    tagFilter, tagFilters :: Text+    tagFilter  = "tag:mail.google.com,2008:filter:"+    tagFilters = "tag:mail.google.com,2008:filters:"++    noel :: Name -> [(Name, Text)] -> [Node] -> Node+    noel name attrs nodes = NodeElement $ Element name (toAttrs attrs) nodes++    utcText :: UTCTime -> Text+    utcText = T.pack . formatTime defaultTimeLocale "%FT%TZ"++    showIdent :: Int -> Text+    showIdent = T.pack . show++    entry :: Int -> Filter -> Node+    entry ident Filter {..} = noel "entry" [] $+        [ noel "category" [("term", "filter")] []+        , noel "title" [] [NodeContent "Mail Filter"]+        , noel "id" [] [NodeContent $ tagFilter <> showIdent ident]+        , updated+        , noel "content" [] []+        , prop "hasTheWord" (search hasTheWord)+        ] ++ map pact actions where++        prop name value = noel "apps:property"+            [("name", name), ("value", value)] []+        search s = TL.toStrict (B.toLazyText b) where+            PrecBuilder _prec b = searchBuilder s+        pact act = case act of+            Archive             -> prop "shouldArchive" "true"+            Categorise cat      -> prop "smartLabelToApply" $ case cat of+                Forums      -> "^smartlabel_group"+                Personal    -> "^smartlabel_personal"+                Promotions  -> "^smartlabel_promo"+                Social      -> "^smartlabel_social"+                Updates     -> "^smartlabel_notification"+            Delete              -> prop "shouldTrash" "true"+            ForwardTo t         -> prop "forwardTo" t+            LabelAs t           -> prop "label" t+            MarkAsImportant yes -> case yes of+                True -> prop "shouldAlwaysMarkAsImportant" "true"+                False -> prop "shouldNeverMarkAsImportant" "true"+            MarkAsRead          -> prop "shouldMarkAsRead" "true"+            NeverSpam           -> prop "shouldNeverSpam" "true"+            Star                -> prop "shouldStar" "true"++#if MIN_VERSION_xml_conduit(1,0,0)+    toAttrs = Map.fromList+#else+    toAttrs = id+#endif+