packages feed

imm 1.9.0.0 → 1.10.0.0

raw patch · 12 files changed

+87/−70 lines, 12 filesdep +avrodep −msgpackdep −streaming-bytestringdep −streaming-withPVP ok

version bump matches the API change (PVP)

Dependencies added: avro

Dependencies removed: msgpack, streaming-bytestring, streaming-with

API changes (from Hackage documentation)

- Imm: Message :: Feed -> FeedElement -> Message
- Imm: data Message
- Imm.Callback: Message :: Feed -> FeedElement -> Message
- Imm.Callback: data Message
- Imm.Callback: instance Data.MessagePack.Object.MessagePack Imm.Callback.Message
- Imm.Callback: instance GHC.Classes.Ord Imm.Callback.Message
+ Imm: deserializeMessage :: MonadFail m => LByteString -> m (Feed, FeedElement)
+ Imm: serializeMessage :: Feed -> FeedElement -> LByteString
+ Imm.Callback: deserializeMessage :: MonadFail m => LByteString -> m (Feed, FeedElement)
+ Imm.Callback: instance Data.Avro.Encoding.FromAvro.FromAvro Imm.Callback.Message
+ Imm.Callback: instance Data.Avro.Encoding.ToAvro.ToAvro Imm.Callback.Message
+ Imm.Callback: instance Data.Avro.HasAvroSchema.HasAvroSchema Imm.Callback.Message
+ Imm.Callback: serializeMessage :: Feed -> FeedElement -> LByteString

Files

README.md view
@@ -34,16 +34,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 [MessagePack][4]-encoded object structured as follows:--```-{-  "feed": "RSS document or Atom feed (XML)",-  "element": "RSS item or Atom entry (XML)"-}-```+*imm* will call each callback once per feed element, and will fill its standard input (`stdin`) with [Avro][4]-encoded binary data, which schema is described in file [`idl/callback.json`](idl/callback.json). -`imm` expects callbacks to return `0` in case of success, or any other exit code in case of failure, in which case the standard error output (`stderr`) will be displayed.+Callback process is expected to return `0` in case of success, or any other exit code in case of failure, in which case the standard error output (`stderr`) will be displayed.   ## Example use cases@@ -136,4 +129,4 @@ [1]: http://hackage.haskell.org/package/imm [2]: https://www.haskell.org [3]: https://dhall-lang.org/-[4]: https://msgpack.org/+[4]: https://avro.apache.org/
default.nix view
@@ -3,12 +3,23 @@ let   hlib = nixpkgs.haskell.lib; -  thisPackage =-    addRuntimeDependencies (myHaskellPackages.callCabal2nix "imm" ./. { }) [+  source = nixpkgs.nix-gitignore.gitignoreSource [ ] ./.;+  packageWithoutRuntimeDependencies =+    myHaskellPackages.callCabal2nix "imm" source { };+  packageWithRuntimeDependencies =+    addRuntimeDependencies packageWithoutRuntimeDependencies [       nixpkgs.httpie       nixpkgs.pup     ]; +  exe = hlib.justStaticExecutables packageWithRuntimeDependencies;++  my-avro = {+    pkg = "avro";+    ver = "0.5.2.0";+    sha256 = "0inznspd7lwrc4z7bz12zrdh75zmyibidyb5yblxd3vmni68dx5c";+  };+   my-atom-conduit = {     pkg = "atom-conduit";     ver = "0.8.0.0";@@ -28,16 +39,17 @@   };    myHaskellPackages = nixpkgs.haskellPackages.override {-    overrides = hself: hsuper: {-      imm = thisPackage;-      atom-conduit = hlib.dontCheck-        (hlib.dontHaddock (hsuper.callHackageDirect my-atom-conduit { }));-      opml-conduit = hlib.dontCheck-        (hlib.dontHaddock (hsuper.callHackageDirect my-opml-conduit { }));-      rss-conduit = hlib.dontCheck-        (hlib.dontHaddock (hsuper.callHackageDirect my-rss-conduit { }));-      msgpack = hlib.doJailbreak hsuper.msgpack;-    };+    overrides = hself: hsuper:+      let+        fromHackage = x:+          hlib.dontCheck (hlib.dontHaddock (hsuper.callHackageDirect x { }));+      in {+        imm = packageWithRuntimeDependencies;+        avro = fromHackage my-avro;+        atom-conduit = fromHackage my-atom-conduit;+        opml-conduit = fromHackage my-opml-conduit;+        rss-conduit = fromHackage my-rss-conduit;+      };   };    addRuntimeDependencies = drv: xs:@@ -64,8 +76,6 @@      withHoogle = false;   };--  exe = hlib.justStaticExecutables (myHaskellPackages.imm);  in {   inherit shell;
+ idl/callback.json view
@@ -0,0 +1,14 @@+{+  "type": "record",+  "name": "message",+  "fields": [+    {+      "name": "feed",+      "type": "string"+    },+    {+      "name": "element",+      "type": "string"+    }+  ]+}
imm.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                imm-version:             1.9.0.0+version:             1.10.0.0 synopsis:            Execute arbitrary callbacks for each element of RSS/Atom feeds description:         Cf README file homepage:            https://github.com/k0ral/imm@@ -11,7 +11,7 @@ category:            Web build-type:          Simple data-files:          data/*.dhall-extra-source-files:  README.md, *.nix+extra-source-files:  README.md, *.nix, idl/*.json tested-with:         GHC <8.10 && >=8.4.2  source-repository head@@ -40,6 +40,7 @@   build-depends:     aeson,     async,+    avro,     atom-conduit >= 0.7,     binary,     conduit,@@ -48,7 +49,6 @@     directory >= 1.2.3.0,     filepath,     hashable,-    msgpack,     microlens,     monad-time,     pipes,@@ -70,7 +70,7 @@  executable imm   import: common-  build-depends: imm, aeson, async, atom-conduit >=0.7, bytestring, conduit, containers, dhall >= 1.27, directory, fast-logger, filepath, msgpack, opml-conduit >=0.7, optparse-applicative, prettyprinter-ansi-terminal, pipes, pipes-bytestring, refined >=0.4.1, rss-conduit >=0.4.1, safe, safe-exceptions, stm, stm-chans, text, typed-process, uri-bytestring, xml-conduit >=1.5, xml-types+  build-depends: imm, aeson, async, atom-conduit >=0.7, avro >=0.5, bytestring, conduit, containers, dhall >= 1.27, directory, fast-logger, filepath, opml-conduit >=0.7, optparse-applicative, prettyprinter-ansi-terminal, pipes, pipes-bytestring, refined >=0.4.1, rss-conduit >=0.4.1, safe, safe-exceptions, stm, stm-chans, text, typed-process, uri-bytestring, xml-conduit >=1.5, xml-types   main-is: Main.hs   other-modules: Alternate, Core, Database, HTTP, Logger, Options, Paths_imm, XML   autogen-modules: Paths_imm@@ -79,14 +79,14 @@  executable imm-writefile   import: common-  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+  build-depends: imm, atom-conduit, blaze-html, blaze-markup, bytestring, directory, filepath, optparse-applicative, prettyprinter, rss-conduit, 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, atom-conduit, blaze-html, blaze-markup, bytestring, dhall >= 1.27, directory, filepath, msgpack, mime-mail, optparse-applicative, prettyprinter, refined, rss-conduit, text, time, typed-process, uri-bytestring+  build-depends: imm, atom-conduit, blaze-html, blaze-markup, bytestring, dhall >= 1.27, directory, filepath, mime-mail, optparse-applicative, prettyprinter, refined, rss-conduit, text, time, typed-process, 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,20 +1,21 @@ {-# LANGUAGE DeriveGeneric     #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-} {-# LANGUAGE TypeApplications  #-}-module Imm.Callback where+module Imm.Callback (Callback(..), serializeMessage, deserializeMessage) where  -- {{{ Imports import           Imm.Feed -import qualified Data.Map                  as Map-import           Data.MessagePack.Object+import qualified Data.Avro                 as Avro+import           Data.Avro.Deriving import           Data.Text.Prettyprint.Doc import           Dhall                     hiding (maybe) -- }}}  -- | External program run for each feed element. ----- A `Message` is passed to this program through stdin, serialized in JSON.+-- Data is passed to that program through standard input (@stdin@), using Avro (<https://hackage.haskell.org/package/avro>) serialization format. The data schema is described in file @ids/callback.json@, provided with this library. data Callback = Callback   { _executable :: FilePath   , _arguments  :: [Text]@@ -26,16 +27,16 @@   pretty (Callback executable arguments) = pretty executable <+> sep (pretty <$> arguments)  --- | 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)+deriveAvroWithOptions defaultDeriveOptions "idl/callback.json" -instance MessagePack Message where-  toObject (Message feed element) = toObject @(Map Text Text)-    $ Map.insert "feed" (renderFeed feed)-    $ Map.insert "element" (renderFeedElement element) mempty+-- | Meant to be called by the main @imm@ process.+serializeMessage :: Feed -> FeedElement -> LByteString+serializeMessage feed element = Avro.encodeValue $ Message (renderFeed feed) (renderFeedElement element) -  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+-- | Meant to be called by callback process.+deserializeMessage :: MonadFail m => LByteString -> m (Feed, FeedElement)+deserializeMessage bytestring = do+  Message feedText elementText <- Avro.decodeValue bytestring & either fail pure+  feed <- parseFeed feedText & either (fail . displayException) pure+  element <- parseFeedElement elementText & either (fail . displayException) pure+  return (feed, element)
src/lib/Prelude.hs view
@@ -1,6 +1,6 @@ module Prelude (io, module Relude, module Relude.Extra.Map) where -import           Relude           hiding (Handle, force)+import           Relude           hiding (Handle, appendFile, force, readFile, writeFile) import           Relude.Extra.Map (lookup)  io :: MonadIO m => IO a -> m a
src/main/Main.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE RankNTypes            #-} {-# LANGUAGE RecordWildCards       #-} {-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-} -- {{{ Imports import           Alternate import qualified Core@@ -19,9 +20,9 @@ import           Control.Concurrent.STM.TMChan import           Control.Exception.Safe import           Data.Conduit.Combinators      as Conduit (stdin)-import qualified Data.MessagePack              as MsgPack import           Dhall import           Imm+import qualified Imm.Callback                  as Callback import           Imm.Database.Feed             as Database import qualified Imm.HTTP                      as HTTP import           Imm.Pretty@@ -117,7 +118,7 @@   -- New items events => execute callback => processed/error events   let runnerF (entryKey, feed, element) = do         results <- forM callbacks $ \callback@(Callback executable arguments) -> do-          let processInput = byteStringInput $ MsgPack.pack $ Message feed element+          let processInput = byteStringInput $ Callback.serializeMessage feed element               processConfig = proc executable (toString <$> arguments) & setStdin processInput            log logger Debug $ "Running" <+> cyan (pretty executable) <+> "on" <+> magenta (pretty entryKey) <+> "/" <+> yellow (pretty $ getTitle element)@@ -202,7 +203,9 @@   bold ("Fetch error for" <+> prettyURI uri)   <++> indent 2 (pretty $ displayException e) -printCallbackError :: Logger.Handle m -> ((EntryKey, FeedElement), _) -> m ()+printCallbackError :: i ~ (EntryKey, FeedElement)+                   => e ~ (Callback, Int, LByteString, LByteString)+                   => Logger.Handle m -> (i, [e]) -> m () printCallbackError logger ((entryKey, element), e) = log logger Error $   bold ("Callback error for" <+> pretty entryKey <+> "/" <+> pretty (getTitle element))   <++> indent 2 prettyErrors
src/main/Prelude.hs view
@@ -1,6 +1,6 @@ module Prelude (io, module Relude, module Relude.Extra.Map) where -import           Relude           hiding (Handle, force)+import           Relude           hiding (Handle, appendFile, force, readFile, writeFile) import           Relude.Extra.Map (lookup)  io :: MonadIO m => IO a -> m a
src/send-mail/Main.hs view
@@ -3,12 +3,11 @@ {-# LANGUAGE OverloadedStrings #-} -- | 'Callback' for @imm@ that sends a mail via a SMTP server the input RSS/Atom item. -- {{{ Imports-import           Imm.Callback+import qualified Imm.Callback         as Callback import           Imm.Feed import           Imm.Pretty -import           Data.ByteString      (getContents)-import qualified Data.MessagePack     as MsgPack+import           Data.ByteString.Lazy (getContents) import           Data.Text            as Text (intercalate) import           Data.Time import           Dhall                hiding (map, maybe)@@ -71,9 +70,9 @@   CliOptions configFile recipients dryRun <- parseOptions   Command executable arguments <- input auto $ fromString configFile -  message <- getContents <&> fromStrict <&> MsgPack.unpack+  message <- getContents <&> Callback.deserializeMessage   case message of-    Just (Message feed element) -> do+    Right (feed, element) -> do       timezone <- io getCurrentTimeZone       currentTime <- io getCurrentTime       let formatMail = FormatMail defaultFormatFrom defaultFormatSubject defaultFormatBody (const $ const recipients)@@ -88,7 +87,7 @@           ExitSuccess   -> exitSuccess           ExitFailure _ -> putStrLn (decodeUtf8 errors) >> exitFailure -    _ -> putStrLn "Invalid input" >> exitFailure+    Left e -> putStrLn ("Invalid input: " <> e) >> exitFailure    return () 
src/send-mail/Prelude.hs view
@@ -1,6 +1,6 @@ module Prelude (io, module Relude, module Relude.Extra.Map) where -import           Relude           hiding (Handle, force)+import           Relude           hiding (Handle, appendFile, force, readFile, writeFile) import           Relude.Extra.Map (lookup)  io :: MonadIO m => IO a -> m a
src/write-file/Main.hs view
@@ -4,24 +4,20 @@ -- -- Meant to be use as a callback for imm. -- {{{ Imports-import           Imm.Callback+import           Imm.Callback                  as Callback import           Imm.Feed import           Imm.Pretty -import           Data.ByteString               (getContents) import           Data.ByteString.Builder-import           Data.ByteString.Streaming     (toStreamingByteString)-import qualified Data.MessagePack              as MsgPack+import           Data.ByteString.Lazy          (getContents, writeFile) import qualified Data.Text                     as Text (null, replace) import           Data.Time import           Options.Applicative-import           Streaming.With import           System.Directory              (createDirectoryIfMissing) import           System.FilePath import           Text.Atom.Types import           Text.Blaze.Html.Renderer.Utf8-import           Text.Blaze.Html5              (Html, docTypeHtml,-                                                preEscapedToHtml, (!))+import           Text.Blaze.Html5              (Html, docTypeHtml, preEscapedToHtml, (!)) import qualified Text.Blaze.Html5              as H import qualified Text.Blaze.Html5.Attributes   as H (charset, href) import           Text.RSS.Types@@ -46,16 +42,17 @@ main :: IO () main = do   CliOptions directory dryRun <- parseOptions-  message <- getContents <&> fromStrict <&> MsgPack.unpack-  case message of-    Just (Message feed element) -> do+  input <- getContents <&> Callback.deserializeMessage++  case input :: Either String (Feed, FeedElement) of+    Right (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+        writeFile filePath $ toLazyByteString content+    Left e -> putStrLn ("Invalid input: " <> e) >> exitFailure   return ()  -- * Default behavior
src/write-file/Prelude.hs view
@@ -1,6 +1,6 @@ module Prelude (io, module Relude, module Relude.Extra.Map) where -import           Relude           hiding (Handle, force)+import           Relude           hiding (Handle, appendFile, force, readFile, writeFile) import           Relude.Extra.Map (lookup)  io :: MonadIO m => IO a -> m a