never executed always true always false

    1 module HelVM.HelMA.Automaton.Eff.MockEff
    2   ( MockEffData (..)
    3   , MonadMockEff
    4   , MonadSafeMockEff
    5   , createMockEffData
    6   , mockGetChar
    7   , mockGetCharSafe
    8   , mockGetContents
    9   , mockGetContentsBS
   10   , mockGetContentsText
   11   , mockGetLine
   12   , mockGetLineSafe
   13   , mockPutChar
   14   , mockPutLine
   15   , reverseOutput
   16   ) where
   17 
   18 import           HelVM.HelMA.Automaton.API.IOTypes
   19 
   20 import           HelVM.HelIO.Control.Safe
   21 
   22 import           HelVM.HelIO.SequencesExtra
   23 
   24 import qualified Data.Sequences                    as S
   25 import qualified Data.Text                         as Text
   26 
   27 mockGetContentsBS ∷ MonadMockEff m ⇒ m LByteString
   28 mockGetContentsBS = fromStrict . encodeUtf8 <$> mockGetContentsText
   29 
   30 mockGetContentsText ∷ MonadMockEff m ⇒ m LText
   31 mockGetContentsText = fromStrict . toText <$> mockGetContents
   32 
   33 mockGetContents ∷ MonadMockEff m ⇒ m String
   34 mockGetContents = mockGetContents' =<< get where
   35   mockGetContents' ∷ MonadMockEff m ⇒ MockEffData → m String
   36   mockGetContents' mockEff = content <$ put mockEff { input = "" } where content = input mockEff
   37 
   38 mockGetChar ∷ MonadMockEff m ⇒ m Char
   39 mockGetChar = mockGetChar' =<< get where
   40   mockGetChar' ∷ MonadMockEff m ⇒ MockEffData → m Char
   41   mockGetChar' mockEff = orErrorTuple ("mockGetChar" , Text.show mockEff) (top (input mockEff)) <$ put mockEff { input = orErrorTuple ("mockGetChar" , Text.show mockEff) $ discard $ input mockEff }
   42 
   43 mockGetLine ∷ MonadMockEff m ⇒ m Text
   44 mockGetLine = mockGetLine' =<< get where
   45   mockGetLine' ∷ MonadMockEff m ⇒ MockEffData → m Text
   46   mockGetLine' mockEff = toText line <$ put mockEff { input = input' } where (line , input') = splitStringByLn $ input mockEff
   47 
   48 mockGetCharSafe ∷ MonadSafeMockEff m ⇒ m Char
   49 mockGetCharSafe = mockGetChar' =<< get where
   50   mockGetChar' ∷ MonadSafeMockEff m ⇒ MockEffData → m Char
   51   mockGetChar' mockEff = appendErrorTuple ("mockGetCharSafe" , Text.show mockEff) $ mockGetChar'' =<< unconsSafe (input mockEff) where
   52     mockGetChar'' (c, input') = put mockEff { input = input' } $> c
   53 
   54 mockGetLineSafe ∷ MonadSafeMockEff m ⇒ m Text
   55 mockGetLineSafe = mockGetLineSafe' =<< get where
   56   mockGetLineSafe' ∷ MonadSafeMockEff m ⇒ MockEffData → m Text
   57   mockGetLineSafe' mockEff = toText line <$ put mockEff { input = input' } where (line , input') = splitStringByLn $ input mockEff
   58 
   59 mockPutChar ∷ MonadMockEff m ⇒ Char → m ()
   60 mockPutChar = modify . mockDataPutChar
   61 
   62 mockPutLine ∷ MonadMockEff m ⇒ Text → m ()
   63 mockPutLine = modify . mockDataPutText
   64 
   65 ----
   66 
   67 createMockEffData ∷ Input → MockEffData
   68 createMockEffData = MockEffData "" . toString
   69 
   70 reverseOutput ∷ MockEffData → Output
   71 reverseOutput = reverseText . output
   72 
   73 reverseText ∷ String → Output
   74 reverseText = S.reverse . toText
   75 
   76 reverseString ∷ Output → String
   77 reverseString = toString . S.reverse
   78 
   79 mockDataPutChar ∷ Char → MockEffData → MockEffData
   80 mockDataPutChar char mockEff = mockEff { output = char : output mockEff }
   81 
   82 mockDataPutText ∷ Text → MockEffData → MockEffData
   83 mockDataPutText text mockEff = mockEff { output = reverseString text <> output mockEff }
   84 
   85 splitStringByLn ∷ String → (String , String)
   86 splitStringByLn = splitBy '\n'
   87 
   88 ----
   89 
   90 type MonadSafeMockEff m = (MonadSafe m , MonadMockEff m)
   91 type MonadMockEff m = MonadState MockEffData m
   92 
   93 data MockEffData
   94   = MockEffData
   95       { output :: !String
   96       , input  :: !String
   97       }
   98   deriving stock (Eq, Show)