Skip to content

Instantly share code, notes, and snippets.

@tungd
Created July 24, 2018 09:14
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save tungd/9f208fc9a1753a2b1055ea9c8f3b8536 to your computer and use it in GitHub Desktop.
Save tungd/9f208fc9a1753a2b1055ea9c8f3b8536 to your computer and use it in GitHub Desktop.
Example using database pool with `ReaderT`
#!/usr/bin/env stack
-- stack --resolver lts-12.0 --install-ghc runghc --package mtl --package resource-pool --package mysql-simple
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Reader
import Data.Pool
import Database.MySQL.Simple
-- Or newtype, if you don't need anything else here
data Env = Env { dbPool :: Pool Connection }
main = IO ()
main = do
pool <- createPool (connect connectionInfo) close 4 2 10
runReaderT main_ (Env pool)
-- flip runReaderT (Env pool) $ do
-- tables <- runDb $ \conn -> do
-- results :: [Only String] <- query_ conn "show tables"
-- pure results
-- liftIO $ print tables
where
connectionInfo = defaultConnectInfo
{ connectHost = "127.0.0.1"
, connectDatabase = "mysql"
, connectPassword = "root"
}
main_ :: ReaderT Env IO ()
main_ = do
tables :: [Only String] <- runDb $ \conn -> query_ conn "show tables"
liftIO $ print tables
-- If you like flexibility (requires FlexibleContexts)
-- runDb
-- :: (MonadReader Env m, MonadIO m)
-- => (Connection -> IO b) -> m b
runDb :: (Connection -> IO a) -> ReaderT Env IO a
runDb action = do
pool <- asks dbPool
liftIO $ withResource pool action
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment