24 lines
868 B
Haskell
24 lines
868 B
Haskell
{-# LANGUAGE GADTs #-}
|
|
|
|
module DB.Language where
|
|
|
|
import Control.Exception (Exception)
|
|
import Control.Monad.Free.Church (F, liftF)
|
|
import Database.PostgreSQL.Simple (Connection, FromRow, Query)
|
|
|
|
data SqlDBMethodF next where
|
|
SqlDBMethod :: FromRow r => (Connection -> Query -> IO [r]) -> ([r] -> next) -> SqlDBMethodF next
|
|
SqlThrowException :: Exception e => e -> (a -> next) -> SqlDBMethodF next
|
|
|
|
instance Functor SqlDBMethodF where
|
|
fmap f (SqlDBMethod runner next) = SqlDBMethod runner (f . next)
|
|
fmap f (SqlThrowException exceptionMsg next) = SqlThrowException exceptionMsg (f . next)
|
|
|
|
type SqlDb = F SqlDBMethodF
|
|
|
|
sqlDbMethod :: FromRow r => (Connection -> Query -> IO [r]) -> SqlDb [r]
|
|
sqlDbMethod action = liftF $ SqlDBMethod action id
|
|
|
|
sqlThrowException :: Exception e => e -> SqlDb a
|
|
sqlThrowException exception = liftF $ SqlThrowException exception id
|