Cleanup

HELPS.cabal

@@ -51,4 +51,6 @@ executable Main
     Core
     Database
     Handlers
+    Logger
+    Routes
   default-language: GHC2021

src/Core.hs

@@ -20,28 +20,7 @@ import Servant hiding                     ((:>), throwError)
 import qualified Servant                  as S
 
 --
--- Routes
---
-type Root = Get '[PlainText] T.Text
-
-type UserList = "user"
-  S.:> Get '[JSON] [User]
-
-type UserGet = "user"
-  S.:> Capture "userId" Int
-  S.:> Get '[JSON] User
-
-type UserPost = "user"
-  S.:> ReqBody '[PlainText] String
-  S.:> PostCreated '[PlainText] NoContent
-
-type AppAPI = Root
-  :<|> UserList
-  :<|> UserGet
-  :<|> UserPost
-
---
--- Core data
+-- Core data types
 --
 data User = User { userId :: Int, userName :: String}
   deriving (Show, Generic)
@@ -54,9 +33,6 @@ instance ToRow User where
 instance ToJSON User
 instance FromJSON User
 
---
--- Effects
---
 type AppEff = Eff '[ Database
                    , Reader AppEnv
                    , FileSystem
@@ -67,7 +43,6 @@ type AppEff = Eff '[ Database
 
 data AppEnv = AppEnv { pool :: Pool Connection }
 
--- Database
 data Database :: Effect where
   DatabaseRead
     :: (ToField a, Show a, FromRow b) => (Query, a) -> Database (Eff es) [b]
@@ -76,44 +51,8 @@ data Database :: Effect where
   DatabaseWrite
     :: (ToField a, Show a) => (Query, a) -> Database (Eff es) ()
 
-type instance DispatchOf Database = 'Dynamic
-
-type DatabaseEffects es = ( Reader AppEnv :> es
-                          , Logger :> es
-                          , Error ServerError :> es
-                          , IOE :> es
-                          )
-
-databaseRead
-  :: (ToField a, Show a, Database :> es, Error ServerError :> es)
-  => (Query, a) -> Eff es [User]
-databaseRead = send . DatabaseRead
-
-databaseRead_
-  :: (Database :> es, Error ServerError :> es) => Query -> Eff es [User]
-databaseRead_ = send . DatabaseRead_
-
-databaseWrite
-  :: (ToField a, Show a, Database :> es, Error ServerError :> es)
-  => (Query, a) -> Eff es ()
-databaseWrite = send . DatabaseWrite
-
--- Logger
 data Logger :: Effect where
-  WriteLog :: String -> Logger (Eff es) ()
-
-type instance DispatchOf Logger = 'Dynamic
-
-writeLog :: (Logger :> es, Error ServerError :> es) => String -> Eff es ()
-writeLog = send . WriteLog
-
-runLoggerIO :: (IOE :> es, Error ServerError :> es) =>
-  Eff (Logger : es) a -> Eff es a
-runLoggerIO = interpret $ \_ -> \case
-  WriteLog msg -> log msg
-  where
-    log :: (IOE :> es, Error ServerError :> es) => String -> Eff es ()
-    log msg = liftIOE $ putStrLn msg
+    WriteLog :: String -> Logger (Eff es) ()
 
 -- Utility
 liftIOE :: (IOE :> es, Error ServerError :> es) => IO a -> Eff es a

src/Database.hs

@@ -1,6 +1,7 @@
 module Database where
 
 import Core
+import Logger
 
 import Control.Exception            (IOException)
 import Data.Aeson                   (ToJSON)
@@ -15,6 +16,28 @@ import Effectful.Reader.Static
 import Effectful.State.Static.Local (State, get, put, evalState)
 import Servant hiding               ((:>), throwError)
 
+type instance DispatchOf Database = 'Dynamic
+
+type DatabaseEffects es = ( Reader AppEnv :> es 
+                          , Logger :> es
+                          , Error ServerError :> es
+                          , IOE :> es
+                          )
+
+databaseRead
+  :: (ToField a, Show a, Database :> es, Error ServerError :> es)
+  => (Query, a) -> Eff es [User]
+databaseRead = send . DatabaseRead
+
+databaseRead_
+  :: (Database :> es, Error ServerError :> es) => Query -> Eff es [User]
+databaseRead_ = send . DatabaseRead_
+
+databaseWrite
+  :: (ToField a, Show a, Database :> es, Error ServerError :> es)
+  => (Query, a) -> Eff es ()
+databaseWrite = send . DatabaseWrite
+
 runDatabaseDebug :: DatabaseEffects es => Eff (Database : es) a -> Eff es a
 runDatabaseDebug = interpret $ \_ -> \case
   DatabaseRead  (statement, values) -> do

src/Logger.hs

@@ -0,0 +1,24 @@
+module Logger where
+
+import Core
+
+import Effectful
+import Effectful.Dispatch.Dynamic
+import Effectful.Error.Static             (Error, throwError)
+import Effectful.FileSystem
+import Effectful.Reader.Static
+import GHC.Generics                       (Generic)
+import Servant                     hiding ((:>))
+
+type instance DispatchOf Logger = 'Dynamic
+
+writeLog :: (Logger :> es, Error ServerError :> es) => String -> Eff es ()
+writeLog = send . WriteLog
+
+runLoggerIO :: (IOE :> es, Error ServerError :> es) =>
+  Eff (Logger : es) a -> Eff es a
+runLoggerIO = interpret $ \_ -> \case
+  WriteLog msg -> log msg
+  where
+    log :: (IOE :> es, Error ServerError :> es) => String -> Eff es ()
+    log msg = liftIOE $ putStrLn msg

src/Main.hs

@@ -3,6 +3,8 @@ module Main (main) where
 import Core
 import Database
 import Handlers
+import Logger
+import Routes
 
 import Control.Monad.Except     (ExceptT (ExceptT))
 import Data.List

src/Routes.hs

@@ -0,0 +1,27 @@
+module Routes where
+
+import Core
+  
+import qualified Data.Text as T
+import Servant
+
+--
+-- Routes
+--
+type Root = Get '[PlainText] T.Text
+
+type UserList = "user"
+  :> Get '[JSON] [User]
+
+type UserGet = "user"
+  :> Capture "userId" Int
+  :> Get '[JSON] User
+
+type UserPost = "user"
+  :> ReqBody '[PlainText] String
+  :> PostCreated '[PlainText] NoContent
+
+type AppAPI = Root
+  :<|> UserList
+  :<|> UserGet
+  :<|> UserPost