tonatona-persistent-postgresql-0.2.0.0: src/Tonatona/Persist/Postgresql.hs

module Tonatona.Persist.Postgresql
  ( run
  , TonaDbM
  , Config(..)
  , DbConnStr(..)
  , DbConnNum(..)
  , runMigrate
  ) where

import RIO

import Control.Monad.Logger as Logger (Loc, LoggingT(..), LogLevel, LogSource, LogStr, runStdoutLoggingT)
import Data.Pool (Pool)
import Database.Persist.Postgresql (withPostgresqlPool)
import Database.Persist.Sql (Migration, SqlBackend, runMigration, runSqlPool)

import Tonatona (HasConfig(..), HasParser(..))
import TonaParser ((.||), argLong, envVar, liftWith, optionalVal)

type TonaDbM env
  = ReaderT SqlBackend (RIO env)

runMigrate :: (HasConfig env Config) => Migration -> RIO env ()
runMigrate migration = run $ runMigration migration

-- | Main function.
run :: (HasConfig env Config) => TonaDbM env a -> RIO env a
run query = do
  pool <- asks (connPool . config)
  runSqlPool query pool

------------
-- Config --
------------

newtype DbConnStr = DbConnStr
  { unDbConnStr :: ByteString
  } deriving (Eq, IsString, Read, Show)

instance HasParser DbConnStr where
  parser = DbConnStr <$>
    optionalVal
      "Formatted string to connect postgreSQL"
      (argLong "db-conn-string" .|| envVar "DB_CONN_STRING")
      "postgresql://myuser:mypass@localhost:5432/mydb"

newtype DbConnNum = DbConnNum { unDbConnNum :: Int }
  deriving (Eq, Num, Read, Show)

instance HasParser DbConnNum where
  parser = DbConnNum <$>
    optionalVal
      "Number of connections which connection pool uses"
      ( argLong "db-conn-num" .|| envVar "DB_CONN_NUM")
      10

data Config = Config
  { connString :: DbConnStr
  , connNum :: DbConnNum
  , connPool :: Pool SqlBackend
  }

instance HasParser Config where
  parser = do
    connStr <- parser
    connNum <- parser
    liftWith $ \action -> do
      runLoggingT
        (withPostgresqlPool
           (unDbConnStr connStr)
           (unDbConnNum connNum)
           (lift . action . Config connStr connNum))
        stdoutLogger

stdoutLogger :: Loc -> Logger.LogSource -> Logger.LogLevel -> LogStr -> IO ()
stdoutLogger loc source level msg = do
  func <- runStdoutLoggingT $ LoggingT pure
  func loc source level msg