imm 1.2.0.0 → 1.2.1.0

raw patch · 9 files changed

+62/−56 lines, 9 filesdep +microlensdep ~mono-traversabledep ~rss-conduitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: microlens

Dependency ranges changed: mono-traversable, rss-conduit

API changes (from Hackage documentation)

Files

• imm.cabal +2/−2
• src/bin/Executable.hs +8/−6
• src/lib/Imm/Core.hs +1/−1
• src/lib/Imm/Feed.hs +17/−5
• src/lib/Imm/HTTP.hs +1/−1
• src/lib/Imm/Hooks/WriteFile.hs +25/−27
• src/lib/Imm/Options.hs +1/−1
• src/lib/Imm/Prelude.hs +6/−12
• src/lib/Imm/Pretty.hs +1/−1

@@ -1,5 +1,5 @@ name:                imm-version:             1.2.0.0+version:             1.2.1.0 synopsis:            Execute arbitrary actions for each unread element of RSS/Atom feeds description:         Cf README file homepage:            https://github.com/k0ral/imm@@ -42,7 +42,7 @@     Imm.Options     Imm.Pretty     Paths_imm-  build-depends: aeson, ansi-wl-pprint, atom-conduit >= 0.4, base == 4.*, blaze-html, blaze-markup, bytestring, case-insensitive, chunked-data >= 0.3.0, comonad, conduit, conduit-combinators, connection, containers, directory >= 1.2.3.0, dyre, fast-logger, filepath, free, hashable, HaskellNet, HaskellNet-SSL >= 0.3.3.0, http-client >= 0.4.30, http-client-tls, http-types, mime-mail, monoid-subclasses, mono-traversable >= 1.0.0, network, opml-conduit >= 0.6, optparse-applicative, rainbow, rainbox, rss-conduit >= 0.3.1, safe-exceptions, tagged, text, transformers, time, timerep >= 2.0.0.0, tls, uri-bytestring, xml, xml-conduit >= 1.5, xml-types+  build-depends: aeson, ansi-wl-pprint, atom-conduit >= 0.4, base == 4.*, blaze-html, blaze-markup, bytestring, case-insensitive, chunked-data >= 0.3.0, comonad, conduit, conduit-combinators, connection, containers, directory >= 1.2.3.0, dyre, fast-logger, filepath, free, hashable, HaskellNet, HaskellNet-SSL >= 0.3.3.0, http-client >= 0.4.30, http-client-tls, http-types, mime-mail, monoid-subclasses, microlens, mono-traversable >= 1, network, opml-conduit >= 0.6, optparse-applicative, rainbow, rainbox, rss-conduit >= 0.4.1, safe-exceptions, tagged, text, transformers, time, timerep >= 2.0.0.0, tls, uri-bytestring, xml, xml-conduit >= 1.5, xml-types   -- Build-tools:   hs-source-dirs: src/lib   ghc-options: -Wall -fno-warn-unused-do-bind

@@ -5,6 +5,7 @@ -- {{{ Imports import           Imm import           Imm.Database.JsonFile+import qualified Imm.Hooks.WriteFile   as WriteFile import           Imm.HTTP.Simple import           Imm.Logger.Simple import           Imm.Prelude@@ -13,11 +14,11 @@ import           System.Exit -- }}} -mkDummyCoHooks :: (MonadIO m, MonadThrow m) => () -> CoHooksF m ()-mkDummyCoHooks _ = CoHooksF coOnNewElement where-  coOnNewElement _ _ = do-    io $ putStrLn "No hook defined."-    throwM $ ExitFailure 1+-- mkDummyCoHooks :: (MonadIO m, MonadThrow m) => () -> CoHooksF m ()+-- mkDummyCoHooks _ = CoHooksF coOnNewElement where+--   coOnNewElement _ _ = do+--     io $ putStrLn "No hook defined."+--     throwM $ ExitFailure 1   main :: IO ()@@ -26,4 +27,5 @@   manager <- defaultManager   database <- defaultDatabase -  imm (mkCoHttpClient, manager) (mkCoDatabase, database) (mkCoLogger, logger) (mkDummyCoHooks, ()) (mkCoXmlParser, defaultPreProcess)+  -- imm (mkCoHttpClient, manager) (mkCoDatabase, database) (mkCoLogger, logger) (mkDummyCoHooks, ()) (mkCoXmlParser, defaultPreProcess)+  imm (mkCoHttpClient, manager) (mkCoDatabase, database) (mkCoLogger, logger) (WriteFile.mkCoHooks, WriteFile.defaultSettings "/home/koral/feeds") (mkCoXmlParser, defaultPreProcess)

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts       #-} {-# LANGUAGE NoImplicitPrelude      #-} {-# LANGUAGE OverloadedStrings      #-} {-# LANGUAGE ScopedTypeVariables    #-}

@@ -1,4 +1,6 @@+{-# LANGUAGE DataKinds         #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} -- | Helpers to manipulate feeds module Imm.Feed where @@ -8,10 +10,12 @@  import           Data.Hashable import           Data.Time-+import           Lens.Micro import           Text.Atom.Types+import           Text.RSS.Extensions.Content+import           Text.RSS.Extensions.DublinCore+import           Text.RSS.Lens import           Text.RSS.Types- import           URI.ByteString -- }}} @@ -25,10 +29,10 @@   pretty (ByUID n) = text "feed" <+> text (show n)   pretty (ByURI u) = prettyURI u -data Feed = Rss RssDocument | Atom AtomFeed+data Feed = Rss (RssDocument '[ContentModule, DublinCoreModule]) | Atom AtomFeed   deriving(Eq, Show) -data FeedElement = RssElement RssItem | AtomElement AtomEntry+data FeedElement = RssElement (RssItem '[ContentModule, DublinCoreModule]) | AtomElement AtomEntry   deriving(Eq, Show)  @@ -43,12 +47,20 @@ getElements (Atom feed) = map AtomElement $ feedEntries feed  getDate :: FeedElement -> Maybe UTCTime-getDate (RssElement item)   = itemPubDate item+getDate (RssElement item)   = itemPubDate item <|> (elementDate $ itemDcMetaData (item ^. itemExtensionL)) getDate (AtomElement entry) = Just $ entryUpdated entry  getTitle :: FeedElement -> Text getTitle (RssElement item)   = itemTitle item getTitle (AtomElement entry) = show $ prettyAtomText $ entryTitle entry++getContent :: FeedElement -> Text+getContent (RssElement item) = if not (null content) then content else itemDescription item where+  ContentItem content = item ^. itemExtensionL+getContent (AtomElement entry) = fromMaybe "<empty>" $ content <|> summary where+  content = show . prettyAtomContent <$> entryContent entry+  summary = show . prettyAtomText <$> entrySummary entry+  getHashes :: FeedElement -> [Int] getHashes (RssElement item) = map (hash . (show :: Doc -> String) . prettyGuid) (maybeToList $ itemGuid item)

@@ -27,7 +27,7 @@   deriving(Functor)  -- | HTTP client interpreter-data CoHttpClientF m a = CoHttpClientF+newtype CoHttpClientF m a = CoHttpClientF   { getH :: URI -> m (Either SomeException LByteString, a)   } deriving(Functor) 

@@ -13,14 +13,11 @@ import           Imm.Pretty  import           Control.Arrow- import           Data.Monoid.Textual           hiding (elem, map) import qualified Data.Text.Lazy                as Text import           Data.Time- import           System.Directory              (createDirectoryIfMissing) import           System.FilePath- import           Text.Atom.Types import           Text.Blaze.Html.Renderer.Text import           Text.Blaze.Html5              (Html, docTypeHtml,@@ -28,7 +25,6 @@ import qualified Text.Blaze.Html5              as H hiding (map) import           Text.Blaze.Html5.Attributes   as H (charset, href) import           Text.RSS.Types- import           URI.ByteString -- }}} @@ -42,7 +38,7 @@ -- * Interpreter  -- | Interpreter for 'HooksF'-mkCoHooks :: (MonadIO m) => WriteFileSettings -> CoHooksF m WriteFileSettings+mkCoHooks :: MonadIO m => WriteFileSettings -> CoHooksF m WriteFileSettings mkCoHooks a@(WriteFileSettings f) = CoHooksF coOnNewElement where   coOnNewElement feed element = do     let FileInfo path content = f feed element@@ -77,40 +73,42 @@   H.body $ do     H.h1 $ convertText $ getFeedTitle feed     H.article $ do-      defaultHeader feed element+      H.header $ do+        defaultArticleTitle feed element+        defaultArticleAuthor feed element+        defaultArticleDate feed element       defaultBody feed element   -- * Low-level helpers --- | Generate an HTML @<header>@ for a given feed element-defaultHeader :: Feed -> FeedElement -> Html-defaultHeader _ element@(RssElement item) = H.header $ do-  H.h2 $ maybe id (\uri -> H.a ! H.href uri) link $ convertText $ getTitle element-  unless (null author) $ H.address $ "Published by " >> convertText author-  forM_ (itemPubDate item) $ \date -> H.p $ " on " >> H.time (convertDoc $ prettyTime date)-  where link = withRssURI (convertDoc . prettyURI) <$> itemLink item-        author = itemAuthor item-defaultHeader _ element@(AtomElement entry) = H.header $ do-  H.h2 $ convertText $ getTitle element-  H.address $ do-    "Published by "-    forM_ (entryAuthors entry) $ \author -> do-      convertDoc $ prettyPerson author-      ", "-  H.p $ "on " >> H.time (convertDoc $ prettyTime $ entryUpdated entry)+defaultArticleTitle :: Feed -> FeedElement -> Html+defaultArticleTitle _ element@(RssElement item) = H.h2 $ maybe id (\uri -> H.a ! H.href uri) link $ convertText $ getTitle element where+  link = withRssURI (convertDoc . prettyURI) <$> itemLink item+defaultArticleTitle _ element@(AtomElement _) = H.h2 $ convertText $ getTitle element +defaultArticleAuthor :: Feed -> FeedElement -> Html+defaultArticleAuthor _ (RssElement item) = unless (null author) $ H.address $ "Published by " >> convertText author where+  author = itemAuthor item+defaultArticleAuthor _ (AtomElement entry) = H.address $ do+  "Published by "+  forM_ (entryAuthors entry) $ \author -> do+    convertDoc $ prettyPerson author+    ", "++defaultArticleDate :: Feed -> FeedElement -> Html+defaultArticleDate _ element = forM_ (getDate element) $ \date -> H.p $ " on " >> H.time (convertDoc $ prettyTime date)++ -- | Generate the HTML content for a given feed element defaultBody :: Feed -> FeedElement -> Html-defaultBody _ (RssElement item) = H.p $ preEscapedToHtml $ itemDescription item-defaultBody _ (AtomElement entry) = do+defaultBody _ element@(RssElement _) = H.p $ preEscapedToHtml $ getContent element+defaultBody _ element@(AtomElement entry) = do   unless (null links) $ H.p $ do     "Related links:"     H.ul $ forM_ links $ \uri -> H.li (H.a ! H.href (convertAtomURI uri) $ convertAtomURI uri)-  H.p $ preEscapedToHtml $ fromMaybe "<empty>" $ content <|> summary+  H.p $ preEscapedToHtml $ getContent element   where links   = map linkHref $ entryLinks entry-        content = show . prettyAtomContent <$> entryContent entry :: Maybe Text-        summary = show . prettyAtomText <$> entrySummary entry :: Maybe Text   convertAtomURI :: (IsString t) => AtomURI -> t

@@ -68,7 +68,7 @@ --         ++ catMaybes [("CONFIG=" ++) <$> opts^.configurationLabel_]  parseOptions :: (MonadIO m) => m CliOptions-parseOptions = io $ customExecParser (prefs noBacktrack) (info parser $ progDesc "Convert items from RSS/Atom feeds to mails.")+parseOptions = io $ customExecParser (defaultPrefs {- noBacktrack -} ) (info parser $ progDesc "Fetch elements from RSS/Atom feeds and execute arbitrary actions for each of them.")   where parser = helper <*> optional dyreMasterBinary *> optional dyreDebug *> cliOptions  

@@ -22,10 +22,9 @@                                                        void, when) import           Control.Monad.IO.Class          as X import           Control.Monad.Trans.Free        (FreeF (..), FreeT (..))- import           Data.Bifunctor                  as X-import qualified Data.ByteString                 as B (ByteString ())-import qualified Data.ByteString.Lazy            as LB (ByteString ())+import qualified Data.ByteString                 as B (ByteString)+import qualified Data.ByteString.Lazy            as LB (ByteString) import           Data.Containers                 as X import           Data.Either                     as X import           Data.Foldable                   as X (forM_)@@ -36,20 +35,17 @@ import           Data.Map                        as X (Map) import           Data.Maybe                      as X hiding (catMaybes) import           Data.Monoid                     as X hiding (Product, Sum)-import           Data.Monoid.Textual             as X (TextualMonoid (),-                                                       fromText)+import           Data.Monoid.Textual             as X (TextualMonoid, fromText) import           Data.MonoTraversable.Unprefixed as X hiding (forM_, mapM_) import           Data.Ord                        as X import           Data.Sequences                  as X import           Data.String                     as X (IsString (..)) import           Data.Tagged-import qualified Data.Text                       as T (Text ())-import qualified Data.Text.Lazy                  as LT (Text ())+import qualified Data.Text                       as T (Text)+import qualified Data.Text.Lazy                  as LT (Text) import           Data.Traversable                as X (for, forM) import           Data.Typeable                   as X- import qualified GHC.Show                        as Show- import           Prelude                         as X hiding (all, and, any,                                                        break, concat, concatMap,                                                        drop, dropWhile, elem,@@ -63,14 +59,11 @@                                                        takeWhile, unlines,                                                        unwords, words,                                                        writeFile)- import           System.IO                       as X (stderr, stdout)- import           Text.PrettyPrint.ANSI.Leijen    as X (Doc, Pretty (..), angles,                                                        brackets, equals, hsep,                                                        indent, space, text,                                                        vsep, (<+>))- import           Text.PrettyPrint.ANSI.Leijen    (line) -- }}} @@ -123,6 +116,7 @@   inj = proxy inj' (Proxy :: Proxy (Contains f g))  +-- | Functors @f@ and @g@ are paired when they can annihilate each other class (Monad m, Functor f, Functor g) => PairingM f g m | f -> g where   pairM :: (a -> b -> m r) -> f a -> g b -> m r 

@@ -80,7 +80,7 @@   -- , "   Item Body:   " ++ (Imm.Mail.getItemContent item),   ) -prettyItem :: RssItem -> Doc+prettyItem :: RssItem e -> Doc prettyItem i = "Item:" <+> text (fromText $ itemTitle i) <++> indent 4   (         "By" <+> equals <+> text (fromText $ itemAuthor i)   <++> "Updated" <+> equals <+> fromMaybe "<empty>" (prettyTime <$> itemPubDate i)