Support logging to PSQL; general improvement to logging effect; cleanup and clarification of names

src/Core.hs

@@ -1,28 +1,45 @@
 module Core where
 
-import Control.Exception                  (IOException)
-import Control.Monad.Catch                (catch)
-import Data.Aeson                         (FromJSON, ToJSON)
-import qualified Data.Text                as T
-import Data.ByteString.Lazy.UTF8          (fromString)
-import Data.Pool                          (Pool)
-import Database.PostgreSQL.Simple         (Connection, Query)
-import Database.PostgreSQL.Simple.FromRow (FromRow, field, fromRow)
-import Database.PostgreSQL.Simple.ToField (ToField)
-import Database.PostgreSQL.Simple.ToRow   (ToRow, toRow)
+import Control.Exception                    (IOException)
+import Control.Monad.Catch                  (catch)
+import Data.Aeson                           (FromJSON, ToJSON)
+import Data.Pool                            (Pool)
+import qualified Data.Text                  as T
+import Database.PostgreSQL.Simple           (Connection, Query)
+import Database.PostgreSQL.Simple.FromField (FromField)
+import Database.PostgreSQL.Simple.FromRow   (FromRow, field, fromRow)
+import Database.PostgreSQL.Simple.ToField   (ToField, toField)
+import Database.PostgreSQL.Simple.ToRow     (ToRow, toRow)
 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                     ((:>), throwError)
-import qualified Servant                  as S
+import Effectful.Error.Static               (Error, throwError)
+import Effectful.FileSystem                 (FileSystem)
+import Effectful.Reader.Static              (Reader)
+import GHC.Generics                         (Generic)
+import Servant hiding                       ((:>), throwError)
 
 --
 -- Core data types
 --
-data User = User { userId :: Int, userName :: String}
+type AppEff = Eff '[ FileSystem
+                   , Logger
+                   , Database
+                   , Reader AppEnv
+                   , Error ServerError
+                   , IOE
+                   ]
+
+data AppEnv = AppEnv { pool :: Pool Connection }
+
+newtype UserId = UserId Int
+  deriving (Show, Generic, FromField, ToField, FromHttpApiData, ToHttpApiData)
+
+instance ToJSON UserId
+instance FromJSON UserId
+instance ToRow UserId
+instance FromRow UserId
+
+data User = User { userId :: UserId, userName :: T.Text}
   deriving (Show, Generic)
 
 instance FromRow User where
@@ -33,26 +50,22 @@ instance ToRow User where
 instance ToJSON User
 instance FromJSON User
 
-type AppEff = Eff '[ Database
-                   , Reader AppEnv
-                   , FileSystem
-                   , Logger
-                   , Error ServerError
-                   , IOE
-                   ]
-
-data AppEnv = AppEnv { pool :: Pool Connection }
-
 data Database :: Effect where
   DatabaseRead
     :: (ToField a, Show a, FromRow b) => (Query, a) -> Database (Eff es) [b]
   DatabaseRead_
     :: (FromRow b) => Query -> Database (Eff es) [b]
   DatabaseWrite
-    :: (ToField a, Show a) => (Query, a) -> Database (Eff es) ()
+    :: (ToRow a, Show a) => (Query, a) -> Database (Eff es) ()
 
 data Logger :: Effect where
-    WriteLog :: String -> Logger (Eff es) ()
+    WriteLog :: LogLevel -> String -> Logger (Eff es) ()
+
+data LogLevel = Info | Warning | Error
+  deriving (Show, Eq)
+
+instance ToField LogLevel where
+  toField level = toField (T.pack (show level))
 
 -- Utility
 liftIOE :: (IOE :> es, Error ServerError :> es) => IO a -> Eff es a