simple-logging 0.2.0.2 → 0.2.0.3

raw patch · 3 files changed

+49/−36 lines, 3 filesdep ~simple-effectsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: simple-effects

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• simple-logging.cabal +2/−2
• src/Control/Effects/Logging.hs +38/−34

@@ -1,3 +1,12 @@+# 0.2.0.3
+Updated to simple-effects-0.10.0.0
+
+# 0.2.0.2
+Colors in pretty printing
+Log data can now hold a summary
+Handler for logging all IO exceptions
+Handler for writing all log data to the file system
+
 # 0.2.0.1
 Fixed wrong pretty printing
 

@@ -1,5 +1,5 @@ name:                simple-logging-version:             0.2.0.2+version:             0.2.0.3 synopsis:            Logging effect to plug into the simple-effects framework homepage:            https://gitlab.com/haskell-hr/logging license:             MIT@@ -23,7 +23,7 @@                      , bytestring                      , iso8601-time                      , text-                     , simple-effects+                     , simple-effects >= 0.10.0.0                      , exceptions                      , mtl                      , string-conv

@@ -1,6 +1,8 @@ {-# LANGUAGE TypeFamilies, FlexibleContexts, MultiParamTypeClasses, RankNTypes, ConstraintKinds
            , RecordWildCards #-}
 {-# LANGUAGE GADTs, DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 -- | Use this module to add logging to your monad.
 --   A log is a structured value that can hold information like severity, log message, timestamp,
 --   callstack, etc.
@@ -32,13 +34,20 @@ 
 import Control.Effects.Early
 import Data.UUID
+import GHC.Generics
+import Data.Void
 
 -- | The logging effect.
-data Logging = Logging
-data instance Effect Logging method mr where
-    LoggingMsg :: Log -> Effect Logging 'Logging 'Msg
-    LoggingRes :: Effect Logging 'Logging 'Res
+data Logging
+instance Effect Logging where
+    data EffMethods Logging m = LoggingMethods
+        { _logEffect :: Log -> m () }
+        deriving (Generic)
 
+-- | Send a single log into the stream.
+logEffect :: MonadEffect Logging m => Log -> m ()
+LoggingMethods logEffect = effect
+
 -- | Arbitrary piece of text. Logs contain a list of these.
 newtype Tag     = Tag     Text deriving (Eq, Ord, Read, Show)
 
@@ -123,17 +132,13 @@ newtype GenericException = GenericException Text deriving (Eq, Ord, Read, Show)
 instance Exception GenericException
 
--- | Send a single log into the stream.
-logEffect :: MonadEffect Logging m => Log -> m ()
-logEffect = void . effect . LoggingMsg
-
 -- | A generic handler for logs. Since it's polymorphic in 'm' you can choose to emit more logs
 --   and make it a log transformer instead.
-handleLogging :: Functor m => (Log -> m ()) -> EffectHandler Logging m a -> m a
-handleLogging f = handleEffect (\(LoggingMsg l) -> LoggingRes <$ f l)
+handleLogging :: Functor m => (Log -> m ()) -> RuntimeImplemented Logging m a -> m a
+handleLogging f = implement (LoggingMethods f)
 
 -- | Add a new context on top of every log that comes from the given computation.
-layerLogs :: (HasCallStack, MonadEffect Logging m) => Context -> EffectHandler Logging m a -> m a
+layerLogs :: (HasCallStack, MonadEffect Logging m) => Context -> RuntimeImplemented Logging m a -> m a
 layerLogs ctx = handleLogging (\log' -> logEffect (log' { logContext = ctx : logContext log' }))
 
 -- | Get the bottom-most context if it exists.
@@ -157,7 +162,7 @@ 
 -- | Log an error and then throw a checked exception.
 --   Read about checked exceptions in 'Control.Effects.Signal'.
-logAndThrowsErr :: (MonadEffect Logging m, Throws e m, HasCallStack) => Text -> e -> m a
+logAndThrowsErr :: (MonadEffects '[Logging, Signal e Void] m, HasCallStack) => Text -> e -> m a
 logAndThrowsErr msg err = logError msg >> throwSignal err
 
 -- | Log an error and throw a generic exception containing the text of the error message.
@@ -166,40 +171,40 @@ 
 -- | Log a stripped-down version of the logs to the console.
 --   Only contains the message and the severity.
-logMessagesToStdout :: MonadIO m => EffectHandler Logging m a -> m a
+logMessagesToStdout :: MonadIO m => RuntimeImplemented Logging m a -> m a
 logMessagesToStdout = handleLogging (\Log{..} -> putText (pshow logLevel <> ": " <> logMessage))
 
 -- | Log everything to the console. Uses the 'Show' instance for 'Log'.
-logRawToStdout :: MonadIO m => EffectHandler Logging m a -> m a
+logRawToStdout :: MonadIO m => RuntimeImplemented Logging m a -> m a
 logRawToStdout = handleLogging print
 
 -- | Discard the logs.
-muteLogs :: Monad m => EffectHandler Logging m a -> m a
+muteLogs :: Monad m => RuntimeImplemented Logging m a -> m a
 muteLogs = handleLogging (const (return ()))
 
 -- | Use the given function to transform and possibly discard logs.
-witherLogs :: MonadEffect Logging m => (Log -> m (Maybe Log)) -> EffectHandler Logging m a -> m a
+witherLogs :: MonadEffect Logging m => (Log -> m (Maybe Log)) -> RuntimeImplemented Logging m a -> m a
 witherLogs f = handleLogging $ f >=> maybe (return ()) logEffect
 
 -- | Only let through logs that satisfy the given predicate.
-filterLogs :: MonadEffect Logging m => (Log -> Bool) -> EffectHandler Logging m a -> m a
+filterLogs :: MonadEffect Logging m => (Log -> Bool) -> RuntimeImplemented Logging m a -> m a
 filterLogs f = witherLogs (\l -> return $ if f l then Just l else Nothing)
 
 -- | Transform logs with the given function.
-mapLogs :: MonadEffect Logging m => (Log -> m Log) -> EffectHandler Logging m a -> m a
+mapLogs :: MonadEffect Logging m => (Log -> m Log) -> RuntimeImplemented Logging m a -> m a
 mapLogs f = witherLogs ((Just <$>) . f)
 
 -- | Filter out logs that are comming from below a certain depth.
-logIfDepthLessThan :: MonadEffect Logging m => Int -> EffectHandler Logging m a -> m a
+logIfDepthLessThan :: MonadEffect Logging m => Int -> RuntimeImplemented Logging m a -> m a
 logIfDepthLessThan n = logIfDepth (< n)
 
 -- | Filter logs whose depth satisfies the given predicate.
-logIfDepth :: MonadEffect Logging m => (Int -> Bool) -> EffectHandler Logging m a -> m a
+logIfDepth :: MonadEffect Logging m => (Int -> Bool) -> RuntimeImplemented Logging m a -> m a
 logIfDepth cond = filterLogs (\Log{..} -> cond (length logContext))
 
 -- | For each log, add it's message to the logs breadcrumb list. This is useful so you don't have
 --   to manually add crumbs.
-messagesToCrumbs :: (MonadIO m, MonadEffect Logging m) => EffectHandler Logging m a -> m a
+messagesToCrumbs :: (MonadIO m, MonadEffect Logging m) => RuntimeImplemented Logging m a -> m a
 messagesToCrumbs = mapLogs $ \l@Log{..} -> do
     time <- liftIO getCurrentTime
     let cat = Text.intercalate "." (fmap getContext logContext)
@@ -209,7 +214,7 @@ --   If, for example, you're writing a web server, you might want to have this handler over the
 --   request handler so that if an error occurs you can see all the steps that happened before it,
 --   during the handling of that request.
-collectCrumbs :: MonadEffect Logging m => EffectHandler Logging (StateT [Crumb] m) a -> m a
+collectCrumbs :: MonadEffect Logging m => RuntimeImplemented Logging (StateT [Crumb] m) a -> m a
 collectCrumbs = flip evalStateT [] . mapLogs (\l@Log{..} -> do
     crumbs <- get
     let newCrumbs = crumbs ++ logCrumbs
@@ -217,37 +222,37 @@     return (l { logCrumbs = newCrumbs }))
 
 -- | Add a user to every log.
-addUserToLogs :: MonadEffect Logging m => LogUser -> EffectHandler Logging m a -> m a
+addUserToLogs :: MonadEffect Logging m => LogUser -> RuntimeImplemented Logging m a -> m a
 addUserToLogs user = mapLogs (\l -> return (l { logUser = Just user }))
 
 -- | Add a crumb to every log.
-addCrumbToLogs :: MonadEffect Logging m => Crumb -> EffectHandler Logging m a -> m a
+addCrumbToLogs :: MonadEffect Logging m => Crumb -> RuntimeImplemented Logging m a -> m a
 addCrumbToLogs crumb = mapLogs (\l -> return (l { logCrumbs = logCrumbs l ++ [crumb] }))
 
 -- | Attach arbitrary data to every log. Typically you want to use this handler on
 --   'logX' functions directly like @setDataWithSummary "some data" (logInfo "some info")@
-setDataWithSummary :: MonadEffect Logging m => LogData -> EffectHandler Logging m a -> m a
+setDataWithSummary :: MonadEffect Logging m => LogData -> RuntimeImplemented Logging m a -> m a
 setDataWithSummary dat = mapLogs (\l -> return (l { logData = dat }))
 
 -- | Attach an arbitrary 'ByteString' to every log. Typically you want to use this handler on
 --   'logX' functions directly like @setDataTo "some data" (logInfo "some info")@
-setDataTo :: MonadEffect Logging m => ByteString -> EffectHandler Logging m a -> m a
+setDataTo :: MonadEffect Logging m => ByteString -> RuntimeImplemented Logging m a -> m a
 setDataTo bs = setDataWithSummary (LogData bs "")
 
 -- | Attach an arbitrary value to every log using it's 'ToJSON' instance.
 --   Typically you want to use this handler on 'logX' functions directly like
 --   @setDataToJsonOf 123 (logInfo "some info")@
-setDataToJsonOf :: (MonadEffect Logging m, ToJSON v) => v -> EffectHandler Logging m a -> m a
+setDataToJsonOf :: (MonadEffect Logging m, ToJSON v) => v -> RuntimeImplemented Logging m a -> m a
 setDataToJsonOf = setDataTo . toS . encode
 
 -- | Attach an arbitrary value to every log using it's 'Show' instance.
 --   Typically you want to use this handler on 'logX' functions directly like
 --   @setDataToShowOf 123 (logInfo "some info")@
-setDataToShowOf :: (MonadEffect Logging m, Show v) => v -> EffectHandler Logging m a -> m a
+setDataToShowOf :: (MonadEffect Logging m, Show v) => v -> RuntimeImplemented Logging m a -> m a
 setDataToShowOf = setDataTo . pshow
 
 -- | Add the current time to every log.
-setTimestampToNow :: (MonadEffect Logging m, MonadIO m) => EffectHandler Logging m a -> m a
+setTimestampToNow :: (MonadEffect Logging m, MonadIO m) => RuntimeImplemented Logging m a -> m a
 setTimestampToNow = mapLogs $ \l -> do
     time <- liftIO getCurrentTime
     return (l { logTimestamp = Just time })
@@ -269,7 +274,7 @@ --   the logs with the path to the files.
 writeDataToFiles ::
     ( MonadEffect Logging m, MonadIO m )
-    => FilePath -> EffectHandler Logging m a -> m a
+    => FilePath -> RuntimeImplemented Logging m a -> m a
 writeDataToFiles path m = do
     liftIO (createDirectoryIfMissing True path)
     m & mapLogs ( \l@Log{..} -> do
@@ -297,10 +302,9 @@ 
 -- | Print out the logs in rich format. Truncates at the given length.
 --   Logs will contain: message, timestamp, data, user and the call stack.
-prettyPrintSummary :: MonadIO m => Int -> EffectHandler Logging m a -> m a
-prettyPrintSummary trunc h = do
-    lock <- liftIO (newMVar ())
-    flip handleLogging h $ \Log{..} -> liftIO $ withMVar lock $ \_ -> do
+prettyPrintSummary :: MonadIO m => Int -> RuntimeImplemented Logging m a -> m a
+prettyPrintSummary trunc h =
+    flip handleLogging h $ \Log{..} -> liftIO $ do
         let callStackSection = manyLines trunc (toS (prettyCallStack logCallStack))
         let LogData{..} = logData
         let dataSection =