Move message to MyLib

src/MyLib.hs

@@ -1,22 +1,56 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
 module MyLib (defaultMain) where
 
 import Control.Exception (bracket)
 import Control.Lens
 import Control.Monad (void)
+import Data.Aeson (FromJSON, ToJSON, Value)
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as LB
 import Data.Config
+import Data.Deriving.Aeson
 import Data.Foldable (for_)
 import Data.Functor.Contravariant ((>$<))
 import Data.Text (Text)
 import qualified Data.Text.Strict.Lens as T
+import qualified Database.SQLite.Simple as SQL
+import GHC.Generics (Generic)
+import qualified Membership
 import Network.AMQP
-import Network.Reddit (publishEntries, RedditId, messageIdentifier)
+       ( Channel
+       , DeliveryMode(Persistent)
+       , exchangeName
+       , exchangeType
+       , msgBody
+       , msgDeliveryMode
+       , newMsg
+       , publishMsg, openConnection, closeConnection, openChannel, newExchange, declareExchange
+       )
+import Network.Reddit (RedditId (RedditId), publishEntries)
 import Network.Wreq.Session (newSession)
 import Publish (Publish(..))
-import qualified Database.SQLite.Simple as SQL
-import qualified Membership
+import Data.Aeson.Lens (key, _String)
+
+data MessageType = Create | Update
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+data Message = Message
+  { messageType :: MessageType
+  , messageIdentifier :: RedditId
+  , messageContent :: Value
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving (ToJSON, FromJSON)
+    via AesonCodec (Field (CamelCase <<< DropPrefix "message")) Message
+
+toMessage :: Value -> Message
+toMessage entry = Message Create (RedditId (entry ^. key "id" . _String)) entry
 
 sqlRecorder :: SQL.Connection -> Publish IO RedditId
 sqlRecorder conn = Publish $ Membership.recordSeen conn
@@ -50,4 +84,4 @@ defaultMain = do
           publisher = (A.encode >$< encoder) <> (messageIdentifier >$< recorder)
       for_ (conf ^. fetchers) $ \fetcher -> do
         print fetcher
-        publishEntries publisher sess fetcher
+        publishEntries (toMessage >$< publisher) sess fetcher

src/Network/Reddit.hs

@@ -1,20 +1,15 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeOperators #-}
 module Network.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)
@@ -25,37 +20,25 @@ import Control.Monad.Trans (liftIO)
 import Database.SQLite.Simple.ToField (ToField)
 import Database.SQLite.Simple.FromField (FromField)
 
-data MessageType = Create | Update
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (ToJSON, FromJSON)
 
 newtype RedditId = RedditId Text
   deriving stock (Show, Eq)
   deriving (ToJSON, FromJSON, ToField, FromField) 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 :: Session -> SubReddit -> Producer Value IO ()
 messages sess sre = P.unfoldr go Nothing >-> P.concat
   where
-    go :: Maybe Text -> IO (Either () ([Message], Maybe Text))
+    go :: Maybe Text -> IO (Either () ([Value], Maybe Text))
     go after = do
-      let opts = defaults & header "User-Agent" .~ ["reddit-pubsub"] & param "after" .~ (maybeToList after)
+      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"
+      let msgs = 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 :: Publish IO Value -> Session -> Fetcher -> IO ()
 publishEntries publisher sess fetcher =
   runEffect $
     for