never executed always true always false

    1 module HelVM.HelIO.Control.Logger (
    2   loggerIOToPTextIO,
    3   loggerIOToIO,
    4   loggerToIO,
    5   removeLoggerT,
    6   removeLogger,
    7   runLoggerT,
    8   runLogger,
    9 
   10   logsFromLoggerT,
   11   logsFromLogger,
   12 
   13   loggerT,
   14   logger,
   15   withMessages,
   16 
   17   liftLogger,
   18 
   19   logMessageTupleList,
   20   logMessageTuple,
   21 
   22   logData,
   23   logMessage,
   24   logMessages,
   25 
   26   MonadLogger,
   27   LoggerT,
   28   Logger,
   29   WithMessages,
   30 ) where
   31 
   32 import           HelVM.HelIO.Control.Message
   33 
   34 import           Control.Monad.Writer.Lazy
   35 
   36 import           HelVM.HelIO.Extra
   37 
   38 import qualified Data.DList                  as D
   39 
   40 -- | DeConstructors
   41 loggerIOToPTextIO :: Show a => IO (Logger a) -> IO Text
   42 loggerIOToPTextIO a = showP <$> loggerIOToIO a
   43 
   44 loggerIOToIO :: IO (Logger a) -> IO a
   45 loggerIOToIO a = loggerToIO =<< a
   46 
   47 loggerToIO :: Logger a -> IO a
   48 loggerToIO = pure <$> removeLogger
   49 
   50 removeLoggerT :: Monad m => LoggerT m a -> m a
   51 removeLoggerT a = fst <$> runWriterT a
   52 
   53 removeLogger :: Logger a -> a
   54 removeLogger = fst <$> runWriter
   55 
   56 runLoggerT :: LoggerT m a -> m (a , Messages)
   57 runLoggerT = runWriterT
   58 
   59 runLogger :: Logger a -> (a , Messages)
   60 runLogger = runWriter
   61 
   62 -- | Logs
   63 logsFromLoggerT :: Monad m => LoggerT m a -> m Messages
   64 logsFromLoggerT a = snd <$> runWriterT a
   65 
   66 logsFromLogger :: Logger a -> Messages
   67 logsFromLogger = snd <$> runWriter
   68 
   69 -- | Constructors
   70 loggerT :: Monad m => m a -> LoggerT m a
   71 loggerT a = WriterT $ withMessages <$> a
   72 
   73 logger :: a -> Logger a
   74 logger a = WriterT  $ Identity $ withMessages a
   75 
   76 withMessages :: a -> WithMessages a
   77 withMessages a = (a , D.empty)
   78 
   79 -- | Lift
   80 liftLogger :: MonadLogger m => Logger a -> m a
   81 liftLogger = writer <$> runWriter
   82 
   83 -- | Append Messages
   84 logMessageTupleList :: MonadLogger m => [MessageTuple] -> m ()
   85 logMessageTupleList = logMessage <$> tupleListToMessage
   86 
   87 logMessageTuple :: MonadLogger m => MessageTuple -> m ()
   88 logMessageTuple = logMessage <$> logTupleToMessage
   89 
   90 logTupleToMessage :: MessageTuple -> Message
   91 logTupleToMessage (k , v) = k <> ": " <> v
   92 
   93 logData :: (MonadLogger m , Show a) => a -> m ()
   94 logData = logMessage <$> show
   95 
   96 logMessage :: MonadLogger m => Message -> m ()
   97 logMessage = logMessages <$> D.singleton
   98 
   99 logMessages :: MonadLogger m => Messages -> m ()
  100 logMessages = tell
  101 
  102 -- | Types
  103 type MonadLogger m = MonadWriter Messages m
  104 
  105 type LoggerT m = WriterT Messages m
  106 
  107 type Logger = Writer Messages
  108 
  109 type WithMessages a = (a , Messages)