imm 2.0.0.0 → 2.1.0.0
raw patch · 19 files changed
+251/−130 lines, 19 filesdep +basedep −base-nopreludedep ~directorydep ~streamlynew-component:exe:imm-monolith
Dependencies added: base
Dependencies removed: base-noprelude
Dependency ranges changed: directory, streamly
Files
- README.md +36/−16
- data/callbacks.dhall +8/−3
- default.nix +0/−80
- flake.nix +76/−0
- imm.cabal +11/−3
- shell.nix +0/−1
- src/lib/Imm/Pretty.hs +2/−2
- src/lib/Prelude.hs +4/−4
- src/main/Alternate.hs +4/−2
- src/main/Core.hs +1/−2
- src/main/Database/Async.hs +1/−1
- src/main/Database/Handle.hs +1/−1
- src/main/Logger.hs +2/−2
- src/main/Main.hs +1/−1
- src/main/Prelude.hs +4/−4
- src/monolith/Main.hs +73/−0
- src/monolith/Prelude.hs +19/−0
- src/send-mail/Prelude.hs +4/−4
- src/write-file/Prelude.hs +4/−4
README.md view
@@ -5,16 +5,16 @@ *imm* is written in [Haskell][2], configured in [Dhall][3]. The project includes: - a main executable `imm` that users run directly-- secondary executables (`imm-writefile`, `imm-sendmail`) which can be used as callbacks triggered by `imm`+- secondary executables (`imm-writefile`, `imm-sendmail`, `imm-monolith`) meant to be used as callbacks triggered by `imm` - a [Haskell][2] library, that exports functions useful to both the main executable and callbacks; the API is documented [in Hackage][1]. ## Installation ### Using nix -This repository includes a *nix* package that can be installed by running the following command at the root folder:+This repository is notably a [Nix flake][flakes] that can be installed by running the following command at the root folder: ```bash-nix-build --attr exe+nix build ``` ### Without nix@@ -25,6 +25,7 @@ ``` Then, the following runtime dependencies must be installed separately and provided in `PATH`:+- [monolith](https://github.com/Y2Z/monolith) (if using `imm-monolith`) - [pup](https://github.com/ericchiang/pup) ## Configuration@@ -66,23 +67,41 @@ ### Offline read-it-later -*imm* is able to store a local copy of unread elements, to read them later while offline for example. External links won't work offline though.+*imm* is able to store a local copy of unread elements, to read them later while offline for example. -```dhall-let Callback : Type =- { _executable : Text- , _arguments : List Text- }+There are 2 alternate ways of achieving this:+- using `imm-writefile` will produce a light HTML file with no stylesheets, no scripts and with links to online resources (images, fonts, ...) that won't be available offline:+ ```dhall+ let Callback : Type =+ { _executable : Text+ , _arguments : List Text+ } -let writeFile =- { _executable = "imm-writefile"- , _arguments = [ "-d", "/path/to/folder" ]- }+ let writeFile =+ { _executable = "imm-writefile"+ , _arguments = [ "-d", "/path/to/folder" ]+ } -let config : List Callback = [ writeFile ]-in config-```+ let config : List Callback = [ writeFile ]+ in config+ ```+- using `imm-monolith` will produce a heavy, self-contained HTML file, with embedded stylesheets, scripts, images and fonts; links to external web pages will still require an internet connection:+ ```dhall+ let Callback : Type =+ { _executable : Text+ , _arguments : List Text+ } + let downloadPage =+ { _executable = "imm-monolith"+ , _arguments = [ "-d", "/path/to/folder" ]+ }++ let config : List Callback = [ downloadPage ]+ in config+ ```++ ## Example usage - Subscribe to a feed through direct URL:@@ -123,3 +142,4 @@ [1]: http://hackage.haskell.org/package/imm [2]: https://www.haskell.org [3]: https://dhall-lang.org/+[flakes]: https://nixos.wiki/wiki/Flakes
data/callbacks.dhall view
@@ -5,8 +5,13 @@ , _arguments : List Text } --- Below are 2 basic callbacks bundled with imm.---+-- Below are 3 basic callbacks bundled with imm.+-- Check out `imm-monolith --help`+let downloadPage =+ { _executable = "imm-monolith"+ , _arguments = [ "-d", "/path/to/folder" ]+ }+ -- Check out `imm-writefile --help` let writeFile = { _executable = "imm-writefile"@@ -19,5 +24,5 @@ , _arguments = ["--login", "-u", "user@domain.com", "-P", "password", "-s", "smtp.domain.com", "-p", "587", "--to", "foo.bar@domain.com"] } -let config : List Callback = [ writeFile ]+let config : List Callback = [ downloadPage ] in config
− default.nix
@@ -1,80 +0,0 @@-{ nixpkgs ? import <nixpkgs> { } }:--let- hlib = nixpkgs.haskell.lib;-- source = nixpkgs.nix-gitignore.gitignoreSource [ ] ./.;- packageWithoutRuntimeDependencies =- myHaskellPackages.callCabal2nix "imm" source { };- packageWithRuntimeDependencies = with nixpkgs;- addRuntimeDependencies packageWithoutRuntimeDependencies [- pup- sqliteInteractive- ];-- exe = hlib.justStaticExecutables packageWithRuntimeDependencies;-- my-atom-conduit = {- pkg = "atom-conduit";- ver = "0.9.0.0";- sha256 = "11x41fxj0g93kg46z06i1kxfms84wqbad41i7fnm7ixpw4n464pp";- };-- my-beam = nixpkgs.fetchFromGitHub {- owner = "haskell-beam";- repo = "beam";- rev = "3bde0615b6eccfe5ca44ed907b79a3cd74eee33f";- sha256 = "0fy8p70pxhrllr2njwxa8lijf35hlds2zkhh7fkkv5b3i34jqx29";- };-- my-rss-conduit = {- pkg = "rss-conduit";- ver = "0.6.0.0";- sha256 = "1gdq1bv1ayx9qx9ppwld8b5qjfsq1pgkqd29qni3jcldw9w4wfb8";- };-- myHaskellPackages = nixpkgs.haskellPackages.override {- overrides = hself: hsuper:- let- fromHackage = x:- hlib.dontCheck (hlib.dontHaddock (hsuper.callHackageDirect x { }));- in {- imm = packageWithRuntimeDependencies;- atom-conduit = fromHackage my-atom-conduit;- beam-core = hself.callCabal2nix "beam-core" "${my-beam}/beam-core" {};- beam-migrate = hself.callCabal2nix "beam-core" "${my-beam}/beam-migrate" {};- beam-sqlite = hself.callCabal2nix "beam-core" "${my-beam}/beam-sqlite" {};- rss-conduit = fromHackage my-rss-conduit;- };- };-- addRuntimeDependencies = drv: xs:- hlib.overrideCabal drv (drv: {- buildDepends = (drv.buildDepends or [ ]) ++ [ nixpkgs.makeWrapper ];- postInstall = ''- ${drv.postInstall or ""}- for exe in "$out/bin/"* ; do- wrapProgram "$exe" --prefix PATH ":" \- ${nixpkgs.lib.makeBinPath xs}- done- '';- });-- shell = myHaskellPackages.shellFor {- packages = p: [ p.imm ];-- buildInputs = with nixpkgs; [- haskellPackages.cabal-install- haskellPackages.haskell-ci- haskellPackages.hlint- haskellPackages.ghcid- sqliteInteractive- ];-- withHoogle = false;- };--in {- inherit shell;- inherit exe;-}
+ flake.nix view
@@ -0,0 +1,76 @@+{+ description = "imm flake";++ inputs = {+ nixpkgs.url = "github:NixOS/nixpkgs/e9158eca70ae59e73fae23be5d13d3fa0cfc78b4";+ beam.url = "github:haskell-beam/beam/efd464b079755a781c2bb7a2fc030d6c141bbb8a";+ beam.flake = false;+ atom-conduit.url = "github:k0ral/atom-conduit/da353afcbf19a8cfebefa34bc5c4b81ee80322b3";+ atom-conduit.flake = false;+ rss-conduit.url = "github:k0ral/rss-conduit/c1fec73d715fd1c9a95a155e87ba469887b8e543";+ rss-conduit.flake = false;+ timerep.url = "github:HugoDaniel/timerep/aeb792b7ec701634016021b188e01091e9bd10df";+ timerep.flake = false;+ };++ outputs = { self, nixpkgs, beam, atom-conduit, rss-conduit, timerep }:+ let+ pkgs = import nixpkgs { system = "x86_64-linux"; };+ hlib = pkgs.haskell.lib;++ source = pkgs.nix-gitignore.gitignoreSource [ ] ./.;+ package = with pkgs;+ add-runtime-dependencies (my-haskell-packages.callCabal2nix "imm" source { }) [+ monolith+ pup+ sqliteInteractive+ ];+ executable = hlib.justStaticExecutables package;++ my-haskell-packages = pkgs.haskellPackages.override {+ overrides = hself: hsuper:+ let from-hackage = x: hlib.doJailbreak (hlib.dontCheck (hlib.dontHaddock (hsuper.callHackageDirect x { })));+ in {+ imm = package;+ atom-conduit = hself.callCabal2nix "atom-conduit" atom-conduit { };+ beam-core = hlib.doJailbreak (hself.callCabal2nix "beam-core" "${beam}/beam-core" { });+ beam-migrate = hlib.doJailbreak (hself.callCabal2nix "beam-core" "${beam}/beam-migrate" { });+ beam-sqlite = hlib.doJailbreak (hself.callCabal2nix "beam-core" "${beam}/beam-sqlite" { });+ rss-conduit = hself.callCabal2nix "rss-conduit" rss-conduit { };+ chronos = from-hackage {+ pkg = "chronos";+ ver = "1.1.1";+ sha256 = "gOHjPrDXgyZjfC/4qp7UwCj9FOopO5vGQaAKkRoCdRg=";+ };+ co-log = from-hackage {+ pkg = "co-log";+ ver = "0.4.0.1";+ sha256 = "r/thdqWagfWFFVntgxytOWIrERUj2WCFqZXyGTA9wxU=";+ };+ timerep = hself.callCabal2nix "timerep" timerep { };+ };+ };++ add-runtime-dependencies = drv: xs:+ hlib.overrideCabal drv (drv: {+ buildDepends = (drv.buildDepends or [ ]) ++ [ pkgs.makeWrapper ];+ postInstall = ''+ ${drv.postInstall or ""}+ for exe in "$out/bin/"* ; do+ wrapProgram "$exe" --prefix PATH ":" \+ ${nixpkgs.lib.makeBinPath xs}+ done+ '';+ });+ in {+ defaultPackage.x86_64-linux = executable;+ devShell = my-haskell-packages.shellFor {+ packages = p: [ p.imm ];++ buildInputs = [ my-haskell-packages.cabal-install my-haskell-packages.hlint pkgs.sqliteInteractive ];++ withHoogle = false;+ };+ };++}
imm.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: imm-version: 2.0.0.0+version: 2.1.0.0 synopsis: Execute arbitrary actions for each item from RSS/Atom feeds description: Cf README file homepage: https://github.com/k0ral/imm@@ -19,8 +19,9 @@ location: git://github.com/k0ral/imm.git common common- build-depends: base-noprelude >=4.7 && <5, relude+ build-depends: base >=4.7 && <5, relude default-language: Haskell2010+ mixins: base hiding (Prelude) other-modules: Prelude @@ -71,7 +72,7 @@ executable imm import: common- build-depends: imm, aeson, async, beam-core, beam-sqlite, bytestring, chronos, co-log, conduit, containers, dhall >= 1.27, directory, filepath, http-types, microlens, monad-time, optparse-applicative, prettyprinter-ansi-terminal, pipes, pipes-bytestring, pipes-http, safe, safe-exceptions, sqlite-simple, stm, stm-chans, streamly, text, time, typed-process, typerep-map, uri-bytestring, xml-conduit >=1.5, xml-types+ build-depends: imm, aeson, async, beam-core, beam-sqlite, bytestring, chronos, co-log, conduit, containers, dhall >= 1.27, directory, filepath, http-types, microlens, monad-time, optparse-applicative, prettyprinter-ansi-terminal, pipes, pipes-bytestring, pipes-http, safe, safe-exceptions, sqlite-simple, stm, stm-chans, streamly >=0.7, text, time, typed-process, typerep-map, uri-bytestring, xml-conduit >=1.5, xml-types main-is: Main.hs other-modules: Alternate@@ -89,6 +90,13 @@ XML autogen-modules: Paths_imm hs-source-dirs: src/main+ ghc-options: -Wall -fno-warn-unused-do-bind -threaded++executable imm-monolith+ import: common+ build-depends: imm, aeson, bytestring, directory, filepath, optparse-applicative, prettyprinter, safe-exceptions, text, time, typed-process, uri-bytestring+ main-is: Main.hs+ hs-source-dirs: src/monolith ghc-options: -Wall -fno-warn-unused-do-bind -threaded executable imm-writefile
− shell.nix
@@ -1,1 +0,0 @@-(import ./default.nix { }).shell
src/lib/Imm/Pretty.hs view
@@ -6,10 +6,10 @@ -- {{{ Imports import qualified Data.Text as Text-import Data.Text.Prettyprint.Doc as X hiding (list, width) import Data.Text.Prettyprint.Doc (list)-import Data.Text.Prettyprint.Doc.Render.Terminal as X (AnsiStyle)+import Data.Text.Prettyprint.Doc as X hiding (list, width) import Data.Text.Prettyprint.Doc.Render.Terminal+import Data.Text.Prettyprint.Doc.Render.Terminal as X (AnsiStyle) import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty import Data.Time import Data.Tree
src/lib/Prelude.hs view
@@ -1,8 +1,8 @@ module Prelude (for, io, headFail, headThrow, module Relude, module Relude.Extra.Map) where -import Relude hiding (Handle, appendFile, force, readFile, stdout, writeFile)-import Relude.Extra.Map (lookup) import Control.Exception.Safe+import Relude hiding (Handle, appendFile, force, readFile, stdout, writeFile)+import Relude.Extra.Map (lookup) io :: MonadIO m => IO a -> m a io = liftIO@@ -12,8 +12,8 @@ headThrow :: MonadThrow m => Exception e => e -> [a] -> m a headThrow _ (a:_) = return a-headThrow e _ = throwM e+headThrow e _ = throwM e headFail :: MonadFail m => String -> [a] -> m a headFail _ (a:_) = return a-headFail e _ = fail e+headFail e _ = fail e
src/main/Alternate.hs view
@@ -39,8 +39,10 @@ ] instance FromJSON AlternateLink where- parseJSON (Object v) = AlternateLink <$> v .: "title" <*> v .: "type" <*> v .: "href"- parseJSON _ = mzero+ parseJSON = withObject "AlternateLink" $ \v -> AlternateLink+ <$> (v .: "title" <|> pure mempty)+ <*> v .: "type"+ <*> v .: "href" asFeedURI :: MonadFail m => URI -> Text -> m URI
src/main/Core.hs view
@@ -16,9 +16,8 @@ -- {{{ Imports import Alternate-import Database.Record--- (FeedItemRecord (..), FeedItemStatus (..), FeedRecord (..), Inserted) import qualified Database.Handle as Database+import Database.Record import Output (putDocLn) import qualified Output
src/main/Database/Async.hs view
@@ -3,7 +3,7 @@ module Database.Async (withAsyncHandle) where import Database.Handle-import Output (putDocLn)+import Output (putDocLn) import qualified Output import Control.Concurrent.Async
src/main/Database/Handle.hs view
@@ -173,7 +173,7 @@ markAllFeedsAsUnprocessed :: MonadThrow m => Logger.Handle m -> Handle m -> m () markAllFeedsAsUnprocessed logger database = do- log logger Debug $ "Marking all feeds as unprocessed..."+ log logger Debug "Marking all feeds as unprocessed..." feeds <- _fetchAllFeeds database items <- _fetchAllItems database forM_ items $ \item -> _updateItemStatus database $ item { _itemStatus = markItemAsUnprocessed $ _itemStatus item }
src/main/Logger.hs view
@@ -12,7 +12,7 @@ import Chronos import Colog hiding (Severity (..))-import qualified Colog as Colog+import qualified Colog import Data.Text.Prettyprint.Doc.Render.Terminal import qualified Data.TypeRepMap as TypeRepMap import System.Directory@@ -56,4 +56,4 @@ <> " " <> text where showTime posixTime = "[" <> encode_YmdHMS (SubsecondPrecisionFixed 0) hyphen (timeToDatetime posixTime) <> "]" showThread (Just tid) = "[" <> show tid <> "]"- showThread _ = mempty+ showThread _ = mempty
src/main/Main.hs view
@@ -43,7 +43,7 @@ Subscribe u c -> Core.subscribe logger stdout database u c Unsubscribe query -> Core.unsubscribe logger database query Describe query -> Core.describeFeeds stdout database query- Reset query -> Core.markAsUnprocessed logger database query+ Reset query -> Core.markAsUnprocessed logger database query Run f c -> main2 logger stdout database f =<< resolveCallbacks c (inputCallbacksFile programInput) Database.commit logger database
src/main/Prelude.hs view
@@ -1,8 +1,8 @@ module Prelude (for, io, headFail, headThrow, module Relude, module Relude.Extra.Map) where -import Relude hiding (Handle, appendFile, force, readFile, stdout, writeFile)-import Relude.Extra.Map (lookup) import Control.Exception.Safe+import Relude hiding (Handle, appendFile, force, readFile, stdout, writeFile)+import Relude.Extra.Map (lookup) io :: MonadIO m => IO a -> m a io = liftIO@@ -12,8 +12,8 @@ headThrow :: MonadThrow m => Exception e => e -> [a] -> m a headThrow _ (a:_) = return a-headThrow e _ = throwM e+headThrow e _ = throwM e headFail :: MonadFail m => String -> [a] -> m a headFail _ (a:_) = return a-headFail e _ = fail e+headFail e _ = fail e
+ src/monolith/Main.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+-- | Download a self-contained HTML file, using monolith, related to the input RSS/Atom item.+--+-- Meant to be use as a callback for imm.+-- {{{ Imports+import Imm.Callback+import Imm.Feed+import Imm.Link+import Imm.Pretty++import Data.Aeson+import Data.ByteString.Lazy (getContents)+import qualified Data.Text as Text (replace)+import Data.Time+import Options.Applicative+import System.Directory (createDirectoryIfMissing)+import System.Exit (ExitCode)+import System.FilePath+import System.Process.Typed+import URI.ByteString.Extended+-- }}}++data CliOptions = CliOptions+ { _directory :: FilePath+ , _dryRun :: Bool+ } deriving (Eq, Ord, Read, Show)++parseOptions :: MonadIO m => m CliOptions+parseOptions = io $ customExecParser defaultPrefs (info cliOptions $ progDesc "Download a self-contained HTML file, using monolith, for each new RSS/Atom item. An intermediate folder will be created for each feed.")++cliOptions :: Parser CliOptions+cliOptions = CliOptions+ <$> strOption (long "directory" <> short 'd' <> metavar "PATH" <> help "Root directory where files will be created.")+ <*> switch (long "dry-run" <> help "Disable all I/Os, except for logs.")+++main :: IO ()+main = do+ CliOptions directory dryRun <- parseOptions+ input <- getContents <&> eitherDecode++ case input :: Either String CallbackMessage of+ Right (CallbackMessage feedDefinition item) -> do+ let filePath = defaultFilePath directory feedDefinition item+ putStrLn filePath+ unless dryRun $ do+ createDirectoryIfMissing True $ takeDirectory filePath+ case getMainLink item of+ Just link -> downloadPage filePath (_linkURI link) >>= exitWith+ _ -> putStrLn ("No main link in item " <> show (prettyName item)) >> exitFailure+ Left e -> putStrLn ("Invalid input: " <> e) >> exitFailure+ return ()++-- * Default behavior++downloadPage :: FilePath -> AnyURI -> IO ExitCode+downloadPage filePath uri = runProcess $ proc "monolith" ["-o", filePath, show $ pretty uri]+ & setStdin nullStream+ & setStdout inherit+ & setStderr inherit++-- | Generate a path @<root>/<feed title>/<element date>-<element title>.html@, where @<root>@ is the first argument+defaultFilePath :: FilePath -> FeedDefinition -> FeedItem -> FilePath+defaultFilePath root feedDefinition element = makeValid $ root </> toString title </> fileName <.> "html" where+ date = maybe "" (formatTime defaultTimeLocale "%F-") $ _itemDate element+ fileName = date <> toString (sanitize $ _itemTitle element)+ title = sanitize $ _feedTitle feedDefinition+ sanitize = appEndo (mconcat [Endo $ Text.replace (toText [s]) "_" | s <- pathSeparators])+ >>> Text.replace "." "_"+ >>> Text.replace "?" "_"+ >>> Text.replace "!" "_"+ >>> Text.replace "#" "_"
+ src/monolith/Prelude.hs view
@@ -0,0 +1,19 @@+module Prelude (for, io, headFail, headThrow, module Relude, module Relude.Extra.Map) where++import Control.Exception.Safe+import Relude hiding (Handle, appendFile, force, readFile, stdout, writeFile)+import Relude.Extra.Map (lookup)++io :: MonadIO m => IO a -> m a+io = liftIO++for :: [a] -> (a -> b) -> [b]+for = flip map++headThrow :: MonadThrow m => Exception e => e -> [a] -> m a+headThrow _ (a:_) = return a+headThrow e _ = throwM e++headFail :: MonadFail m => String -> [a] -> m a+headFail _ (a:_) = return a+headFail e _ = fail e
src/send-mail/Prelude.hs view
@@ -1,8 +1,8 @@ module Prelude (for, io, headFail, headThrow, module Relude, module Relude.Extra.Map) where -import Relude hiding (Handle, appendFile, force, readFile, stdout, writeFile)-import Relude.Extra.Map (lookup) import Control.Exception.Safe+import Relude hiding (Handle, appendFile, force, readFile, stdout, writeFile)+import Relude.Extra.Map (lookup) io :: MonadIO m => IO a -> m a io = liftIO@@ -12,8 +12,8 @@ headThrow :: MonadThrow m => Exception e => e -> [a] -> m a headThrow _ (a:_) = return a-headThrow e _ = throwM e+headThrow e _ = throwM e headFail :: MonadFail m => String -> [a] -> m a headFail _ (a:_) = return a-headFail e _ = fail e+headFail e _ = fail e
src/write-file/Prelude.hs view
@@ -1,8 +1,8 @@ module Prelude (for, io, headFail, headThrow, module Relude, module Relude.Extra.Map) where -import Relude hiding (Handle, appendFile, force, readFile, stdout, writeFile)-import Relude.Extra.Map (lookup) import Control.Exception.Safe+import Relude hiding (Handle, appendFile, force, readFile, stdout, writeFile)+import Relude.Extra.Map (lookup) io :: MonadIO m => IO a -> m a io = liftIO@@ -12,8 +12,8 @@ headThrow :: MonadThrow m => Exception e => e -> [a] -> m a headThrow _ (a:_) = return a-headThrow e _ = throwM e+headThrow e _ = throwM e headFail :: MonadFail m => String -> [a] -> m a headFail _ (a:_) = return a-headFail e _ = fail e+headFail e _ = fail e