never executed always true always false

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