never executed always true always false

    1 {-# LANGUAGE FlexibleInstances #-}
    2 {-# LANGUAGE RankNTypes        #-}
    3 module HelVM.HelMA.Automaton.API.Env where
    4 
    5 import           HelVM.HelMA.Automaton.API.AppOptions
    6 import           HelVM.HelMA.Automaton.API.IOTypes
    7 
    8 import qualified Codec.Picture                        as Picture
    9 
   10 import           Lens.Micro.TH                        ( makeLenses )
   11 
   12 import qualified RIO
   13 
   14 data FileIO
   15   = FileIO
   16       { readTextFile :: forall env. FilePath -> RIO.RIO env Source
   17       , readImage    :: forall env. FilePath -> RIO.RIO env Picture.DynamicImage
   18       }
   19 
   20 data StdIO
   21   = StdIO
   22       { stdPutLTextLn      :: forall env. LText -> RIO.RIO env ()
   23       , stdGetContentsText :: forall env. RIO.RIO env LText
   24       , stdPutLBSLn        :: forall env. LByteString -> RIO.RIO env ()
   25       , stdGetContentsBS   :: forall env. RIO.RIO env LByteString
   26       }
   27 
   28 data Env
   29   = Env
   30       { _envFileIO  :: FileIO
   31       , _envStdIO   :: StdIO
   32       , _envOptions :: AppOptions
   33       , _envLogFunc :: RIO.LogFunc
   34       }
   35 
   36 makeLenses ''Env
   37 
   38 type Has env = (HasIO env, HasAppOptions env, RIO.HasLogFunc env)
   39 type HasIO env = (HasFileIO env, HasStdIO env)
   40 
   41 class HasFileIO env where
   42   fileIOL :: RIO.Lens' env FileIO
   43 
   44 instance HasFileIO Env where
   45   fileIOL = envFileIO
   46 
   47 class HasStdIO env where
   48   stdIOL :: RIO.Lens' env StdIO
   49 
   50 instance HasStdIO Env where
   51   stdIOL = envStdIO
   52 
   53 class HasAppOptions env where
   54   appOptionsL :: RIO.Lens' env AppOptions
   55 
   56 instance HasAppOptions Env where
   57   appOptionsL = envOptions
   58 
   59 instance RIO.HasLogFunc Env where
   60   logFuncL = envLogFunc
   61 
   62 readSourceFileRio ∷ Has env ⇒ RIO.RIO env Source
   63 readSourceFileRio = readSourceFileWithOptions =<< optionsRio where
   64   readSourceFileWithOptions = readSourceFile <$> exec <*> file
   65   readSourceFile True = pure . toText
   66   readSourceFile _    = readTextFileRio
   67 
   68 readTextFileRio ∷ Has env ⇒ FilePath → RIO.RIO env Source
   69 readTextFileRio fp = do
   70   io <- RIO.view fileIOL
   71   readTextFile io fp
   72 
   73 readImageRio ∷ Has env ⇒ FilePath → RIO.RIO env Picture.DynamicImage
   74 readImageRio fp = do
   75   io <- RIO.view fileIOL
   76   readImage io fp
   77 
   78 putLTextLnRio ∷ Has env ⇒ LText → RIO.RIO env ()
   79 putLTextLnRio text = do
   80   io <- RIO.view stdIOL
   81   stdPutLTextLn io text
   82 
   83 getContentsTextRio ∷ Has env ⇒ RIO.RIO env LText
   84 getContentsTextRio = do
   85   io <- RIO.view stdIOL
   86   stdGetContentsText io
   87 
   88 putLBSLnRio ∷ Has env ⇒ LByteString → RIO.RIO env ()
   89 putLBSLnRio lbs = do
   90   io <- RIO.view stdIOL
   91   stdPutLBSLn io lbs
   92 
   93 getContentsBSRio ∷ Has env ⇒ RIO.RIO env LByteString
   94 getContentsBSRio = do
   95   io <- RIO.view stdIOL
   96   stdGetContentsBS io
   97 
   98 optionsRio ∷ Has env ⇒ RIO.RIO env AppOptions
   99 optionsRio = RIO.view appOptionsL
  100 
  101 logFuncRio ∷ Has env ⇒ RIO.RIO env RIO.LogFunc
  102 logFuncRio = RIO.view RIO.logFuncL