packages feed

imm 1.6.1.0 → 1.7.0.0

raw patch · 6 files changed

+32/−28 lines, 6 filesdep +msgpackPVP ok

version bump matches the API change (PVP)

Dependencies added: msgpack

API changes (from Hackage documentation)

- Imm.Callback: instance Data.Aeson.Types.FromJSON.FromJSON Imm.Callback.Message
- Imm.Callback: instance Data.Aeson.Types.ToJSON.ToJSON Imm.Callback.Message
+ Imm.Callback: instance Data.MessagePack.Object.MessagePack Imm.Callback.Message

Files

README.md view
@@ -12,9 +12,9 @@  Callbacks are configured through the `$XDG_CONFIG_HOME/imm/callbacks.dhall` file. A commented template file is bundled with the project. -`imm` will call each callback once per feed element, and will fill its standard input (`stdin`) with a JSON object structured as follows:+`imm` will call each callback once per feed element, and will fill its standard input (`stdin`) with a [MessagePack][4]-encoded object structured as follows: -```json+``` {   "feed": "RSS document or Atom feed (XML)",   "element": "RSS item or Atom entry (XML)"@@ -107,3 +107,4 @@ [1]: http://hackage.haskell.org/package/imm [2]: https://www.haskell.org [3]: https://dhall-lang.org/+[4]: https://msgpack.org/
imm.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                imm-version:             1.6.1.0+version:             1.7.0.0 synopsis:            Execute arbitrary callbacks for each element of RSS/Atom feeds description:         Cf README file homepage:            https://github.com/k0ral/imm@@ -48,6 +48,7 @@     filepath,     hashable,     http-types,+    msgpack,     microlens,     monad-time,     prettyprinter,@@ -67,7 +68,7 @@  executable imm   import: common-  build-depends: imm, aeson, async, atom-conduit >=0.7, bytestring, case-insensitive, conduit, connection, containers, dhall, directory, fast-logger, filepath, http-client >=0.4.30, http-client-tls, opml-conduit >=0.7, optparse-applicative, prettyprinter-ansi-terminal, refined >=0.4.1, rss-conduit >=0.4.1, safe-exceptions, stm, stm-chans, streaming-bytestring, streaming-with, text, typed-process, uri-bytestring, xml-conduit >=1.5, xml-types+  build-depends: imm, aeson, async, atom-conduit >=0.7, bytestring, case-insensitive, conduit, connection, containers, dhall, directory, fast-logger, filepath, http-client >=0.4.30, http-client-tls, msgpack, opml-conduit >=0.7, optparse-applicative, prettyprinter-ansi-terminal, refined >=0.4.1, rss-conduit >=0.4.1, safe-exceptions, stm, stm-chans, streaming-bytestring, streaming-with, text, typed-process, uri-bytestring, xml-conduit >=1.5, xml-types   main-is: Main.hs   other-modules: Core, Database, HTTP, Logger, Options, Paths_imm, XML   autogen-modules: Paths_imm@@ -76,14 +77,14 @@  executable imm-writefile   import: common-  build-depends: imm, aeson, atom-conduit, blaze-html, blaze-markup, bytestring, directory, filepath, optparse-applicative, prettyprinter, rss-conduit, streaming-bytestring, streaming-with, text, time, uri-bytestring+  build-depends: imm, atom-conduit, blaze-html, blaze-markup, bytestring, directory, filepath, msgpack, optparse-applicative, prettyprinter, rss-conduit, streaming-bytestring, streaming-with, text, time, uri-bytestring   main-is: Main.hs   hs-source-dirs: src/write-file   ghc-options: -Wall -fno-warn-unused-do-bind -threaded  executable imm-sendmail   import: common-  build-depends: imm, aeson, atom-conduit, blaze-html, blaze-markup, bytestring, directory, filepath, HaskellNet >=0.5, HaskellNet-SSL >= 0.3.3.0, mime-mail, network <3, optparse-applicative, prettyprinter, refined, rss-conduit, text, time, uri-bytestring+  build-depends: imm, atom-conduit, blaze-html, blaze-markup, bytestring, directory, filepath, HaskellNet >=0.5, HaskellNet-SSL >= 0.3.3.0, msgpack, mime-mail, network <3, optparse-applicative, prettyprinter, refined, rss-conduit, text, time, uri-bytestring   main-is: Main.hs   hs-source-dirs: src/send-mail   ghc-options: -Wall -fno-warn-unused-do-bind -threaded
src/lib/Imm/Callback.hs view
@@ -1,14 +1,15 @@ {-# LANGUAGE DeriveGeneric     #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications  #-} module Imm.Callback where  -- {{{ Imports import           Imm.Feed -import           Data.Aeson-import           Data.Aeson.Types+import qualified Data.Map                  as Map+import           Data.MessagePack.Object import           Data.Text.Prettyprint.Doc-import           Dhall+import           Dhall                     hiding (maybe) -- }}}  -- | External program run for each feed element.@@ -28,12 +29,13 @@ -- | All information passed to external programs about a new feed item, are stored in this structure. data Message = Message Feed FeedElement deriving(Eq, Generic, Ord, Show) -instance ToJSON Message where-  toJSON (Message feed element) = object ["feed" .= renderFeed feed, "element" .= renderFeedElement element]+instance MessagePack Message where+  toObject (Message feed element) = toObject @(Map Text Text)+    $ Map.insert "feed" (renderFeed feed)+    $ Map.insert "element" (renderFeedElement element) mempty -instance FromJSON Message where-  parseJSON = withObject "Message" $ \v -> Message-    <$> (v .: "feed" >>= (liftEither . parseFeed))-    <*> (v .: "element" >>= (liftEither . parseFeedElement))-    where liftEither :: Either e a -> Parser a-          liftEither = either (const mempty) return+  fromObject object = fromObject object >>= \m -> Message+    <$> (lookup @(Map Text Text) "feed" m >>= eitherToMaybe . parseFeed)+    <*> (lookup @(Map Text Text) "element" m >>= eitherToMaybe . parseFeedElement)+    where eitherToMaybe (Right a) = Just a+          eitherToMaybe _         = Nothing
src/main/Main.hs view
@@ -22,9 +22,9 @@ import           Control.Concurrent.Async import           Control.Concurrent.STM.TMChan import           Control.Exception.Safe-import           Data.Aeson                    hiding (Error) import           Data.Conduit.Combinators      as Conduit (stdin) import qualified Data.Map                      as Map+import qualified Data.MessagePack              as MsgPack import qualified Data.Text                     as Text import qualified Data.Text.IO                  as Text import           Dhall@@ -123,7 +123,7 @@     newItem <- atomically $ readTMChan newItemsChan     forM_ newItem $ \(feedID, feed, element) -> do       results <- forM callbacks $ \callback@(Callback executable arguments) -> do-        let processInput = byteStringInput $ encode $ Message feed element+        let processInput = byteStringInput $ MsgPack.pack $ Message feed element             processConfig = proc executable (map toString arguments) & setStdin processInput          log logger Debug $ "Running" <+> cyan (pretty executable) <+> "on" <+> magenta (pretty feedID) <+> "/" <+> yellow (pretty $ getTitle element)
src/send-mail/Main.hs view
@@ -7,8 +7,8 @@ import           Imm.Feed import           Imm.Pretty -import           Data.Aeson import           Data.ByteString             (getContents)+import qualified Data.MessagePack            as MsgPack import           Data.Text                   as Text (intercalate) import           Data.Time import           Network.HaskellNet.SMTP@@ -103,15 +103,15 @@ main = do   CliOptions smtpServer recipients dryRun <- parseOptions -  message <- getContents <&> fromStrict <&> eitherDecode+  message <- getContents <&> fromStrict <&> MsgPack.unpack   case message of-    Left e -> putStrLn e-    Right (Message feed element) -> do+    Just (Message feed element) -> do       timezone <- io getCurrentTimeZone       currentTime <- io getCurrentTime       let formatMail = FormatMail defaultFormatFrom defaultFormatSubject defaultFormatBody (const $ const recipients)           mail = buildMail formatMail currentTime timezone feed element       unless dryRun $ io $ withSMTPConnection smtpServer $ sendMimeMail2 mail+    _ -> putStrLn "Invalid input" >> exitFailure    return () 
src/write-file/Main.hs view
@@ -8,10 +8,10 @@ import           Imm.Feed import           Imm.Pretty -import           Data.Aeson-import           Data.ByteString (getContents)+import           Data.ByteString               (getContents) import           Data.ByteString.Builder import           Data.ByteString.Streaming     (toStreamingByteString)+import qualified Data.MessagePack              as MsgPack import qualified Data.Text                     as Text (null, replace) import           Data.Time import           Options.Applicative@@ -46,16 +46,16 @@ main :: IO () main = do   CliOptions directory dryRun <- parseOptions-  message <- getContents <&> fromStrict <&> eitherDecode+  message <- getContents <&> fromStrict <&> MsgPack.unpack   case message of-    Left e -> putStrLn e-    Right (Message feed element) -> do+    Just (Message feed element) -> do       let content = defaultFileContent feed element           filePath = defaultFilePath directory feed element       putStrLn filePath       unless dryRun $ do         createDirectoryIfMissing True $ takeDirectory filePath         writeBinaryFile filePath $ toStreamingByteString content+    _ -> putStrLn "Invalid input" >> exitFailure   return ()  -- * Default behavior