di 0.3 → 1.0

raw patch · 8 files changed

+199/−600 lines, 8 filesdep +df1dep +di-coredep +di-df1dep −QuickCheckdep −bytestringdep −didep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: df1, di-core, di-df1, di-handle, di-monad, exceptions

Dependencies removed: QuickCheck, bytestring, di, stm, tasty, tasty-hunit, tasty-quickcheck, time, transformers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• README.md +6/−4
• di.cabal +18/−20
• lib/Di.hs +167/−0
• src/Di.hs +0/−66
• src/Di/Backend.hs +0/−97
• src/Di/Core.hs +0/−277
• test/Main.hs +0/−136

@@ -1,3 +1,11 @@+# Version 1.0++* BREAKING CHANGE: Most of what used to be in this library lives now in+  `di-core`. This library is now intended to be an entry point to the various+  `di-*` libraries. Consider this first release of the new ecosystem a preview+  release: The API is likely to stay stable, but extensive testing,+  formalization and tooling is due.+ # Version 0.3  * BREAKING CHANGE: `mkDiTextStderr` and `mkDiStringHandle` return a `Di String

@@ -1,12 +1,14 @@ # di -Easy and powerful typeful logging without monad towers.+Typeful hierarchical structured logging using di, mtl and df1. +This is meta-package bringing in together things from the `di-core`,+`di-monad`, `di-handle` and `di-df1` libraries.++See the `Di` module for more documentation.+ [![Build Status](https://travis-ci.org/k0001/di.svg?branch=master)](https://travis-ci.org/k0001/di)  See the [BSD3 LICENSE](https://github.com/k0001/di/blob/master/di/LICENSE.txt) file to learn about the legal terms and conditions for this library.--Find documentation for this library in the top-level-[`Di`](https://github.com/k0001/di/blob/master/src/Di.hs) module. 

@@ -1,5 +1,5 @@ name: di-version: 0.3+version: 1.0 author: Renzo Carbonara maintainer: renλren.zone copyright: Renzo Carbonara 2017-2018@@ -9,31 +9,29 @@ category: Logging build-type: Simple cabal-version: >=1.18-synopsis: Easy, powerful, structured and typeful logging without monad towers.-description: Easy, powerful, structured and typeful logging without monad towers.+synopsis: Typeful hierarchical structured logging using di, mtl and df1.+description:+  Typeful hierarchical structured logging using di, mtl and df1.+  .+  This is meta-package bringing in together things from the @di-core@,+  @di-monad@, @di-handle@ and @di-df1@ libraries.+  .+  See the "Di" module for more documentation. homepage: https://github.com/k0001/di bug-reports: https://github.com/k0001/di/issues  library-  hs-source-dirs: src+  hs-source-dirs: lib   default-language: Haskell2010   exposed-modules: Di-  other-modules: Di.Core Di.Backend-  build-depends: base >=4.9 && <5.0, stm, time, transformers+  build-depends:+    base >=4.9 && <5.0,+    df1,+    di-core,+    di-df1,+    di-handle,+    di-monad,+    exceptions   ghcjs-options: -Wall -O3   ghc-options: -Wall -O2 -test-suite test-  default-language: Haskell2010-  type: exitcode-stdio-1.0-  hs-source-dirs: test-  main-is: Main.hs-  build-depends:-    base,-    bytestring,-    di,-    stm,-    QuickCheck,-    tasty,-    tasty-hunit,-    tasty-quickcheck

@@ -0,0 +1,167 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module is a highly opinionated, basic, and yet surprisingly sufficient+-- choice of a concrete stack of logging solutions belonging to the [di+-- logging ecosystem](https://github.com/k0001/di)—an otherwise rather+-- general ecosystem, flexible and full of choices.+--+-- For most logging scenarios out there, the choices made here should suffice,+-- but if you find these are not sufficient for your particular use case, please+-- refer to other libraries of the /di logging ecosystem/ such as+-- [di-core](https://hackage.haskell.org/package/di-core),+-- [di-monad](https://hackage.haskell.org/package/di-core),+-- [di-handle](https://hackage.haskell.org/package/di-core), or+-- [di-df1](https://hackage.haskell.org/package/di-core), and you are likely+-- to find a compatible and composable solution there. For this reason, staring+-- with this package rather than one of the those other lower-level packages is+-- always recommended.+--+-- The choices made here are:+--+-- * We encourage a [mtl](https://hackage.haskell.org/package/mtl) approach+--   through a typeclass called 'Di.Monad.MonadDi', for which all of the+--   monad transformers in+--   [transformers](https://hackage.haskell.org/package/transformers) and+--   [pipes](https://hackage.haskell.org/package/pipes) have instances.+--+-- * We provide our own 'Di.Monad.DiT' monad transformer which+--   has a 'MonadDi' instance, as well as instances for all the relevant+--   typeclasses in the+--   [base](https://hackage.haskell.org/package/base),+--   [mtl](https://hackage.haskell.org/package/mtl), and+--   [exceptions](https://hackage.haskell.org/package/exceptions) libraries.+--   All of the 'MonadDi' instances exported by this package expect a+--   'DiT' transformer in the stack somewhere, and defer all work to it.+--+-- * We embrace the [df1](https://hackage.haskell.org/package/df1) hierarchical+--   structured logging format, both at the type-level and when rendering the+--   log lines as text. Most notably, this means that we embrace the /df1/+--   importance 'Df1.Level's.+--+-- * We commit logs to the outside world by printing them to 'System.IO.stderr'.+--+-- You will notice that some of the functions in this module mention the types+-- 'Df1.Level', 'Df1.Path' and 'Df1.Message', and some other functions+-- talk about @level@, @path@ and @msg@ type variables. This is+-- because even while our particular set of choices require some monomorphic+-- types, the /di logging ecosystem/ treats these values polymorphically, so+-- they will show up in the types in one way or another, either in concrete or+-- polymorphic form. This can seem a bit noisy, but the good news is that if,+-- for example, want to call a third party library that uses other types+-- for conveying the idea of a “log importance level” or a “log message”,+-- then you can do so if you can convert between these different types.+-- For more information about this, see "Di.Monad" and "Di.Core", but not today.+--+-- The intended usage of this module is:+--+-- @+-- import qualified "Di"+-- @+module Di+ ( new+ , Di.Core.Di++   -- * Monadic API+ , Di.Monad.MonadDi++   -- ** Hierarchy+ , Di.Df1.Monad.push+ , Df1.Segment+ , Df1.segment++   -- ** Metadata+ , Di.Df1.Monad.attr+ , Df1.Key+ , Df1.key+ , Df1.Value+ , Df1.value++   -- ** Messages+ , Df1.Message+ , Di.Df1.Monad.debug+ , Di.Df1.Monad.info+ , Di.Df1.Monad.notice+ , Di.Df1.Monad.warning+ , Di.Df1.Monad.error+ , Di.Df1.Monad.alert+ , Di.Df1.Monad.critical+ , Di.Df1.Monad.emergency++   -- * Basic DiT support+ , Di.Monad.DiT+ , Di.Monad.runDiT+ , Di.Monad.hoistDiT+ ) where++import Control.Monad.Catch as Ex+import Control.Monad.IO.Class (MonadIO)++import qualified Df1+import qualified Di.Core+import qualified Di.Df1+import qualified Di.Df1.Monad+import qualified Di.Handle+import qualified Di.Monad++--------------------------------------------------------------------------------++-- | Obtain a 'Di.Core.Di' that will write logs in the /df1/ format to+-- 'System.IO.stderr'.+--+-- Generally, you will want to call 'new' just once per application, right from+-- your @main@ function. For example:+--+-- @+-- main :: 'IO' ()+-- main = do+--    'new' $ \\di -> do+--       'Di.Monad.runDiT' di $ do+--           -- /The rest of your program goes here./+--           -- /You can start logging right away./+--           'Di.Df1.Monad.notice' "Welcome to my program!"+--           -- /You can use 'Di.Df1.Monad.push' to separate different/+--           -- /logging scopes of your program:/+--           'Di.Df1.Monad.push' "initialization" $ do+--               -- /something something do initialization/+--               'Di.Df1.Monad.notice' "Starting web server"+--           'Di.Df1.Monad.push' "server" $ do+--               -- /And you can use 'Di.Df1.Monad.attr' to add metadata to/+--               -- /messages logged within a particular scope./+--               'Di.Df1.Monad.attr' "port" "80" $ do+--                    'Di.Df1.Monad.info' "Listening for new clients"+--                    clientAddress <- /somehow get a client connection/+--                    'Di.Df1.Monad.push' "handler" $ do+--                       'Di.Df1.Monad.attr' "client-address" clientAddress $ do+--                          'Di.Df1.Monad.info' "Connection established"+-- @+--+-- That program will render something like this to 'System.IO.stderr' (in colors!):+--+-- @+-- 2018-05-06T19:48:06.194579393Z NOTICE Welcome to my program!+-- 2018-05-06T19:48:06.195041422Z \/initialization NOTICE Starting web server+-- 2018-05-06T19:48:06.195052862Z \/server port=80 INFO Listening for new clients+-- 2018-05-06T19:48:06.195059084Z \/server port=80 \/handler client%2daddress=192%2e168%2e0%2e25%3a32528 INFO Connection established+-- @+--+-- (Unrelated: Notice how /df1/ escapes pretty much all punctuation characters.+-- This is temporal until /df1/ is formalized and a more limited set of+-- punctuation characters is reserved.)+new+  :: (MonadIO m, Ex.MonadMask m)+  => (Di.Core.Di Df1.Level Df1.Path Df1.Message -> m a)+  -- ^ Within this scope, you can use the obtained 'Di.Core.Di' safely, even+  -- concurrently. As soon as @m a@ finishes, 'new' will block until+  -- all logs have finished processing, before returning.+  --+  -- /WARNING:/ Even while+  -- @'new' commit 'pure' :: m ('Di.Core.Di' 'Df1.Level' 'Df1.Path' 'Df1.Message')@+  -- type-checks, and you can use it to work with the 'Di.Core.Di' outside the+  -- intended scope, you will have to remember to call 'Di.Monad.flush'+  -- yourself before exiting your application. Otherwise, some log messages may+  -- be left unprocessed. If possible, use the 'Di.Core.Di' within this function+  -- and don't let it escape this scope.+  -> m a -- ^+new act = do+  commit <- Di.Handle.stderr Di.Df1.df1+  Di.Core.new commit act+

@@ -1,66 +0,0 @@--- |------ Import this module as follows:------ @--- import Di (Di)--- import qualified Di--- @---module Di- ( -- * Usage-   -- $usage-   Di- , log- , flush- , push- , filter- , contralevel- , contrapath- , contramsg-   -- * Backends- , mkDi- , B.mkDiStringStderr- , B.mkDiStringHandle- ) where--import Prelude hiding (filter, log)--import Di.Core-  (Di, log, flush, push, filter, contralevel, contrapath, contramsg, mkDi)-import qualified Di.Backend as B----- $usage------ First, read the documentation for the 'Di' datatype.------ Second, create a base 'Di' value. You will achieve this by using 'mkDi' or,--- more likely, one of the ready-made 'B.mkDiStringStderr',--- 'B.mkDiStringHandle', etc.------ At this point, you can start logging messages using 'log'. However, things--- can be made more interesting.------ Your choice of base 'Di' will mandate particular types for the @level@,--- @path@ and @msg@ arguments to 'Di'. However, these base types are likely to--- be very general (e.g., 'String'), so quite likely you'll want to use--- 'contralevel', 'contrapath' and 'contramsg' to make those types more--- specific. For example, you can use a precise datatype like the following for--- associating each log message with a particular importance level:------ @--- data Level = Error | Info | Debug---   deriving ('Show')--- @------ Now, assuming the your base 'Di' @level@ type is 'String', you can use--- @'contralevel' 'show'@ to convert your @'Di' 'String' path msg@ to a @'Di'--- 'Level' path msg@. The same approach applies to @path@ and @msg@ as well,--- through the 'contrapath' and 'contramsg' functions respectively.------ /Hint/: If you are building a library, be sure to export your @Level@--- datatype so that users of your library can 'contralevel' your 'Level'--- datatype as necessary.-

@@ -1,97 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module Di.Backend- ( mkDiStringStderr- , mkDiStringHandle- ) where--import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Monoid (mconcat, mappend)-import Data.String (IsString(fromString))-import qualified Data.Time as Time-import Prelude hiding (log, filter)-import qualified System.IO as IO-import Data.Semigroup (Semigroup(..))--import Di.Core (Di, mkDi, contrapath)-------------------------------------------------------------------------------------- | Strings separated by a forward slash.------ The string doesn't contain any of @[\'/'\, \' \', \'\\n\', \'\\r\']@.------ Use 'fromString' (GHC's @OverloadedStrings@ extension) to construct a--- 'StringPath'.-newtype StringPath = UnsafeStringPath { unStringPath :: String }-  deriving (Eq, Ord, Show)--instance IsString StringPath where-  fromString = stringPathSingleton-  {-# INLINE fromString #-}---- | Ocurrences of one of @[\'/'\, \' \', \'\\n\', \'\\r\']@ in the given--- 'String' will be replaced by @\'_\'@.-stringPathSingleton :: String -> StringPath-stringPathSingleton = \s -> UnsafeStringPath (map f s)-  where f :: Char -> Char-        f = \case '/'  -> '_'-                  ' '  -> '_'-                  '\n' -> '_'-                  '\r' -> '_'-                  c    -> c--instance Semigroup StringPath where-  UnsafeStringPath "" <> b = b-  a <> UnsafeStringPath "" = a-  UnsafeStringPath a <> UnsafeStringPath b = UnsafeStringPath (a <> "/" <> b)--instance Monoid StringPath where-  mempty = UnsafeStringPath ""-  {-# INLINE mempty #-}-  mappend = (<>)-  {-# INLINE mappend #-}--- | 'String's are written to 'IO.Handle' using the 'IO.Handle''s locale--- encoding.------ The @level@ and @message@ are plain 'String's.------ The @path@ is a list of 'String's which will be separated by @\'/\'@ when--- rendered. Ocurrences of one of @[\'/'\, \' \', \'\\n\', \'\\r\']@ in those--- 'String's will be replaced by @\'_\'@.------ @--- > 'log' ('push' [\"cuatro\"] ('push' [\"uno dos\", \"tres\"] di)) \"WARNING\" \"Hello!\"--- WARNING 2018-05-03T09:15:54.819379740000Z uno_dos\/tres\/cuatro: Hello!--- @-mkDiStringHandle-  :: (MonadIO m)-  => IO.Handle-  -> m (Di String [String] String)-mkDiStringHandle h = liftIO $ do-    IO.hSetBuffering h IO.LineBuffering-    fmap (contrapath (mconcat . map stringPathSingleton)) $ do-       mkDi $ \ts l p m -> do-          IO.hPutStrLn h $ mconcat-             [ l, " ", renderIso8601 ts-             , if p == mempty then "" else (" " <> unStringPath p)-             , ": ", noBreaks m ]-          IO.hFlush h-  where-    noBreaks :: String -> String-    noBreaks = concatMap $ \case-      '\n' -> "\\n"-      '\r' -> "\\r"-      c -> [c]---- |--- @--- 'mkDiStringStderr'  ==  'mkDiStringHandle' 'IO.stderr'--- @-mkDiStringStderr :: MonadIO m => m (Di String [String] String)-mkDiStringStderr = mkDiStringHandle IO.stderr------------------------------------------------------------------------------------renderIso8601 :: Time.UTCTime -> String-renderIso8601 = Time.formatTime Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S.%qZ"

@@ -1,277 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Di.Core- ( Di(..)- , mkDi- , log- , flush- , push- , filter- , contralevel- , contrapath- , contramsg- ) where--import Control.Concurrent (forkFinally, myThreadId)-import Control.Concurrent.STM-import qualified Control.Exception as Ex-import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Function (fix)-import Data.Monoid (mconcat, (<>))-import qualified Data.Time as Time-import Prelude hiding (log, filter)-import qualified System.IO as IO-------------------------------------------------------------------------------------- | @'Di' level path msg@ allows you to to log messages of type @msg@, with a--- particular importance @level@, under a scope identified by @path@ (think of--- @path@ as a filesystem path that you can use to group together related log--- messages).------ Each @msg@ gets logged together with its @level@, @path@ and the--- 'Time.UTCTime' stating the instant when the logging requests was made.------ Even though logging is usually associated with rendering text, 'Di' makes no--- assumption about the types of the @msg@ values being logged, nor the @path@--- values that convey their scope, nor the @level@ values that convey their--- importance. Instead, it delays conversion from these precise types into the--- ultimately desired raw representation (if any) as much as possible. This--- makes it possible to log more precise information (for example, logging a--- datatype of your own without having to convert it to text first), richer--- scope paths (for example, the scope could be a 'Data.Map.Strict.Map' that--- gets enriched with more information as we 'push' down the @path@), and--- importance @level@s that are never too broad nor too narrow. This improves--- type safety, as well as the composability of the @level@, @path@ and @msg@--- values. In particular, all of @level@, @path@ and @msg@ are contravariant--- values, which in practice means including a precise 'Di' into a more general--- 'Di' is always possible (see the 'contralevel', 'contrapath' and 'contramsg'--- functions).------ Messages of undesired importance levels can be muted by using 'filter'.------ Contrary to other logging approaches based on monad transformers, a 'Di' is a--- value that is expected to be passed around explicitly. Of course, if--- necessary you can always put a 'Di' in some internal monad state or--- environment and provide a custom API for it. That's a choice you can make.------ A 'Di' can be safely used concurrently, and messages are rendered in the--- absolute order they were submitted for logging.------ 'Di' is pronounced as \"dee" (not \"die" nor \"dye" nor \"day"). \"Di" is--- the spanish word for an imperative form of the verb \"decir", which in--- english means "to say", which clearly has something to do with logging.-data Di level path msg = Di-  { _diLog :: Time.UTCTime -> level -> path -> msg -> IO ()-    -- ^ Low level logging function.-  , _diFilter :: level -> Bool-    -- ^ Whether a particular message @level@ should be logged or not.-  , _diLogs :: TQueue (IO ())-    -- ^ Work queue. This queue keeps fully applied '_diLog' calls.-  }---- | Build a new 'Di' from a logging function.------ /Note:/ If the passed in 'IO' function throws a exception, it will be--- just logged to 'IO.stderr' and then ignored.------ /Note:/ There's no need to "release" the obtained 'Di'.-mkDi-  :: MonadIO m-  => (Time.UTCTime -> level -> path -> msg -> IO ())-  -> m (Di level path msg)  -- ^-mkDi f = liftIO $ do-   di <- Di f (const True) <$> newTQueueIO-   me <- myThreadId-   _ <- forkFinally (worker di) (either (Ex.throwTo me) pure)-   pure di- where-   worker :: Di level path msg -> IO ()-   worker di = fix $ \k -> do-     eio <- Ex.try $ atomically $ do-        io <- peekTQueue (_diLogs di)-        pure (Ex.finally io (atomically (readTQueue (_diLogs di))))-     case eio of-        Left (_ :: Ex.BlockedIndefinitelyOnSTM) -> do-           pure ()  -- Nobody writes to '_diLogs' anymore, so we can just stop.-        Right io -> do-           catchSync io $ \se -> do-              ts <- fmap renderIso8601 Time.getCurrentTime-              IO.hPutStrLn IO.stderr $ mconcat-                 [ "Logging error at ", ts-                 , ": could not log message at due to "-                 , Ex.displayException se, ". Ignoring." ]-           k---- | Log a message with the given importance @level@.------ This function returns immediately after queing the message for logging in a--- different thread. If you want to explicitly wait for the message to be--- logged, then call 'flush' afterwards.------ /Note:/ No exceptions from the underlying logging backend (i.e., the 'IO'--- action given to 'mkDi') will be thrown from 'log'. Instead, those will be--- recorded to 'IO.stderr' and ignored.-log :: (MonadIO m, Monoid path) => Di level path msg -> level -> msg -> m ()-log (Di dLog dFilter dLogs) !l = \(!m) ->-   when (dFilter l) $ liftIO $ do-      ts <- Time.getCurrentTime-      atomically $ writeTQueue dLogs $! dLog ts l mempty m-{-# INLINABLE log #-}----- | Block until all messages being logged have finished processing.------ Manually calling 'flush' is not usually necessary, but, if at some point you--- want to ensure that all messages logged until then have properly rendered to--- the underlying backend, then 'flush' will block until that happens.-flush :: MonadIO m => Di level path msg -> m ()-flush di = liftIO (atomically (check =<< isEmptyTQueue (_diLogs di)))-{-# INLINABLE flush #-}----- | Returns a new 'Di' on which only messages with a @level@ satisfying the--- given predicate—in addition to any previous 'filter's—are ever logged.------ Identity:------ @--- 'filter' ('const' 'True')    ==   'id'--- @------ Composition:------ @--- 'filter' ('Control.Applicative.liftA2' (&&) f g)   ==   'filter' f . 'filter' g--- @------ Conmutativity:------ @--- 'filter' f . 'filter' g    ==    'filter' g . 'filter' f--- @-filter :: (level -> Bool) -> Di level path msg -> Di level path msg-filter f = \di -> di { _diFilter = \l -> f l && _diFilter di l }-{-# INLINABLE filter #-}----- | Push a new @path@ to the 'Di'.------ Identity:------ @--- 'push' 'mempty'   ==   'id'--- @------ Composition:------ @--- 'push' (a <> b)   ==   'push' b . 'push' a--- @-push :: Monoid path => path -> Di level path msg -> Di level path msg-push ps = \(Di dLog dFilter dLogs) ->-  Di (\ts l p1 m -> dLog ts l (ps <> p1) m) dFilter dLogs-{-# INLINABLE push #-}----- | A 'Di' is contravariant in its @level@ argument.------ This function is used to go from a /more general/ to a /less general/ type--- of @level@. For example, @data Level = Info | Error@ is a less general type--- than @data Level' = Info' | Warning' | Error'@, since the former can only--- convey two logging levels, whereas the latter can convey three. We can--- convert from the more general to the less general @level@ type using this--- 'contralevel' function:------ @--- 'contralevel' (\\case { Info -> Info'; Error -> Error' }) (di :: 'Di' Level' ['String'] msg)---     :: 'Di' Level ['Int'] msg--- @------ Identity:------ @--- 'contralevel' 'id'   ==   'id'--- @------ Composition:------ @--- 'contralevel' (f . g)   ==   'contralevel' g . 'contralevel' f--- @-contralevel :: (level -> level') -> Di level' path msg  -> Di level path msg-contralevel f = \(Di dLog dFilter dLogs) ->-  Di (\ts l p m -> dLog ts (f l) p m) (\l -> dFilter (f l)) dLogs-{-# INLINABLE contralevel #-}---- | A 'Di' is contravariant in its @path@ argument.------ This function is used to go from a /more general/ to a /less specific/ type--- of @path@. For example, @['Int']@ is a less general type than @['String']@,--- since the former clearly conveys the idea of a list of numbers, whereas the--- latter could be a list of anything that is representable as 'String', such as--- names of fruits and poems. We can convert from the more general to the less--- general @path@ type using this 'contrapath' function:------ @--- 'contrapath' ('map' 'show') (di :: 'Di' level ['String'] msg)---     :: 'Di' ['Int'] msg--- @------ Identity:------ @--- 'contrapath' 'id'   ==   'id'--- @------ Composition:------ @--- 'contrapath' (f . g)   ==   'contrapath' g . 'contrapath' f--- @-contrapath :: (path -> path') -> Di level path' msg  -> Di level path msg-contrapath f = \(Di dLog dFilter dLogs) ->-  Di (\ts l p m -> dLog ts l (f p) m) dFilter dLogs-{-# INLINABLE contrapath #-}---- | A 'Di' is contravariant in its @msg@ argument.------ This function is used to go from a /more general/ to a /less general/ type--- of @msg@. For example, @'Int'@ is a less general type than @'String'@, since--- the former clearly conveys the idea of a numbers, whereas the latter could be--- a anything that is representable as 'String', such as names of painters and--- colors. We can convert from the more general to the less general @msg@ type--- using this 'contramsg' function:------ @--- 'contramsg' 'show' (di :: 'Di' level path 'String')---     :: 'Di' level path 'Int'--- @------ Identity:------ @--- 'contramsg' 'id'   ==   'id'--- @------ Composition:------ @--- 'contramsg' (f . g)   ==   'contramsg' g . 'contramsg' f--- @-contramsg :: (msg -> msg') -> Di level path msg' -> Di level path msg-contramsg f = \(Di dLog dFilter dLogs) ->-  Di (\ts l p m -> dLog ts l p (f m)) dFilter dLogs-{-# INLINABLE contramsg #-}------------------------------------------------------------------------------------renderIso8601 :: Time.UTCTime -> String-renderIso8601 = Time.formatTime Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S.%qZ"--catchSync :: IO a -> (Ex.SomeException -> IO a) -> IO a-catchSync m f = Ex.catch m $ \se -> case Ex.asyncExceptionFromException se of-   Just ae -> Ex.throwIO (ae :: Ex.AsyncException)-   Nothing -> f se

@@ -1,136 +0,0 @@-{-# LANGUAGE CPP #-}-module Main where--import Control.Applicative (liftA2)-import qualified Control.Exception as Ex-import Control.Concurrent.STM-  (STM, atomically, TQueue, newTQueue, writeTQueue, tryReadTQueue)-import Data.Foldable (for_)-import Data.Function (fix)-import Data.Monoid (Sum(Sum, getSum))-import qualified Test.Tasty as Tasty-import qualified Test.Tasty.HUnit as HU-import Test.Tasty.HUnit ((@?=))-import qualified Test.Tasty.QuickCheck as QC-import qualified Test.Tasty.Runners as Tasty--import Di (Di)-import qualified Di------------------------------------------------------------------------------------main :: IO ()-main = Tasty.defaultMainWithIngredients-  [ Tasty.consoleTestReporter-  , Tasty.listingTests-  ] tt--tt :: Tasty.TestTree-tt = Tasty.testGroup "di"-  [ QC.testProperty "log" $ do-      QC.forAll QC.arbitrary $ \lpms ->-        QC.ioProperty $ do-          expect lpms $ \di0 -> do-            for_ lpms $ \(l, p, m) -> do-              Di.log (Di.push p di0) l m--  , HU.testCase "push" $ do-       let x = [("","",""), ("","",""), ("","1",""), ("","12",""), ("","12",""), ("","","")]-       expect x $ \di0 -> do-          Di.log di0 "" ""-          -- Identity-          Di.log (Di.push "" di0) "" ""-          -- Composition-          Di.log (Di.push "1" di0) "" ""-          Di.log ((Di.push "2" . Di.push "1") di0) "" ""-          Di.log (Di.push "12" di0) "" ""-          -- Checking that di0 still works-          Di.log di0 "" ""--  , HU.testCase "contralevel" $ do-       let x = [("1","",""), ("1","",""), ("1","",""), ("2","",""), ("2","",""), ("1","","")]-           n = 1 :: Int-       expect x $ \di0 -> do-          Di.log di0 "1" ""-          -- Identity-          Di.log (Di.contralevel id di0) "1" ""-          -- Composition-          Di.log (Di.contralevel show di0) n ""-          Di.log ((Di.contralevel succ . Di.contralevel show) di0) n ""-          Di.log (Di.contralevel (show . succ) di0) n ""-          -- Checking that di0 still works-          Di.log di0 "1" ""--  , HU.testCase "contrapath" $ do-       let x = [("","",""), ("","1",""), ("","1",""), ("","1",""), ("","2",""), ("","2",""), ("","","")]-           n = Sum (1 :: Int)-       expect x $ \di0 -> do-          Di.log di0 "" ""-          Di.log (Di.push "1" di0) "" ""-          -- Identity-          Di.log (Di.push "1" (Di.contrapath id di0)) "" ""-          -- Composition-          Di.log (Di.push n (Di.contrapath (show . getSum) di0)) "" ""-          Di.log (Di.push n ((Di.contrapath (mappend n) . Di.contrapath (show . getSum)) di0)) "" ""-          Di.log (Di.push n (Di.contrapath (show . getSum . mappend n) di0)) "" ""-          -- Checking that di0 still works-          Di.log di0 "" ""--  , HU.testCase "contramsg" $ do-       let x = [("","","1"), ("","","1"), ("","","1"), ("","","2"), ("","","2"),  ("","","1")]-           n = 1 :: Int-       expect x $ \di0 -> do-          Di.log di0 "" "1"-          -- Identity-          Di.log (Di.contramsg id di0) "" "1"-          -- Composition-          Di.log (Di.contramsg show di0) "" n-          Di.log ((Di.contramsg succ . Di.contramsg show) di0) "" n-          Di.log (Di.contramsg (show . succ) di0) "" n-          -- Checking that di0 still works-          Di.log di0 "" "1"--  , HU.testCase "filter" $ do-       let x = [("1","","a"), ("2","","c"), ("1","","d"), ("3","","g"), ("3","","j"), ("3","","m"), ("1","","n")]-       expect x $ \di0 -> do-          Di.log di0 "1" "a"-          -- Predicates-          Di.log (Di.filter (/= "1") di0) "1" "b"-          Di.log (Di.filter (/= "1") di0) "2" "c"-          -- Identity-          Di.log (Di.filter (const True) di0) "1" "d"-          -- Composition-          Di.log ((Di.filter (/= "1") . Di.filter (/= "2")) di0) "1" "e"-          Di.log ((Di.filter (/= "1") . Di.filter (/= "2")) di0) "2" "f"-          Di.log ((Di.filter (/= "1") . Di.filter (/= "2")) di0) "3" "g"-          Di.log (Di.filter (liftA2 (&&) (/= "1") (/= "2")) di0) "1" "h"-          Di.log (Di.filter (liftA2 (&&) (/= "1") (/= "2")) di0) "2" "i"-          Di.log (Di.filter (liftA2 (&&) (/= "1") (/= "2")) di0) "3" "j"-          -- Conmutativity (c.f., "e" "f" "g")-          Di.log ((Di.filter (/= "2") . Di.filter (/= "1")) di0) "1" "k"-          Di.log ((Di.filter (/= "2") . Di.filter (/= "1")) di0) "2" "l"-          Di.log ((Di.filter (/= "2") . Di.filter (/= "1")) di0) "3" "m"-          -- Checking that di0 still works-          Di.log di0 "1" "n"-  ]--expect :: [(String, String, String)] -> (Di String String String -> IO a) -> IO a-expect as0 k = Ex.bracket-  (do tq <- atomically newTQueue-      di <- Di.mkDi (\_ l p m -> atomically (writeTQueue tq (l, p, m)))-      pure (tq, di))-  (\(tq, di) -> do-      Di.flush di-      as1 <- atomically (drainTQueue tq)-      as1 @?= as0)-  (\(_, di) -> k di)--drainTQueue :: TQueue a -> STM [a]-drainTQueue tq = do-  let go as = maybe (pure as) (\a -> go (a:as)) =<< tryReadTQueue tq-  fmap reverse (go [])--#if !MIN_VERSION_QuickCheck(2,10,0)-instance QC.Testable () where-  property () = QC.property True-#endif