{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}

module Lib where

import Control.Monad.Free.Church (F, foldF, liftF, MonadFree)
import Database.PostgreSQL.Simple (Connection, FromRow, Query, query_)
import Data.Text (Text)
import DB.Interpreter (runDB)
import DB.Language (SqlDb, sqlDbMethod)
import Logger.Interpreter (runLogger)
import Logger.Language (Logger, logMessage)

data DSLMethod next where
  LogMsg :: Logger () -> (() -> next) -> DSLMethod next
  RunQuery :: FromRow r => Connection -> Query -> SqlDb [r] -> ([r] -> next) -> DSLMethod next

instance Functor DSLMethod where
  fmap f (LogMsg msg next) = LogMsg msg (f . next)
  fmap f (RunQuery conn squery act next) = RunQuery conn squery act (f . next)

type DSL = F DSLMethod

interpretDSLMethod :: DSLMethod a -> IO a
interpretDSLMethod (LogMsg logger next) =
  next <$> runLogger logger
interpretDSLMethod (RunQuery conn squery sql next) =
  next <$> runDB conn squery sql

runDSL :: DSL () -> IO ()
runDSL = foldF interpretDSLMethod

-- Smart constructors providing a convenient interface.
logMsg :: Text -> DSL ()
logMsg msg = liftF $ LogMsg (logMessage msg) id

runQuery :: (MonadFree DSLMethod m, FromRow r) => Connection -> Query -> m [r]
runQuery conn squery = liftF $ RunQuery conn squery (sqlDbMethod query_) id