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