never executed always true always false

    1 {-# LANGUAGE GeneralisedNewtypeDeriving #-}
    2 
    3 module HelVM.HelMA.Automaton.Eff.Mock (
    4   ioExecMockEffBatch,
    5   ioExecMockEffWithInput,
    6 
    7   safeExecMockEffBatch,
    8   safeExecMockEffWithInput,
    9 
   10   execMockEffBatch,
   11   execMockEffWithInput,
   12 
   13   runMockEff,
   14   createMockEffData,
   15   calculateOutput,
   16 
   17   calculateLogsWithLevelInfo,
   18   calculateLogsWithLevelDebug,
   19 
   20   Mock (..),
   21   MockEffData,
   22   MockLoggerData,
   23   MockLog (..),
   24 ) where
   25 
   26 import           HelVM.HelMA.Automaton.API.IOTypes
   27 
   28 import           HelVM.HelMA.Automaton.Eff.MockEff
   29 import           HelVM.HelMA.Automaton.Eff.MockLogger
   30 import           HelVM.HelMA.Automaton.Eff.MonadEff
   31 
   32 import           HelVM.HelIO.Control.Message
   33 import           HelVM.HelIO.Control.Safe
   34 
   35 import           Control.Monad.Logger
   36 import           Control.Monad.Trans.Writer.CPS       (Writer, runWriter)
   37 import           Control.Monad.Writer.Class           (MonadWriter)
   38 
   39 import qualified Data.Sequence                        as Seq
   40 
   41 ioExecMockEffBatch :: SafeT Mock () -> IO MockData
   42 ioExecMockEffBatch = ioExecMockEffWithInput ""
   43 
   44 ioExecMockEffWithInput :: Input -> SafeT Mock () -> IO MockData
   45 ioExecMockEffWithInput i = safeToIO . safeExecMockEffWithInput i
   46 
   47 safeExecMockEffBatch :: SafeT Mock () -> Safe MockData
   48 safeExecMockEffBatch = safeExecMockEffWithInput ""
   49 
   50 safeExecMockEffWithInput :: Input -> SafeT Mock () -> Safe MockData
   51 safeExecMockEffWithInput i action = pure $ runMockEff i $ runSafeT action
   52 
   53 execMockEffBatch :: Mock () -> MockData
   54 execMockEffBatch = execMockEffWithInput ""
   55 
   56 execMockEffWithInput :: Input -> Mock () -> MockData
   57 execMockEffWithInput i action = runMockEff i $ Right <$> action
   58 
   59 ----
   60 
   61 runMockEff :: Input -> Mock (Safe ()) -> MockData
   62 runMockEff i mockEff = safeToMockData $ runWriter $ runStateT (unMock mockEff) $ createMockEffData i where
   63   safeToMockData ((Right _, io), logs) = (io, logs)
   64   safeToMockData ((Left msgs, io), logs) = (io, logs Seq.|> errLog) where
   65     errLog = MockLog defaultLoc "" LevelError $ toLogStr $ errorsToText msgs
   66 
   67 calculateOutput :: MockData -> Output
   68 calculateOutput = reverseOutput . fst
   69 
   70 calculateLogsWithLevelInfo :: MockData -> Output
   71 calculateLogsWithLevelInfo = filterLogsWithLevelInfo . snd
   72 
   73 calculateLogsWithLevelDebug :: MockData -> Output
   74 calculateLogsWithLevelDebug = filterLogsWithLevelDebug . snd
   75 
   76 ----
   77 
   78 instance MonadEff Mock where
   79   getContentsBS   = mockGetContentsBS
   80   getContentsText = mockGetContentsText
   81   getChar         = mockGetChar
   82   getLine         = mockGetLine
   83   putChar         = mockPutChar
   84   putLine         = mockPutLine
   85 
   86 instance MonadEff (SafeT Mock) where
   87   getContentsBS   = mockGetContentsBS
   88   getContentsText = mockGetContentsText
   89   getChar         = mockGetCharSafe
   90   getLine         = mockGetLineSafe
   91   putChar         = mockPutChar
   92   putLine         = mockPutLine
   93 
   94 instance {-# OVERLAPPING #-} MonadLogger Mock where
   95   monadLoggerLog loc src level msg = mockLog $ MockLog loc src level $ toLogStr msg
   96 
   97 ----
   98 
   99 newtype Mock a = Mock
  100   { unMock :: StateT MockEffData (Writer MockLoggerData) a
  101   }
  102   deriving newtype
  103     ( Functor
  104     , Applicative
  105     , Monad
  106     , MonadState MockEffData
  107     , MonadWriter MockLoggerData
  108     )
  109 
  110 type MockData = (MockEffData , MockLoggerData)