never executed always true always false

    1 module HelVM.HelMA.Automaton.Eff.MonadEff
    2   ( AppEff
    3   , AppSafeEff
    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 AppSafeEff m = (MonadSafe m , AppEff m)
   24 
   25 type AppEff 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