never executed always true always false

    1 module HelVM.HelMA.Automaton.IO.BusinessIO (
    2 
    3   Element,
    4   BIO,
    5   BusinessIO,
    6 
    7   wPutAsChar,
    8   wPutAsDec,
    9   wGetCharAs,
   10   wGetDecAs,
   11 
   12 --  wPutIntAsChar,
   13 --  wPutIntAsDec,
   14 --  wGetCharAsInt,
   15 --  wGetDecAsInt,
   16 
   17   wGetContentsBS,
   18   wGetContentsText,
   19   wGetContents,
   20   wGetChar,
   21   wPutChar,
   22   wGetLine,
   23   wPutStr,
   24   wPutStrLn,
   25   wFlush,
   26   wLogStr,
   27   wLogStrLn,
   28   wLogShow,
   29 
   30   logStr,
   31   flush,
   32 ) where
   33 
   34 import           HelVM.HelIO.Control.Control
   35 import           HelVM.HelIO.Control.Safe
   36 
   37 import           HelVM.HelIO.ReadText
   38 
   39 import qualified Data.ByteString.Lazy        as LBS
   40 import           Data.Default                as Default
   41 import qualified Data.Text.Lazy              as LT
   42 import qualified Data.Text.Lazy.IO           as LT
   43 
   44 import           System.IO                   hiding (getLine, hFlush, stderr, stdout)
   45 
   46 type Element e  = (ReadShow e , Integral e , Default e)
   47 type ReadShow e = (Read e , Show e)
   48 type BIO m = (MonadControl m , BusinessIO m)
   49 
   50 class Monad m => BusinessIO m where
   51 
   52   wPutAsChar       :: Integral v => v -> m ()
   53   wPutAsDec        :: Integral v => v -> m ()
   54   wGetCharAs       :: Integral v => m v
   55   wGetDecAs        :: Integral v => m v
   56 
   57   wPutIntAsChar    :: Int -> m ()
   58   wPutIntAsDec     :: Int -> m ()
   59   wGetCharAsInt    :: m Int
   60   wGetDecAsInt     :: m Int
   61 
   62   wGetContentsBS   :: m LBS.ByteString
   63   wGetContentsText :: m LT.Text
   64   wGetContents     :: m String
   65   wGetChar         :: m Char
   66   wGetLine         :: m Text
   67   wPutChar         :: Char -> m ()
   68   wPutStr          :: Text -> m ()
   69   wPutStrLn        :: Text -> m ()
   70   wLogStr          :: Text -> m ()
   71   wLogStrLn        :: Text -> m ()
   72   wLogShow         :: Show s => s -> m ()
   73   wFlush           :: m ()
   74 
   75   wPutAsChar    = wPutIntAsChar . fromIntegral
   76   wPutAsDec     = wPutIntAsDec  . fromIntegral
   77   wGetCharAs    = fromIntegral <$> wGetCharAsInt
   78   wGetDecAs     = fromIntegral <$> wGetDecAsInt
   79 
   80   wPutIntAsChar = wPutChar . chr
   81   wPutIntAsDec  = wPutStr . show
   82   wGetCharAsInt = ord <$> wGetChar
   83   wGetDecAsInt  = readTextUnsafe <$> wGetLine
   84 
   85   wPutStrLn s   = wPutStr $ s <> "\n"
   86   wLogStrLn s   = wLogStr $ s <> "\n"
   87   wLogShow      = wLogStrLn . show
   88   wFlush        = pass
   89 
   90 logStr :: Text -> IO ()
   91 logStr = hPutStrLn stderr . toString
   92 
   93 flush :: IO ()
   94 flush = hFlush stdout
   95 
   96 instance BusinessIO IO where
   97   wGetContentsBS   = LBS.getContents
   98   wGetContentsText = LT.getContents
   99   wGetContents     = getContents
  100   wGetChar         = getChar
  101   wGetLine         = getLine
  102   wPutChar         = putChar
  103   wPutStr          = putText
  104   wPutStrLn        = putTextLn
  105   wLogStr          = logStr
  106   wFlush           = flush
  107 
  108 type ExceptTLegacy = ExceptT String
  109 
  110 exceptTLegacy :: Monad m => m a -> ExceptTLegacy m a
  111 exceptTLegacy a = ExceptT $ pure <$> a
  112 
  113 instance BusinessIO (ExceptT String IO) where --FIXXME
  114   wGetContentsBS   = exceptTLegacy   LBS.getContents
  115   wGetContentsText = exceptTLegacy   LT.getContents
  116   wGetContents     = exceptTLegacy   getContents
  117   wGetChar         = exceptTLegacy   getChar
  118   wGetLine         = exceptTLegacy   getLine
  119   wPutChar         = exceptTLegacy . putChar
  120   wPutStr          = exceptTLegacy . putText
  121   wPutStrLn        = exceptTLegacy . putTextLn
  122   wLogStr          = exceptTLegacy . logStr
  123   wFlush           = exceptTLegacy   flush
  124 
  125 instance BusinessIO (SafeT IO) where
  126   wGetContentsBS   = safeT   LBS.getContents
  127   wGetContentsText = safeT   LT.getContents
  128   wGetContents     = safeT   getContents
  129   wGetChar         = safeT   getChar
  130   wGetLine         = safeT   getLine
  131   wPutChar         = safeT . putChar
  132   wPutStr          = safeT . putText
  133   wPutStrLn        = safeT . putTextLn
  134   wLogStr          = safeT . logStr
  135   wFlush           = safeT   flush
  136 
  137 instance BusinessIO (ControlT IO) where
  138   wGetContentsBS   = controlT   LBS.getContents
  139   wGetContentsText = controlT   LT.getContents
  140   wGetContents     = controlT   getContents
  141   wGetChar         = controlT   getChar
  142   wGetLine         = controlT   getLine
  143   wPutChar         = controlT . putChar
  144   wPutStr          = controlT . putText
  145   wPutStrLn        = controlT . putTextLn
  146   wLogStr          = controlT . logStr
  147   wFlush           = controlT   flush