Skip to content

Instantly share code, notes, and snippets.

@tungd
Created March 29, 2018 02:03
Show Gist options
  • Save tungd/8ce10d47a78899d65aa3aaf45f129d77 to your computer and use it in GitHub Desktop.
Save tungd/8ce10d47a78899d65aa3aaf45f129d77 to your computer and use it in GitHub Desktop.
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Selda where
import Data.Pool
import Database.Selda
import Database.Selda.Backend
import Database.Selda.PostgreSQL (pgOpen')
import RIO
import Servant
data Env = Env
{ envDbPool :: !(Pool SeldaConnection)
-- other configuration
}
class HasConnectionPool env where
connectionPoolL :: Lens' env (Pool SeldaConnection)
instance HasConnectionPool Env where
connectionPoolL = lens envDbPool (\env pool -> env { envDbPool = pool })
instance (HasConnectionPool env) => MonadSelda (RIO env) where
seldaConnection = do
pool <- view connectionPoolL
liftIO $ withResource pool pure
invalidateTable _ = pure ()
wrapTransaction commit rollback m = mask $ \restore -> do
x <- restore m `onException` rollback
commit
pure x
main :: IO ()
main = do
envDbPool <- createPool (pgOpen' Nothing "") seldaClose 4 2 10
serve api $ hoistServer api (runRIO Env{..}) app
api :: Proxy AppAPI = Proxy
app = undefined
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment