Use SERIAL for users id field; general cleanup

src/Core.hs

@@ -19,7 +19,8 @@ import Servant hiding                       ((:>), throwError)
 --
 -- Core data types
 --
-type AppEff = Eff '[ Logger
+type AppEff = 
+  Eff '[ Logger
        , Database
        , Reader AppEnv
        , Error ServerError

src/Database.hs

@@ -70,8 +70,8 @@ runDatabaseIO = interpret $ \_ -> \case
     init = do
       AppEnv { pool } <- ask
       liftWithPool pool $ \conn -> do
-        execute_ conn tableUsers
+        execute_ conn createUsersTable
-        execute_ conn tableLogs
+        execute_ conn createLogsTable
         pure ()
 
     read :: (ToField a, FromRow b, DatabaseExeEffects es)
@@ -112,14 +112,14 @@ writeUser name = ("INSERT INTO users (name) VALUES (?);", Only name)
 deleteUser :: UserId -> (Query, UserId)
 deleteUser userId = ("DELETE FROM users WHERE id = ?;", userId)
 
-tableUsers :: Query
+createUsersTable :: Query
-tableUsers = "CREATE TABLE IF NOT EXISTS users ( \
+createUsersTable = "CREATE TABLE IF NOT EXISTS users ( \
-                \id integer NOT NULL, \
+                   \  id SERIAL PRIMARY KEY, \
-                \name character varying(255) NOT NULL \
+                   \  name character varying(255) NOT NULL \
                    \);"
 
-tableLogs :: Query
+createLogsTable :: Query
-tableLogs = "CREATE TABLE IF NOT EXISTS logs ( \
+createLogsTable = "CREATE TABLE IF NOT EXISTS logs ( \
                   \  id SERIAL PRIMARY KEY, \
                   \  level VARCHAR(10) NOT NULL, \
                   \  message TEXT NOT NULL, \

src/Main.hs

@@ -22,25 +22,21 @@ main :: IO ()
 main = do
   pool   <- createConnectionPool 
   let env = AppEnv { pool = pool }
-  runEffStack env $ databaseInit
+  runAppEff env $ databaseInit
   run port . serve proxy $ app env
 
 app :: AppEnv -> Server AppAPI
-app env = transformEff env
+app env = hoistServer proxy (Handler . ExceptT . runAppEff env) handlers
-        $ rootHandler
+
+handlers :: ServerT AppAPI AppEff
+handlers = rootHandler
       :<|> userListHandler
       :<|> userGetHandler
       :<|> userPostHandler
       :<|> userDeleteHandler
 
-transformEff :: AppEnv -> ServerT AppAPI AppEff -> ServerT AppAPI Handler
+runAppEff :: AppEnv -> AppEff a -> IO (Either ServerError a)
-transformEff env = hoistServer proxy
+runAppEff env = runEff
-  $ Handler
-  . ExceptT
-  . runEffStack env
-
-runEffStack :: AppEnv -> AppEff a -> IO (Either ServerError a)
-runEffStack env = runEff
               . runErrorNoCallStack
               . runReader env
               . runDatabaseIO