Beginning cleanup

src/Core.hs

@@ -17,6 +17,19 @@ import GHC.Generics                       (Generic)
 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
 --
@@ -67,26 +80,15 @@ runLoggerIO = interpret $ \_ -> \case
     log :: (IOE :> es, Error ServerError :> es) => String -> Eff es ()
     log msg = adapt $ putStrLn msg
 
--- Utility
 adapt :: (IOE :> es, Error ServerError :> es) => IO a -> Eff es a
+-- Lift IO into Eff and catch IOExceptions
 adapt m = liftIO m `catch` \(e::IOException) -> do
+    -- Log IOExceptions to stdout
     liftIO $ putStrLn $ "ERROR Exception: " ++ show e
+    -- Throw a custom Servant ServerError
     throwError $ ServerError
       { errHTTPCode     = 500
       , errReasonPhrase = "Internal Server Error"
       , errBody         = "This incident will be investigated."
       , errHeaders      = []
       }
-
---
--- 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 API = Root
-      :<|> UserList
-      :<|> UserGet
-      :<|> UserPost

src/Database.hs

@@ -17,10 +17,10 @@ runDatabaseDebug = interpret $ \_ -> \case
   DatabaseWrite (statement, values)  -> write statement values
   where
     read  _ values = 
-      writeLog "We just mocked a READ database operation" >>= \_ -> pure $ 
+      writeLog "Mocked a READ database operation" >>= \_ -> pure $ 
         Just (User values "Mock User")
     write _ values = 
-      writeLog $ "We just mocked a WRITE database operation with a user named " 
+      writeLog $ "Mocked a WRITE database operation with a user named "
         ++ values
 
 runDatabaseIO :: DatabaseEffects es => Eff (Database : es) a -> Eff es a

src/Main.hs

@@ -19,13 +19,13 @@ import qualified Servant        as S
 main :: IO ()
 main = run port $ serve proxy app
 
-app :: Server API
+app :: Server AppAPI
 app = α $ rootHandler
      :<|> userListHandler
      :<|> userGetHandler
      :<|> userPostHandler
 
-α :: ServerT API AppEff -> ServerT API Handler
+α :: ServerT AppAPI AppEff -> ServerT AppAPI Handler
 α = hoistServer proxy 
   $ Handler 
   . ExceptT 
@@ -38,5 +38,5 @@ app = α $ rootHandler
 port :: Int
 port = 8080
 
-proxy :: Proxy API
+proxy :: Proxy AppAPI
 proxy = Proxy