28 lines
743 B
Haskell
28 lines
743 B
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
module Config where
|
|
|
|
import Control.Monad.Reader
|
|
import Control.Monad.Except
|
|
|
|
import Database.Persist
|
|
import Database.Persist.Sql
|
|
import Servant
|
|
|
|
data HandlerConfig = HandlerConfig
|
|
{ db :: ConnectionPool
|
|
}
|
|
|
|
newtype App a = App
|
|
{ runApp :: ReaderT HandlerConfig Handler a
|
|
} deriving (Functor, Applicative, Monad, MonadReader HandlerConfig, MonadError ServantErr, MonadIO)
|
|
|
|
appToServer :: HandlerConfig -> App :~> Handler
|
|
appToServer cfg = NT (flip runReaderT cfg . runApp)
|
|
|
|
runDB :: (MonadReader HandlerConfig m, MonadIO m) => SqlPersistT IO b -> m b
|
|
runDB query = do
|
|
db <- asks db
|
|
liftIO $ runSqlPool query db |