{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}

-- | Provides the default interpretation for the logging effect.
module LibRISCV.Effects.Logging.Default.Interpreter where

import Control.Monad.Freer (type (~>))
import Control.Monad.IO.Class (MonadIO (..))
import LibRISCV.Effects.Logging.Language (
    LogInstructionFetch (..),
 )

-- | The default effectful logging interpreter which writes the
-- 'LibRISCV.Internal.Decoder.Opcodes.InstructionType' of a fetched instruction
-- to standard output, before executing it. This is particularly useful for
-- debugging but is quite verbose in the common case.
defaultLogging :: (MonadIO m) => LogInstructionFetch ~> m
defaultLogging :: forall (m :: * -> *). MonadIO m => LogInstructionFetch ~> m
defaultLogging =
    IO x -> m x
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO x -> m x)
-> (LogInstructionFetch x -> IO x) -> LogInstructionFetch x -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        LogFetched InstructionType
inst -> InstructionType -> IO ()
forall a. Show a => a -> IO ()
print InstructionType
inst

-- | A stub implementation of an effectful interpreter which ignores any logging
-- effects entirely. Should be used when no debugging output is desired.
noLogging :: (Monad m) => LogInstructionFetch ~> m
noLogging :: forall (m :: * -> *). Monad m => LogInstructionFetch ~> m
noLogging = \case
    LogFetched InstructionType
_ -> x -> m x
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()