Initial commit

.gitignore

@@ -0,0 +1,2 @@
+dist-newstyle
+.envrc

.stylish-haskell.yaml

@@ -0,0 +1,248 @@
+# stylish-haskell configuration file
+# ==================================
+
+# The stylish-haskell tool is mainly configured by specifying steps. These steps
+# are a list, so they have an order, and one specific step may appear more than
+# once (if needed). Each file is processed by these steps in the given order.
+steps:
+  # Convert some ASCII sequences to their Unicode equivalents. This is disabled
+  # by default.
+  # - unicode_syntax:
+  #     # In order to make this work, we also need to insert the UnicodeSyntax
+  #     # language pragma. If this flag is set to true, we insert it when it's
+  #     # not already present. You may want to disable it if you configure
+  #     # language extensions using some other method than pragmas. Default:
+  #     # true.
+  #     add_language_pragma: true
+
+  # Align the right hand side of some elements.  This is quite conservative
+  # and only applies to statements where each element occupies a single
+  # line.
+  - simple_align:
+      cases: false
+      top_level_patterns: false
+      records: false
+
+  # Import cleanup
+  - imports:
+      # There are different ways we can align names and lists.
+      #
+      # - global: Align the import names and import list throughout the entire
+      #   file.
+      #
+      # - file: Like global, but don't add padding when there are no qualified
+      #   imports in the file.
+      #
+      # - group: Only align the imports per group (a group is formed by adjacent
+      #   import lines).
+      #
+      # - none: Do not perform any alignment.
+      #
+      # Default: global.
+      align: none
+
+      # The following options affect only import list alignment.
+      #
+      # List align has following options:
+      #
+      # - after_alias: Import list is aligned with end of import including
+      #   'as' and 'hiding' keywords.
+      #
+      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
+      #   >                                          init, last, length)
+      #
+      # - with_alias: Import list is aligned with start of alias or hiding.
+      #
+      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
+      #   >                                 init, last, length)
+      #
+      # - new_line: Import list starts always on new line.
+      #
+      #   > import qualified Data.List      as List
+      #   >     (concat, foldl, foldr, head, init, last, length)
+      #
+      # Default: after_alias
+      list_align: new_line
+
+      # Right-pad the module names to align imports in a group:
+      #
+      # - true: a little more readable
+      #
+      #   > import qualified Data.List       as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #
+      # - false: diff-safe
+      #
+      #   > import qualified Data.List as List (concat, foldl, foldr, init,
+      #   >                                     last, length)
+      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #
+      # Default: true
+      pad_module_names: false
+
+      # Long list align style takes effect when import is too long. This is
+      # determined by 'columns' setting.
+      #
+      # - inline: This option will put as much specs on same line as possible.
+      #
+      # - new_line: Import list will start on new line.
+      #
+      # - new_line_multiline: Import list will start on new line when it's
+      #   short enough to fit to single line. Otherwise it'll be multiline.
+      #
+      # - multiline: One line per import list entry.
+      #   Type with constructor list acts like single import.
+      #
+      #   > import qualified Data.Map as M
+      #   >     ( empty
+      #   >     , singleton
+      #   >     , ...
+      #   >     , delete
+      #   >     )
+      #
+      # Default: inline
+      long_list_align: new_line_multiline
+
+      # Align empty list (importing instances)
+      #
+      # Empty list align has following options
+      #
+      # - inherit: inherit list_align setting
+      #
+      # - right_after: () is right after the module name:
+      #
+      #   > import Vector.Instances ()
+      #
+      # Default: inherit
+      empty_list_align: inherit
+
+      # List padding determines indentation of import list on lines after import.
+      # This option affects 'long_list_align'.
+      #
+      # - <integer>: constant value
+      #
+      # - module_name: align under start of module name.
+      #   Useful for 'file' and 'group' align settings.
+      list_padding: 7
+
+      # Separate lists option affects formatting of import list for type
+      # or class. The only difference is single space between type and list
+      # of constructors, selectors and class functions.
+      #
+      # - true: There is single space between Foldable type and list of it's
+      #   functions.
+      #
+      #   > import Data.Foldable (Foldable (fold, foldl, foldMap))
+      #
+      # - false: There is no space between Foldable type and list of it's
+      #   functions.
+      #
+      #   > import Data.Foldable (Foldable(fold, foldl, foldMap))
+      #
+      # Default: true
+      separate_lists: false
+
+      # Space surround option affects formatting of import lists on a single
+      # line. The only difference is single space after the initial
+      # parenthesis and a single space before the terminal parenthesis.
+      #
+      # - true: There is single space associated with the enclosing
+      #   parenthesis.
+      #
+      #   > import Data.Foo ( foo )
+      #
+      # - false: There is no space associated with the enclosing parenthesis
+      #
+      #   > import Data.Foo (foo)
+      #
+      # Default: false
+      space_surround: false
+
+  # Language pragmas
+  - language_pragmas:
+      # We can generate different styles of language pragma lists.
+      #
+      # - vertical: Vertical-spaced language pragmas, one per line.
+      #
+      # - compact: A more compact style.
+      #
+      # - compact_line: Similar to compact, but wrap each line with
+      #   `{-#LANGUAGE #-}'.
+      #
+      # Default: vertical.
+      style: vertical
+
+      # Align affects alignment of closing pragma brackets.
+      #
+      # - true: Brackets are aligned in same column.
+      #
+      # - false: Brackets are not aligned together. There is only one space
+      #   between actual import and closing bracket.
+      #
+      # Default: true
+      align: false
+
+      # stylish-haskell can detect redundancy of some language pragmas. If this
+      # is set to true, it will remove those redundant pragmas. Default: true.
+      remove_redundant: true
+
+  # Replace tabs by spaces. This is disabled by default.
+  # - tabs:
+  #     # Number of spaces to use for each tab. Default: 8, as specified by the
+  #     # Haskell report.
+  #     spaces: 8
+
+  # Remove trailing whitespace
+  - trailing_whitespace: {}
+
+  # Squash multiple spaces between the left and right hand sides of some
+  # elements into single spaces. Basically, this undoes the effect of
+  # simple_align but is a bit less conservative.
+  # - squash: {}
+
+# A common setting is the number of columns (parts of) code will be wrapped
+# to. Different steps take this into account. Default: 80.
+columns: 80
+
+# By default, line endings are converted according to the OS. You can override
+# preferred format here.
+#
+# - native: Native newline format. CRLF on Windows, LF on other OSes.
+#
+# - lf: Convert to LF ("\n").
+#
+# - crlf: Convert to CRLF ("\r\n").
+#
+# Default: native.
+newline: native
+
+# Sometimes, language extensions are specified in a cabal file or from the
+# command line instead of using language pragmas in the file. stylish-haskell
+# needs to be aware of these, so it can parse the file correctly.
+#
+# No language extensions are enabled by default.
+language_extensions:
+  - RecordWildCards
+  - TemplateHaskell
+  - QuasiQuotes
+  - LambdaCase
+  - TupleSections
+  - MultiParamTypeClasses
+  - TypeApplications
+  - DataKinds
+  - TypeFamilies
+  - FlexibleContexts
+  - NamedFieldPuns
+  - MultiWayIf
+  - PolyKinds
+  - ExplicitForAll
+  - FunctionalDependencies
+  - ExplicitNamespaces
+  - ScopedTypeVariables
+  - ExistentialQuantification
+  - InstanceSigs
+  - GeneralizedNewtypeDeriving
+  - BangPatterns

CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for reddit-pub
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

app/Main.hs

@@ -0,0 +1,8 @@
+module Main where
+
+import qualified MyLib (someFunc)
+
+main :: IO ()
+main = do
+  putStrLn "Hello, Haskell!"
+  MyLib.someFunc

config.dhall

@@ -0,0 +1,16 @@
+let config = ./dhall/package.dhall
+
+in    { amqp = config.AMQP::{
+        , vhost = "reddit"
+        , username = env:AMQP_USER as Text ? "reddit_pub"
+        , password = env:AMQP_PASS as Text ? "tester"
+        , host = env:AMQP_HOST as Text ? "127.0.0.1"
+        -- , host = "10.233.5.2"
+        }
+      , fetchers =
+        [ config.Fetcher::{ subreddit = "haskell" }
+        , config.Fetcher::{ subreddit = "scala" }
+        , config.Fetcher::{ subreddit = "pics", entries = 150 }
+        ]
+      }
+    : config.Type

default.nix

@@ -0,0 +1,17 @@
+{ mkDerivation, aeson, amqp, base, bytestring, dhall, lens
+, lens-aeson, lib, mtl, pipes, text, wreq
+}:
+mkDerivation {
+  pname = "reddit-pub";
+  version = "0.1.0.0";
+  src = ./.;
+  isLibrary = true;
+  isExecutable = true;
+  libraryHaskellDepends = [
+    aeson amqp base bytestring dhall lens lens-aeson mtl pipes text
+    wreq
+  ];
+  executableHaskellDepends = [ base ];
+  license = "unknown";
+  hydraPlatforms = lib.platforms.none;
+}

dhall/AMQP/Type.dhall

@@ -0,0 +1,5 @@
+{ vhost : Text
+, username : Text
+, password : Text
+, host : Text
+}

dhall/AMQP/default.dhall

@@ -0,0 +1,4 @@
+{ vhost = "/"
+, username = "guest"
+, host = "localhost"
+}

dhall/AMQP/package.dhall

@@ -0,0 +1 @@
+{ Type = ./Type.dhall, default = ./default.dhall }

dhall/Fetcher/Type.dhall

@@ -0,0 +1,4 @@
+{ subreddit : Text
+, entries : Natural
+, qualifier : Optional ../Qualifier/Type.dhall
+}

dhall/Fetcher/default.dhall

@@ -0,0 +1,3 @@
+{ entries = 50
+, qualifier = None ../Qualifier/Type.dhall
+}

dhall/Fetcher/package.dhall

@@ -0,0 +1 @@
+{ Type = ./Type.dhall, default = ./default.dhall }

dhall/Qualifier/Type.dhall

@@ -0,0 +1 @@
+< Top | Controversial >

dhall/Type.dhall

@@ -0,0 +1,3 @@
+{ amqp : ./AMQP/Type.dhall
+, fetchers : List ./Fetcher/Type.dhall
+}

dhall/default.dhall

@@ -0,0 +1 @@
+{ amqp = ./AMQP/default.dhall }

dhall/package.dhall

@@ -0,0 +1,5 @@
+{ Type = ./Type.dhall
+, default = ./default.dhall
+, AMQP = ./AMQP/package.dhall
+, Fetcher = ./Fetcher/package.dhall
+}

easy-dhall-nix.json

@@ -0,0 +1,7 @@
+{
+  "url": "https://github.com/justinwoo/easy-dhall-nix.git",
+  "rev": "9bd1bea0dcebe1d1d120c0fd1ba76683dc4a62e3",
+  "date": "2021-07-17T15:03:24+03:00",
+  "sha256": "1gdx1iqhr3ih3f2v304yjnpjqydpl0x4ngrg58qa4x5wlcr5rdhl",
+  "fetchSubmodules": false
+}

easy-hls-nix.json

@@ -0,0 +1,11 @@
+{
+  "url": "https://github.com/ssbothwell/easy-hls-nix",
+  "rev": "393ccab35104d5d49e0ff9eadf7b8654e87abffd",
+  "date": "2021-09-16T11:13:40-07:00",
+  "path": "/nix/store/dsfqcsiahsp9rkip4fsqzz32x0swa3d4-easy-hls-nix",
+  "sha256": "0q1qxlkzjqx2hvf9k2cp5a98vlvsj13lap6hm7gl1kkqp88ai1dw",
+  "fetchLFS": false,
+  "fetchSubmodules": false,
+  "deepClone": false,
+  "leaveDotGit": false
+}

rabbitmq.nix

@@ -0,0 +1,11 @@
+{ lib, config, pkgs, ... }:
+
+{
+  services.rabbitmq = {
+    enable = true;
+    listenAddress = "0.0.0.0";
+    managementPlugin.enable = true;
+  };
+  networking.firewall.allowedTCPPorts = [ 5672 15672 ];
+}
+

reddit-pub.cabal

@@ -0,0 +1,65 @@
+cabal-version:      2.4
+name:               reddit-pub
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author:             Mats Rauhala
+maintainer:         mats.rauhala@iki.fi
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files: CHANGELOG.md
+
+library
+    ghc-options:      -Wall
+    exposed-modules:  MyLib
+                      Data.Config
+                      Data.Deriving.Aeson
+                      Network.AMQP.Reddit
+                      Data.SubReddit
+                      Publish
+
+    -- Modules included in this library but not exported.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:    base ^>=4.14.1.0
+                    , amqp
+                    , aeson
+                    , lens
+                    , lens-aeson
+                    , mtl
+                    , text
+                    , bytestring
+                    , dhall
+                    , wreq
+                    , pipes
+    hs-source-dirs:   src
+    default-language: Haskell2010
+
+executable reddit-pub
+    main-is:          Main.hs
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:
+        base ^>=4.14.1.0,
+        reddit-pub
+
+    hs-source-dirs:   app
+    default-language: Haskell2010

shell.nix

@@ -0,0 +1,41 @@
+{ nixpkgs ? import <nixpkgs> {} }:
+
+with nixpkgs;
+
+let
+  easy-dhall-nix-src = with builtins;
+    fetchgit { inherit (fromJSON (readFile ./easy-dhall-nix.json)) url rev sha256 fetchSubmodules; };
+  easy-hls-src = fetchFromGitHub {
+    owner = "ssbothwell";
+    repo = "easy-hls-nix";
+    inherit (builtins.fromJSON (builtins.readFile ./easy-hls-nix.json)) rev sha256;
+  };
+  easy-hls = callPackage easy-hls-src { ghcVersions = [ hp.ghc.version ]; };
+  easy-dhall-nix = import easy-dhall-nix-src {};
+  hp = haskellPackages.extend (self: super: {
+    reddit_pub = self.callPackage ./. {};
+  });
+
+in
+
+hp.shellFor {
+  packages = h: [h.reddit_pub];
+  withHoogle = true;
+  buildInputs = [
+    easy-dhall-nix.dhall-lsp-simple
+    entr
+    cabal-install
+    haskellPackages.hlint
+    stylish-haskell
+    ghcid
+    easy-hls
+
+    sqlite-interactive
+    rrdtool
+
+    jq
+
+    haskellPackages.graphmod
+  ];
+}
+

src/Data/Config.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE TypeOperators #-}
+module Data.Config where
+
+import Control.Lens
+import Data.Text (Text)
+import Dhall (FromDhall, Generic, ToDhall, auto, inputFile)
+import Dhall.Deriving
+import Numeric.Natural (Natural)
+import Data.SubReddit (SubReddit)
+
+data AMQP = AMQP
+  { amqpVhost :: Text
+  , amqpUsername :: Text
+  , amqpPassword :: Text
+  , amqpHost :: Text
+  }
+  deriving stock (Generic, Show)
+  deriving (FromDhall, ToDhall)
+    via (Codec (Field (CamelCase <<< DropPrefix "amqp"))) AMQP
+
+host :: Lens' AMQP Text
+host = lens amqpHost (\ am txt -> am{amqpHost=txt})
+
+vhost :: Lens' AMQP Text
+vhost = lens amqpVhost (\ am txt -> am{amqpVhost=txt})
+
+username :: Lens' AMQP Text
+username = lens amqpUsername (\ am txt -> am{amqpUsername=txt})
+
+password :: Lens' AMQP Text
+password = lens amqpPassword (\ am txt -> am{amqpPassword=txt})
+
+data Fetcher = Fetcher
+  { fetcherSubreddit :: SubReddit
+  , fetcherEntries :: Natural
+  , fetcherQualifier :: Maybe Qualifier
+  }
+  deriving stock (Show, Generic)
+  deriving (FromDhall, ToDhall) via Codec (Field (CamelCase <<< DropPrefix "fetcher")) Fetcher
+
+subreddit :: Lens' Fetcher SubReddit
+subreddit = lens fetcherSubreddit (\ fe sr -> fe{fetcherSubreddit=sr})
+
+entries :: Lens' Fetcher Natural
+entries = lens fetcherEntries (\ fe nat -> fe{fetcherEntries=nat})
+
+data Qualifier = Top | Controversial
+  deriving stock (Show, Generic)
+  deriving (FromDhall, ToDhall) via Codec (Constructor TitleCase) Qualifier
+
+data Config = Config
+  { configAmqp :: AMQP
+  , configFetchers :: [Fetcher]
+  }
+  deriving stock (Generic, Show)
+  deriving (FromDhall, ToDhall)
+    via (Codec (Field (CamelCase <<< DropPrefix "config"))) Config
+
+amqp :: Lens' Config AMQP
+amqp = lens configAmqp (\ con am -> con{configAmqp=am})
+
+fetchers :: Lens' Config [Fetcher]
+fetchers = lens configFetchers (\ con fes -> con{configFetchers=fes})
+
+readConfig :: FilePath -> IO Config
+readConfig = inputFile auto

src/Data/Deriving/Aeson.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Data.Deriving.Aeson
+  ( AesonCodec(..)
+  , type (<<<)
+  , Field
+  , CamelCase
+  , DropPrefix
+  )
+  where
+
+import Control.Lens
+import Data.Aeson
+import qualified Data.Text.Strict.Lens as T
+import Dhall.Deriving
+import GHC.Generics (Generic, Rep)
+
+newtype AesonCodec codec a = AesonCodec a
+
+class ModifyAesonOptions a where
+  modifyAesonOptions :: Options -> Options
+
+instance (ModifyAesonOptions f, ModifyAesonOptions g) => ModifyAesonOptions (f <<< g) where
+  modifyAesonOptions = modifyAesonOptions @f . modifyAesonOptions @g
+
+instance TextFunction f => ModifyAesonOptions (Field f) where
+  modifyAesonOptions opts = opts{fieldLabelModifier = over T.packed (textFunction @f) }
+
+instance (Generic a, ModifyAesonOptions codec, GToJSON' Value Zero (Rep a))
+  => ToJSON (AesonCodec codec a) where
+  toJSON (AesonCodec a) =
+    genericToJSON (modifyAesonOptions @codec defaultOptions) a
+
+instance (ModifyAesonOptions codec, Generic a, GFromJSON Zero (Rep a))
+  => FromJSON (AesonCodec codec a) where
+  parseJSON va =
+    AesonCodec <$> genericParseJSON (modifyAesonOptions @codec defaultOptions) va

src/Data/SubReddit.hs

@@ -0,0 +1,9 @@
+{-# LANGUAGE DerivingVia #-}
+module Data.SubReddit where
+
+import Dhall (FromDhall, ToDhall)
+
+newtype SubReddit = SubReddit { getSubReddit :: String }
+  deriving Show
+  deriving (FromDhall, ToDhall) via String
+

src/MyLib.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedStrings #-}
+module MyLib (someFunc) where
+
+import Control.Exception (bracket)
+import Control.Lens
+import Data.Config
+import qualified Data.Text.Strict.Lens as T
+import Network.AMQP
+import Network.AMQP.Reddit (publishEntries)
+import Network.Wreq.Session (newSession)
+import Data.Text (Text)
+import qualified Data.ByteString.Lazy as LB
+import Control.Monad (void)
+import qualified Data.Aeson as A
+import Data.Functor.Contravariant ((>$<))
+import Publish (Publish(..))
+import Data.Foldable (for_)
+
+
+amqpPublisher :: Channel -> Text -> Publish IO LB.ByteString
+amqpPublisher channel exchange = Publish $ \lbs -> void $ publishMsg channel exchange "" (message lbs)
+  where
+    message lbs = newMsg
+      { msgBody = lbs
+      , msgDeliveryMode = Just Persistent
+      }
+
+someFunc :: IO ()
+someFunc = do
+  conf <- readConfig "./config.dhall"
+  let connect = openConnection
+                  (conf ^. amqp . host . T.unpacked)
+                  (conf ^. amqp . vhost)
+                  (conf ^. amqp . username)
+                  (conf ^. amqp . password)
+  bracket connect closeConnection $ \conn -> do
+    putStrLn "Hello"
+    chan <- openChannel conn
+    declareExchange chan newExchange { exchangeName = "reddit_posts", exchangeType = "fanout" }
+    sess <- newSession
+    let encoder = amqpPublisher chan "reddit_posts"
+    for_ (conf ^. fetchers) $ \fetcher -> do
+      print fetcher
+      publishEntries (A.encode >$< encoder) sess fetcher

src/Network/AMQP/Reddit.hs

@@ -0,0 +1,61 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+module Network.AMQP.Reddit where
+
+import Control.Lens
+import Data.Aeson (FromJSON, ToJSON, Value)
+import Data.Aeson.Lens
+import Data.Config
+import Data.Deriving.Aeson
+import Data.SubReddit
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Network.Wreq hiding (getWith)
+import Network.Wreq.Session (Session, getWith)
+import Pipes (Producer, (>->), for, runEffect)
+import qualified Pipes.Prelude as P
+import Publish
+import Data.Maybe (maybeToList)
+import Control.Monad.Trans (liftIO)
+
+data MessageType = Create | Update
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+newtype RedditId = RedditId Text
+  deriving stock (Show, Eq)
+  deriving (ToJSON, FromJSON) via Text
+
+data Message = Message
+  { messageType :: MessageType
+  , messageIdentifier :: RedditId
+  , messageContent :: Value
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving (ToJSON, FromJSON)
+    via AesonCodec (Field (CamelCase <<< DropPrefix "message")) Message
+
+messages :: Session -> SubReddit -> Producer Message IO ()
+messages sess sre = P.unfoldr go Nothing >-> P.concat
+  where
+    go :: Maybe Text -> IO (Either () ([Message], Maybe Text))
+    go after = do
+      let opts = defaults & header "User-Agent" .~ ["reddit-pubsub"] & param "after" .~ (maybeToList after)
+      r <- getWith opts sess ("https://www.reddit.com/r/" <> getSubReddit sre <> ".json")
+      let xs = r ^.. responseBody . key "data" . key "children" . _Array . traversed . key "data"
+          next = r ^? responseBody . key "data" . key "after" . _String
+          msgs = [Message Create (RedditId (entry ^. key "id" . _String)) entry | entry <- xs]
+      print next
+      pure $ Right (msgs, next)
+
+publishEntries :: Publish IO Message -> Session -> Fetcher -> IO ()
+publishEntries publisher sess fetcher =
+  runEffect $
+    for
+      (messages sess (fetcher ^. subreddit) >-> P.take (fromIntegral $ fetcher ^. entries))
+      (liftIO . publish publisher)

src/Publish.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE DerivingVia #-}
+module Publish where
+
+import Data.Functor.Contravariant
+
+newtype Publish m a = Publish { publish :: a -> m () }
+  deriving Contravariant via (Op (m ()))