never executed always true always false

    1 module HelVM.HelMA.Automaton.API.Env where
    2 
    3 import           HelVM.HelMA.Automaton.API.AppOptions
    4 import           HelVM.HelMA.Automaton.API.IOTypes
    5 
    6 import qualified Codec.Picture                        as Picture
    7 
    8 import qualified RIO
    9 
   10 type Has env = (HasIO env, HasAppOptions env, RIO.HasLogFunc env)
   11 type HasIO env = (HasFileIO env, HasStdIO env)
   12 
   13 readSourceFileRio :: Has env => RIO.RIO env Source
   14 readSourceFileRio = readSourceFileWithOptions =<< optionsRio where
   15   readSourceFileWithOptions = readSourceFile <$> exec <*> file
   16   readSourceFile True = pure . toText
   17   readSourceFile _    = readTextFileRio
   18 
   19 readTextFileRio :: Has env => FilePath -> RIO.RIO env Source
   20 readTextFileRio = (RIO.view fileIOL >>=) . flip readTextFile
   21 
   22 readImageRio :: Has env => FilePath -> RIO.RIO env Picture.DynamicImage
   23 readImageRio = (RIO.view fileIOL >>=) . flip readImage
   24 
   25 putLTextLnRio :: Has env => LText -> RIO.RIO env ()
   26 putLTextLnRio = (RIO.view stdIOL >>=) . flip stdPutLTextLn
   27 
   28 getContentsTextRio :: Has env => RIO.RIO env LText
   29 getContentsTextRio = RIO.view stdIOL >>= stdGetContentsText
   30 
   31 putLBSLnRio :: Has env => LByteString -> RIO.RIO env ()
   32 putLBSLnRio = (RIO.view stdIOL >>=) . flip stdPutLBSLn
   33 
   34 getContentsBSRio :: Has env => RIO.RIO env LByteString
   35 getContentsBSRio = RIO.view stdIOL >>= stdGetContentsBS
   36 
   37 optionsRio :: Has env => RIO.RIO env AppOptions
   38 optionsRio = RIO.view appOptionsL
   39 
   40 logFuncRio :: Has env => RIO.RIO env RIO.LogFunc
   41 logFuncRio = RIO.view RIO.logFuncL
   42 
   43 data Env = Env
   44   { envFileIO  :: FileIO
   45   , envStdIO   :: StdIO
   46   , envOptions :: AppOptions
   47   , envLogFunc :: RIO.LogFunc
   48   }
   49 
   50 data FileIO = FileIO
   51   { readTextFile :: forall env. FilePath -> RIO.RIO env Source
   52   , readImage    :: forall env. FilePath -> RIO.RIO env Picture.DynamicImage
   53   }
   54 
   55 class HasFileIO env where
   56   fileIOL :: RIO.Lens' env FileIO
   57 
   58 instance HasFileIO Env where
   59   fileIOL = RIO.lens envFileIO (\x y -> x { envFileIO = y })
   60 
   61 data StdIO = StdIO
   62   { stdPutLTextLn      :: forall env. LText -> RIO.RIO env ()
   63   , stdGetContentsText :: forall env. RIO.RIO env LText
   64   , stdPutLBSLn        :: forall env. LByteString -> RIO.RIO env ()
   65   , stdGetContentsBS   :: forall env. RIO.RIO env LByteString
   66   }
   67 
   68 class HasStdIO env where
   69   stdIOL :: RIO.Lens' env StdIO
   70 
   71 instance HasStdIO Env where
   72   stdIOL = RIO.lens envStdIO (\x y -> x { envStdIO = y })
   73 
   74 class HasAppOptions env where
   75   appOptionsL :: RIO.Lens' env AppOptions
   76 
   77 instance HasAppOptions Env where
   78   appOptionsL = RIO.lens envOptions (\x y -> x { envOptions = y })
   79 
   80 instance RIO.HasLogFunc Env where
   81   logFuncL = RIO.lens envLogFunc (\x y -> x { envLogFunc = y })