never executed always true always false

    1 module HelVM.HelMA.Automaton.Eff.MonadEff (
    2   AppEff,
    3   MonadLoggerEff,
    4   MonadEff(..),
    5 ) where
    6 
    7 import           HelVM.HelIO.Control.Safe
    8 
    9 import           HelVM.HelIO.ReadText
   10 
   11 import           Control.Monad.Logger
   12 
   13 import qualified Data.ByteString.Lazy     as LByteString
   14 import qualified Data.Text.Lazy.IO        as LText
   15 
   16 import           Prelude                  hiding (getLine, putText)
   17 import qualified Prelude
   18 
   19 import qualified RIO
   20 
   21 import qualified System.IO                as IO
   22 
   23 type AppEff m = (MonadSafe m , MonadLoggerEff m)
   24 
   25 type MonadLoggerEff m = (MonadLogger m, MonadEff m)
   26 
   27 class Monad m => MonadEff m where
   28 
   29   putAsChar       :: Integral v => v -> m ()
   30   putAsDec        :: Integral v => v -> m ()
   31   getCharAs       :: Integral v => m v
   32   getDecAs        :: Integral v => m v
   33 
   34   putIntAsChar    :: Int -> m ()
   35   putIntAsDec     :: Int -> m ()
   36   getCharAsInt    :: m Int
   37   getDecAsInt     :: m Int
   38 
   39   getContentsBS   :: m LByteString
   40   getContentsText :: m LText
   41   getChar         :: m Char
   42   getLine         :: m Text
   43   putChar         :: Char -> m ()
   44   putLine         :: Text -> m ()
   45 
   46   flush           :: m ()
   47 
   48   putAsChar      = putIntAsChar . fromIntegral
   49   putAsDec       = putIntAsDec  . fromIntegral
   50   getCharAs      = fromIntegral <$> getCharAsInt
   51   getDecAs       = fromIntegral <$> getDecAsInt
   52 
   53   putIntAsChar   = putChar . chr
   54   putIntAsDec    = putLine . show
   55   getCharAsInt   = ord <$> getChar
   56   getDecAsInt    = readTextUnsafe <$> getLine
   57 
   58   flush          = pass
   59 
   60 instance MonadEff IO where
   61   getContentsBS   = LByteString.getContents
   62   getContentsText = LText.getContents
   63   getChar         = IO.getChar
   64   getLine         = Prelude.getLine
   65   putChar         = IO.putChar
   66   putLine         = Prelude.putText
   67   flush           = flushIO
   68 
   69 instance {-# OVERLAPPABLE #-} (MonadTrans t, Monad m, MonadEff m) => MonadEff (t m) where
   70   getContentsBS   = lift getContentsBS
   71   getContentsText = lift getContentsText
   72   getChar         = lift getChar
   73   getLine         = lift getLine
   74   putChar         = lift . putChar
   75   putLine         = lift . putLine
   76   flush           = lift flush
   77 
   78 instance RIO.HasLogFunc env => MonadEff (RIO.RIO env) where
   79   getContentsBS   = liftIO LByteString.getContents
   80   getContentsText = liftIO LText.getContents
   81   getChar         = liftIO IO.getChar
   82   getLine         = liftIO Prelude.getLine
   83   putChar         = liftIO . IO.putChar
   84   putLine         = liftIO . Prelude.putText
   85   flush           = liftIO flushIO
   86 
   87 ---- Internal
   88 
   89 flushIO :: IO ()
   90 flushIO = hFlush stdout