module Sqel.Class.MigrationEffect where

import qualified Hasql.Session as Session
import Hasql.Session (Session)
import Hasql.Statement (Statement)

import Sqel.Migration.Statement (MigrationStatement, migrationSession)

class MigrationEffect m where
  runMigrationStatements :: [MigrationStatement] -> m ()
  runStatement_ :: q -> Statement q () -> m ()
  runStatement :: q -> Statement q [a] -> m [a]
  log :: Text -> m ()
  error :: Text -> m ()

instance MigrationEffect Session where
  runMigrationStatements :: [MigrationStatement] -> Session ()
runMigrationStatements = [MigrationStatement] -> Session ()
migrationSession
  runStatement_ :: forall q. q -> Statement q () -> Session ()
runStatement_ = forall params result.
params -> Statement params result -> Session result
Session.statement
  runStatement :: forall q a. q -> Statement q [a] -> Session [a]
runStatement = forall params result.
params -> Statement params result -> Session result
Session.statement
  log :: Text -> Session ()
log Text
_ = forall (f :: * -> *). Applicative f => f ()
unit
  error :: Text -> Session ()
error Text
_ = forall (f :: * -> *). Applicative f => f ()
unit

instance MigrationEffect (Const [MigrationStatement]) where
  runMigrationStatements :: [MigrationStatement] -> Const [MigrationStatement] ()
runMigrationStatements = forall {k} a (b :: k). a -> Const a b
Const
  runStatement_ :: forall q. q -> Statement q () -> Const [MigrationStatement] ()
runStatement_ q
_ Statement q ()
_ = forall {k} a (b :: k). a -> Const a b
Const []
  runStatement :: forall q a. q -> Statement q [a] -> Const [MigrationStatement] [a]
runStatement q
_ Statement q [a]
_ = forall {k} a (b :: k). a -> Const a b
Const []
  log :: Text -> Const [MigrationStatement] ()
log Text
_ = forall {k} a (b :: k). a -> Const a b
Const []
  error :: Text -> Const [MigrationStatement] ()
error Text
_ = forall {k} a (b :: k). a -> Const a b
Const []