ConsoleMock.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

module Axel.Test.Monad.ConsoleMock where

import Axel.Monad.Console as Console
import Axel.Monad.FileSystem as FS
import Axel.Monad.Process as Proc
import Axel.Monad.Resource as Res

import Control.Lens
import Control.Monad.State.Lazy

newtype ConsoleState = ConsoleState
  { _consoleOutput :: String
  } deriving (Eq, Show)

makeFieldsNoPrefix ''ConsoleState

mkConsoleState :: ConsoleState
mkConsoleState = ConsoleState {_consoleOutput = ""}

newtype ConsoleT m a =
  ConsoleT (StateT ConsoleState m a)
  deriving ( Functor
           , Applicative
           , Monad
           , MonadTrans
           , MonadFileSystem
           , MonadProcess
           , MonadResource
           )

type Console = ConsoleT Identity

instance (Monad m) => MonadConsole (ConsoleT m) where
  putStr str = ConsoleT $ consoleOutput <>= str

runConsoleT :: ConsoleState -> ConsoleT m a -> m (a, ConsoleState)
runConsoleT origState (ConsoleT x) = runStateT x origState

runConsole :: ConsoleState -> Console a -> (a, ConsoleState)
runConsole origState x = runIdentity $ runConsoleT origState x