never executed always true always false

    1 module HelVM.HelIO.Control.Business (
    2   businessTToIO,
    3   businessTToIOWithoutLogs,
    4   businessTToIOWithLogs,
    5   businessToIO,
    6 
    7   runBusinessT,
    8   runBusiness,
    9 
   10   safeWithMessagesToText,
   11 
   12   businessT,
   13   business,
   14 
   15   safeWithMessages,
   16 
   17   MonadBusiness,
   18   BusinessT,
   19   Business,
   20 
   21   UnitSafeWithMessages,
   22   SafeWithMessages
   23 ) where
   24 
   25 import           HelVM.HelIO.Control.Logger
   26 import           HelVM.HelIO.Control.Message
   27 import           HelVM.HelIO.Control.Safe
   28 
   29 import           Control.Type.Operator
   30 
   31 import qualified System.IO                   as IO
   32 
   33 businessTToIO :: Bool -> BusinessT IO a -> IO a
   34 businessTToIO False = businessTToIOWithoutLogs
   35 businessTToIO True  = businessTToIOWithLogs
   36 
   37 businessTToIOWithoutLogs :: BusinessT IO a -> IO a
   38 businessTToIOWithoutLogs = safeWithMessagesToIOWithoutLogs <=< runBusinessT
   39 
   40 businessTToIOWithLogs :: BusinessT IO a -> IO a
   41 businessTToIOWithLogs = safeWithMessagesToIOWithLogs <=< runBusinessT
   42 
   43 businessToIO :: Business a -> IO a
   44 businessToIO = safeToIO <$> removeLogger
   45 
   46 runBusinessT :: BusinessT m a -> m $ SafeWithMessages a
   47 runBusinessT = runLoggerT <$> runSafeT
   48 
   49 runBusiness :: Business a -> SafeWithMessages a
   50 runBusiness a = runLogger $ runSafe <$> a
   51 
   52 safeWithMessagesToIOWithoutLogs :: SafeWithMessages a -> IO a
   53 safeWithMessagesToIOWithoutLogs (safe , _) = safeToIO safe
   54 
   55 safeWithMessagesToIOWithLogs :: SafeWithMessages a -> IO a
   56 safeWithMessagesToIOWithLogs (safe , logs) = safeToIO safe <* IO.hPutStr stderr (errorsToString logs)
   57 
   58 safeWithMessagesToText :: SafeWithMessages a -> Text
   59 safeWithMessagesToText (safe , messages) = errorsToText messages <> safeToText safe
   60 
   61 -- | Constructors
   62 businessT :: Monad m => m a -> BusinessT m a
   63 businessT = safeT <$> loggerT
   64 
   65 business :: a -> Business a
   66 business = logger <$> pure
   67 
   68 safeWithMessages :: a -> SafeWithMessages a
   69 safeWithMessages = withMessages <$> pure
   70 
   71 -- | Types
   72 type MonadBusiness m = (MonadLogger m , MonadSafe m)
   73 
   74 type BusinessT m = SafeT (LoggerT m)
   75 
   76 type Business a = Logger $ Safe a
   77 
   78 type UnitSafeWithMessages = SafeWithMessages ()
   79 
   80 type SafeWithMessages a = WithMessages (Safe a)