Cleanup

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