summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLiyangHu <>2013-09-07 09:09:18 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2013-09-07 09:09:18 (GMT)
commit663ce3e15ee9ba409ae4531484bc40e213a21787 (patch)
tree89f7f7cce749da4cb303c8de8b35f573a28bc403
version 0.0.1.00.0.1.0
-rw-r--r--LICENSE30
-rw-r--r--Setup.hs2
-rw-r--r--example.hs42
-rw-r--r--google-mail-filters.cabal50
-rw-r--r--src/Data/Google/Mail/Filters.hs113
5 files changed, 237 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..8e1c0ce
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/example.hs b/example.hs
new file mode 100644
index 0000000..169a7a0
--- /dev/null
+++ b/example.hs
@@ -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"
+
diff --git a/google-mail-filters.cabal b/google-mail-filters.cabal
new file mode 100644
index 0000000..16cc9a1
--- /dev/null
+++ b/google-mail-filters.cabal
@@ -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
+
diff --git a/src/Data/Google/Mail/Filters.hs b/src/Data/Google/Mail/Filters.hs
new file mode 100644
index 0000000..ad24622
--- /dev/null
+++ b/src/Data/Google/Mail/Filters.hs
@@ -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
+