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 +3/−2
- imm.cabal +5/−4
- src/lib/Imm/Callback.hs +13/−11
- src/main/Main.hs +2/−2
- src/send-mail/Main.hs +4/−4
- src/write-file/Main.hs +5/−5
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