Servant+Selda.hs

{-# 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