{-# LANGUAGE ImpredicativeTypes #-}

module TypeMachine.TM (
    -- * Monad
    TM,
    runTM,
    execTM,

    -- * Logging
    addLog,
    addLogs,

    -- * Utils
    toType,
) where

import Control.Monad (forM_)
import Control.Monad.Writer.Lazy
import Language.Haskell.TH hiding (Type, reifyType)
import TypeMachine.Log
import TypeMachine.Type

-- | The 'TM' (*TypeMachine*) monad can:
--
-- - Emit warning messages (e.g. when omitting that does not exist)
-- - Take advantage of the 'Language.Haskell.TH.Q' monad's features
type TM a = WriterT [TypeMachineLog] Q a

-- | Add a log message to issue
addLog :: TypeMachineLog -> TM ()
addLog :: TypeMachineLog -> TM ()
addLog TypeMachineLog
l = [TypeMachineLog] -> TM ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TypeMachineLog
l]

addLogs :: [TypeMachineLog] -> TM ()
addLogs :: [TypeMachineLog] -> TM ()
addLogs = [TypeMachineLog] -> TM ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell

-- | Execute a 'TM' computation and issue logs using the 'Q' monad
runTM :: TM a -> Q a
runTM :: forall a. TM a -> Q a
runTM TM a
t = do
    (res, logs) <- TM a -> Q (a, [TypeMachineLog])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT TM a
t
    forM_ logs $ reportWarning . formatLog
    return res

-- | Runs a 'TM', returns the logs to issue and the computation result
execTM :: TM a -> Q (a, [TypeMachineLog])
execTM :: forall a. TM a -> Q (a, [TypeMachineLog])
execTM = WriterT [TypeMachineLog] Q a -> Q (a, [TypeMachineLog])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT

-- | Takes an ADT name, returns the `Type` for that ADT
--
-- A utilitary function to use 'reifyType' in the 'TM' monad
toType :: Name -> TM Type
toType :: Name -> TM Type
toType = Q Type -> TM Type
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT [TypeMachineLog] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Q Type -> TM Type) -> (Name -> Q Type) -> Name -> TM Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Type
reifyType