Use pooling and add a general Reader record to the stack by default

src/Core.hs

@@ -5,7 +5,8 @@ import Control.Monad.Catch                (catch)
 import Data.Aeson                         (FromJSON, ToJSON)
 import qualified Data.Text                as T
 import Data.ByteString.Lazy.UTF8          (fromString)
-import Database.PostgreSQL.Simple         (Query)
+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)
@@ -13,6 +14,7 @@ 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
@@ -47,7 +49,9 @@ instance FromJSON User
 --
 -- Effects
 --
-type AppEff = Eff '[Database, FileSystem, Logger, Error ServerError, IOE]
+type AppEff = Eff '[Database, Reader AppEnv, FileSystem, Logger, Error ServerError, IOE]
+
+data AppEnv = AppEnv { pool :: Pool Connection }
 
 -- Database
 data Database :: Effect where
@@ -56,10 +60,10 @@ data Database :: Effect where
 
 type instance DispatchOf Database = 'Dynamic
 
-type DatabaseEffects es = (IOE :> es, Logger :> es, Error ServerError :> es)
+type DatabaseEffects es = (Reader AppEnv :> es, Logger :> es, Error ServerError :> es, IOE :> es)
 
 databaseRead  :: (Database :> es, Error ServerError :> es) => (Query, Int) -> Eff es (Maybe User)
-databaseRead  = send . DatabaseRead
+databaseRead = send . DatabaseRead
 
 databaseWrite :: (Database :> es, Error ServerError :> es) => (Query, String) -> Eff es ()
 databaseWrite = send . DatabaseWrite
@@ -78,11 +82,12 @@ runLoggerIO = interpret $ \_ -> \case
   WriteLog msg -> log msg
   where
     log :: (IOE :> es, Error ServerError :> es) => String -> Eff es ()
-    log msg = adapt $ putStrLn msg
+    log msg = liftIOE $ putStrLn msg
 
-adapt :: (IOE :> es, Error ServerError :> es) => IO a -> Eff es a
+-- Utility
+liftIOE :: (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
+liftIOE m = liftIO m `catch` \(e::IOException) -> do
     -- Log IOExceptions to stdout
     liftIO $ putStrLn $ "ERROR Exception: " ++ show e
     -- Throw a custom Servant ServerError