src: Refactor DB and Logger out of lib

Signed-off-by: Sanchayan Maity <maitysanchayan@gmail.com>

src/DB/Interpreter.hs

@@ -0,0 +1,13 @@
+module DB.Interpreter where
+
+import Control.Exception (throwIO)
+import Control.Monad.Free.Church (foldF)
+import Database.PostgreSQL.Simple (Connection, Query)
+import DB.Language
+
+interpretSqlDBMethod :: Connection -> Query -> SqlDBMethodF a -> IO a
+interpretSqlDBMethod conn squery (SqlDBMethod runner next) = next <$> runner conn squery
+interpretSqlDBMethod _ _ (SqlThrowException exception _) = throwIO exception
+
+runDB :: Connection -> Query -> SqlDb a -> IO a
+runDB conn squery = foldF $ interpretSqlDBMethod conn squery

src/DB/Language.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE GADTs #-}
+
+module DB.Language where
+
+import Control.Exception (Exception)
+import Control.Monad.Free.Church (F, liftF)
+import Database.PostgreSQL.Simple (Connection, FromRow, Query)
+
+data SqlDBMethodF next where
+  SqlDBMethod :: FromRow r => (Connection -> Query -> IO [r]) -> ([r] -> next) -> SqlDBMethodF next
+  SqlThrowException :: Exception e => e -> (a -> next) -> SqlDBMethodF next
+
+instance Functor SqlDBMethodF where
+  fmap f (SqlDBMethod runner next) = SqlDBMethod runner (f . next)
+  fmap f (SqlThrowException exceptionMsg next) = SqlThrowException exceptionMsg (f . next)
+
+type SqlDb = F SqlDBMethodF
+
+sqlDbMethod :: FromRow r => (Connection -> Query -> IO [r]) -> SqlDb [r]
+sqlDbMethod action = liftF $ SqlDBMethod action id
+
+sqlThrowException :: Exception e => e -> SqlDb a
+sqlThrowException exception = liftF $ SqlThrowException exception id

src/Lib.hs

@@ -1,55 +1,15 @@
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 module Lib where
 
-import Control.Exception
+import Control.Monad.Free.Church (F, foldF, liftF, MonadFree)
-import Control.Monad.Free.Church
+import Database.PostgreSQL.Simple (Connection, FromRow, Query, query_)
-import Database.PostgreSQL.Simple
+import Data.Text (Text)
-import Data.Text
+import DB.Interpreter (runDB)
-
+import DB.Language (SqlDb, sqlDbMethod)
-data SqlDBMethodF next where
+import Logger.Interpreter (runLogger)
-  SqlDBMethod :: FromRow r => (Connection -> Query -> IO [r]) -> ([r] -> next) -> SqlDBMethodF next
+import Logger.Language (Logger, logMessage)
-  SqlThrowException :: Exception e => e -> (a -> next) -> SqlDBMethodF next
-
-instance Functor SqlDBMethodF where
-  fmap f (SqlDBMethod runner next) = SqlDBMethod runner (f . next)
-  fmap f (SqlThrowException exceptionMsg next) = SqlThrowException exceptionMsg (f . next)
-
-type SqlDb = F SqlDBMethodF
-
-sqlDbMethod :: FromRow r => (Connection -> Query -> IO [r]) -> SqlDb [r]
-sqlDbMethod action = liftF $ SqlDBMethod action id
-
-sqlThrowException :: Exception e => e -> SqlDb a
-sqlThrowException exception = liftF $ SqlThrowException exception id
-
-interpretSqlDBMethod :: Connection -> Query -> SqlDBMethodF a -> IO a
-interpretSqlDBMethod conn squery (SqlDBMethod runner next) = next <$> runner conn squery
-interpretSqlDBMethod _ _ (SqlThrowException exception _) = throwIO exception
-
-runDB :: Connection -> Query -> SqlDb a -> IO a
-runDB conn squery = foldF $ interpretSqlDBMethod conn squery
-
-data LoggerMethodF next where
-  LogMessage :: Text -> (() -> next) -> LoggerMethodF next
-
-instance Functor LoggerMethodF where
-  fmap f (LogMessage msg next) = LogMessage msg (f . next)
-
-type Logger = F LoggerMethodF
-
-logMessage :: Text -> Logger ()
-logMessage msg = liftF $ LogMessage msg id
-
-interpretLoggerMethod :: LoggerMethodF a -> IO a
-interpretLoggerMethod (LogMessage msg next) = next <$> print msg
-
-runLogger :: Logger () -> IO ()
-runLogger = foldF interpretLoggerMethod
 
 data DSLMethod next where
   LogMsg :: Logger () -> (() -> next) -> DSLMethod next

src/Logger/Interpreter.hs

@@ -0,0 +1,11 @@
+module Logger.Interpreter where
+
+import Control.Monad.Free.Church (foldF)
+import Logger.Language
+
+interpretLoggerMethod :: LoggerMethodF a -> IO a
+interpretLoggerMethod (LogMessage msg next) = next <$> print msg
+
+runLogger :: Logger () -> IO ()
+runLogger = foldF interpretLoggerMethod
+

src/Logger/Language.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE GADTs #-}
+
+module Logger.Language where
+
+import Control.Monad.Free.Church (F, liftF)
+import Data.Text (Text)
+
+data LoggerMethodF next where
+  LogMessage :: Text -> (() -> next) -> LoggerMethodF next
+
+instance Functor LoggerMethodF where
+  fmap f (LogMessage msg next) = LogMessage msg (f . next)
+
+type Logger = F LoggerMethodF
+
+logMessage :: Text -> Logger ()
+logMessage msg = liftF $ LogMessage msg id
+