never executed always true always false

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