di-df1 1.0.2 → 1.1

raw patch · 5 files changed

+367/−116 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• di-df1.cabal +1/−1
• lib/Di/Df1.hs +197/−81
• lib/Di/Df1/Monad.hs +151/−22
• test/Main.hs +4/−12

@@ -1,3 +1,17 @@+# Version 1.1++* COMPILER ASSISTED BREAKING CHANGE: The `STM` compatible logging functions+  previously called `debug'`, `info'`, etc. are now called `debugSTM`,+  `infoSTM`, etc. The names such as `debug'`, `info'`, etc. are now what `debug`,+  `info`, etc. were in the previous version.++* Take `ToValue` and `ToMessage` instances where possible, rather than values of+  type `Value` and `Message`.++* `Di.Df1` now re-exports `Path`, `Segment`, `Key`, `Value`, `Message`,+  `ToKey(key)`, `ToValue(value)` and `ToMessage(message)`.++ # Version 1.0.2  * Added `Df1`, `Df1T` and `MonadDf1` type-synonyms.

@@ -1,5 +1,5 @@ name: di-df1-version: 1.0.2+version: 1.1 author: Renzo Carbonara maintainer: renλren.zone copyright: Renzo Carbonara 2018

@@ -21,7 +21,7 @@  , push    -- * Metadata  , attr-   -- * Messages+   -- * Logging from @IO@  , debug  , info  , notice@@ -30,7 +30,7 @@  , alert  , critical  , emergency-   -- ** Non 'MonadIO' variants+   -- ** Type-inference helpers  , debug'  , info'  , notice'@@ -39,12 +39,33 @@  , alert'  , critical'  , emergency'+   -- ** Logging from @STM@+ , debugSTM+ , infoSTM+ , noticeSTM+ , warningSTM+ , errorSTM+ , alertSTM+ , criticalSTM+ , emergencySTM -   -- * "Di.Handle" support+   -- * Support for @Di.Handle@  , df1    -- * Conversion  , fromDiLog  , fromDf1Log++   -- * Types from @Df1@+ , Df1.Level+ , Df1.Path+ , Df1.Segment+ , Df1.ToSegment(segment)+ , Df1.Key+ , Df1.ToKey(key)+ , Df1.Value+ , Df1.ToValue(value)+ , Df1.Message+ , Df1.ToMessage(message)  ) where  import Control.Concurrent.STM (STM)@@ -69,7 +90,7 @@ -- This type-synonym is not used within the @di-df1@ library itself because -- all functions exposed in the library have more general types. However, -- users are encouraged to use 'Df1' if they find it useful to reduce--- boilerplate and improve type inferrence.+-- boilerplate and improve type inference. type Df1 = Di.Di Df1.Level Df1.Path Df1.Message  --------------------------------------------------------------------------------@@ -84,11 +105,12 @@  -- | Push a new attribute 'Df1.Key' and 'Df1.Value' to the 'Di.Di'. attr-  :: Df1.Key-  -> Df1.Value+  :: Df1.ToValue value+  => Df1.Key+  -> value   -> Di.Di level Df1.Path msg   -> Di.Di level Df1.Path msg   -- ^-attr k v = Di.push (Df1.Attr k v)+attr k v = Di.push (Df1.Attr k (Df1.value v)) {-# INLINE attr #-}  --------------------------------------------------------------------------------@@ -96,168 +118,262 @@  -- | Log a message stating that the system is unusable. emergency-  :: MonadIO m+  :: (MonadIO m, Df1.ToMessage msg)   => Di.Di Df1.Level path Df1.Message-  -> Df1.Message+  -> msg   -> m ()-emergency di = Di.log di Df1.Emergency+emergency di = emergency' di . Df1.message {-# INLINE emergency #-}  -- | Log a condition that should be corrected immediately, such as a corrupted -- database. alert-  :: MonadIO m+  :: (MonadIO m, Df1.ToMessage msg)   => Di.Di Df1.Level path Df1.Message-  -> Df1.Message+  -> msg   -> m ()-alert di = Di.log di Df1.Alert+alert di = alert' di . Df1.message {-# INLINE alert #-}  -- | Log a critical condition that could result in system failure, such as a -- disk running out of space. critical-  :: MonadIO m+  :: (MonadIO m, Df1.ToMessage msg)   => Di.Di Df1.Level path Df1.Message-  -> Df1.Message+  -> msg   -> m ()-critical di = Di.log di Df1.Critical+critical di = critical' di . Df1.message {-# INLINE critical #-}  -- | Log an error condition, such as an unhandled exception. error-  :: MonadIO m+  :: (MonadIO m, Df1.ToMessage msg)   => Di.Di Df1.Level path Df1.Message-  -> Df1.Message+  -> msg   -> m ()-error di = Di.log di Df1.Error+error di = error' di . Df1.message {-# INLINE error #-}  -- | Log a warning condition, such as an exception being gracefully handled or -- some missing configuration setting being assigned a default value. warning-  :: MonadIO m+  :: (MonadIO m, Df1.ToMessage msg)   => Di.Di Df1.Level path Df1.Message-  -> Df1.Message+  -> msg   -> m ()-warning di = Di.log di Df1.Warning+warning di = warning' di . Df1.message {-# INLINE warning #-}  -- | Log a condition that is not an error, but should possibly be handled -- specially. notice-  :: MonadIO m+  :: (MonadIO m, Df1.ToMessage msg)   => Di.Di Df1.Level path Df1.Message-  -> Df1.Message+  -> msg   -> m ()-notice di = Di.log di Df1.Notice+notice di = notice' di . Df1.message {-# INLINE notice #-}  -- | Log an informational message. info-  :: MonadIO m+  :: (MonadIO m, Df1.ToMessage msg)   => Di.Di Df1.Level path Df1.Message-  -> Df1.Message+  -> msg   -> m ()-info di = Di.log di Df1.Info+info di = info' di . Df1.message {-# INLINE info #-}  -- | Log a message intended to be useful only when deliberately debugging a -- program. debug-  :: MonadIO m+  :: (MonadIO m, Df1.ToMessage msg)   => Di.Di Df1.Level path Df1.Message-  -> Df1.Message+  -> msg   -> m ()-debug di = Di.log di Df1.Debug+debug di = debug' di . Df1.message {-# INLINE debug #-}  ----------------------------------------------------------------------------------- STM variants+-- MonadIO variants with better type inference --- | Log a message stating that the system is unusable.+-- | Like 'emergency', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled. emergency'-  :: Monad m-  => (forall x. STM x -> m x)-  -> Di.Di Df1.Level path Df1.Message+  :: MonadIO m+  => Di.Di Df1.Level path Df1.Message   -> Df1.Message   -> m ()-emergency' natSTM di = Di.log' natSTM di Df1.Emergency+emergency' di = Di.log di Df1.Emergency {-# INLINE emergency' #-} --- | Log a condition that should be corrected immediately, such as a corrupted--- database.-alert'-  :: Monad m-  => (forall x. STM x -> m x)-  -> Di.Di Df1.Level path Df1.Message+-- | Like 'critical', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled.+critical'+  :: MonadIO m+  => Di.Di Df1.Level path Df1.Message   -> Df1.Message   -> m ()-alert' natSTM di = Di.log' natSTM di Df1.Alert-{-# INLINE alert' #-}+critical' di = Di.log di Df1.Critical+{-# INLINE critical' #-} --- | Log a critical condition that could result in system failure, such as a--- disk running out of space.-critical'-  :: Monad m-  => (forall x. STM x -> m x)-  -> Di.Di Df1.Level path Df1.Message+-- | Like 'alert', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled.+alert'+  :: MonadIO m+  => Di.Di Df1.Level path Df1.Message   -> Df1.Message   -> m ()-critical' natSTM di = Di.log' natSTM di Df1.Critical-{-# INLINE critical' #-}+alert' di = Di.log di Df1.Alert+{-# INLINE alert' #-} --- | Log an error condition, such as an unhandled exception.+-- | Like 'error', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled. error'-  :: Monad m-  => (forall x. STM x -> m x)-  -> Di.Di Df1.Level path Df1.Message+  :: MonadIO m+  => Di.Di Df1.Level path Df1.Message   -> Df1.Message   -> m ()-error' natSTM di = Di.log' natSTM di Df1.Error+error' di = Di.log di Df1.Error {-# INLINE error' #-} --- | Log a warning condition, such as an exception being gracefully handled or--- some missing configuration setting being assigned a default value.+-- | Like 'warning', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled. warning'-  :: Monad m-  => (forall x. STM x -> m x)-  -> Di.Di Df1.Level path Df1.Message+  :: MonadIO m+  => Di.Di Df1.Level path Df1.Message   -> Df1.Message   -> m ()-warning' natSTM di = Di.log' natSTM di Df1.Warning+warning' di = Di.log di Df1.Warning {-# INLINE warning' #-} --- | Log a condition that is not an error, but should possibly be handled--- specially.+-- | Like 'notice', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled. notice'-  :: Monad m-  => (forall x. STM x -> m x)-  -> Di.Di Df1.Level path Df1.Message+  :: MonadIO m+  => Di.Di Df1.Level path Df1.Message   -> Df1.Message   -> m ()-notice' natSTM di = Di.log' natSTM di Df1.Notice+notice' di = Di.log di Df1.Notice {-# INLINE notice' #-} --- | Log an informational message.+-- | Like 'info', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled. info'-  :: Monad m-  => (forall x. STM x -> m x)-  -> Di.Di Df1.Level path Df1.Message+  :: MonadIO m+  => Di.Di Df1.Level path Df1.Message   -> Df1.Message   -> m ()-info' natSTM di = Di.log' natSTM di Df1.Info+info' di = Di.log di Df1.Info {-# INLINE info' #-} --- | Log a message intended to be useful only when deliberately debugging a--- program.+-- | Like 'debug', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled. debug'-  :: Monad m-  => (forall x. STM x -> m x)-  -> Di.Di Df1.Level path Df1.Message+  :: MonadIO m+  => Di.Di Df1.Level path Df1.Message   -> Df1.Message   -> m ()-debug' natSTM di = Di.log' natSTM di Df1.Debug+debug' di = Di.log di Df1.Debug {-# INLINE debug' #-}++--------------------------------------------------------------------------------+-- STM variants++-- | Like 'emergency', but can be used from any 'Monad' supporting 'STM'.+emergencySTM+  :: (Monad m, Df1.ToMessage msg)+  => (forall x. STM x -> m x)+  -> Di.Di Df1.Level path Df1.Message+  -> msg+  -> m ()+emergencySTM natSTM di = Di.log' natSTM di Df1.Emergency . Df1.message+{-# INLINE emergencySTM #-}++-- | Like 'critical', but can be used from any 'Monad' supporting 'STM'.+criticalSTM+  :: (Monad m, Df1.ToMessage msg)+  => (forall x. STM x -> m x)+  -> Di.Di Df1.Level path Df1.Message+  -> msg+  -> m ()+criticalSTM natSTM di = Di.log' natSTM di Df1.Critical . Df1.message+{-# INLINE criticalSTM #-}++-- | Like 'alert', but can be used from any 'Monad' supporting 'STM'.+alertSTM+  :: (Monad m, Df1.ToMessage msg)+  => (forall x. STM x -> m x)+  -> Di.Di Df1.Level path Df1.Message+  -> msg+  -> m ()+alertSTM natSTM di = Di.log' natSTM di Df1.Alert . Df1.message+{-# INLINE alertSTM #-}++-- | Like 'error', but can be used from any 'Monad' supporting 'STM'.+errorSTM+  :: (Monad m, Df1.ToMessage msg)+  => (forall x. STM x -> m x)+  -> Di.Di Df1.Level path Df1.Message+  -> msg+  -> m ()+errorSTM natSTM di = Di.log' natSTM di Df1.Error . Df1.message+{-# INLINE errorSTM #-}++-- | Like 'warning', but can be used from any 'Monad' supporting 'STM'.+warningSTM+  :: (Monad m, Df1.ToMessage msg)+  => (forall x. STM x -> m x)+  -> Di.Di Df1.Level path Df1.Message+  -> msg+  -> m ()+warningSTM natSTM di = Di.log' natSTM di Df1.Warning . Df1.message+{-# INLINE warningSTM #-}++-- | Like 'notice', but can be used from any 'Monad' supporting 'STM'.+noticeSTM+  :: (Monad m, Df1.ToMessage msg)+  => (forall x. STM x -> m x)+  -> Di.Di Df1.Level path Df1.Message+  -> msg+  -> m ()+noticeSTM natSTM di = Di.log' natSTM di Df1.Notice . Df1.message+{-# INLINE noticeSTM #-}++-- | Like 'info', but can be used from any 'Monad' supporting 'STM'.+infoSTM+  :: (Monad m, Df1.ToMessage msg)+  => (forall x. STM x -> m x)+  -> Di.Di Df1.Level path Df1.Message+  -> msg+  -> m ()+infoSTM natSTM di = Di.log' natSTM di Df1.Info . Df1.message+{-# INLINE infoSTM #-}++-- | Like 'debug', but can be used from any 'Monad' supporting 'STM'.+debugSTM+  :: (Monad m, Df1.ToMessage msg)+  => (forall x. STM x -> m x)+  -> Di.Di Df1.Level path Df1.Message+  -> msg+  -> m ()+debugSTM natSTM di = Di.log' natSTM di Df1.Debug . Df1.message+{-# INLINE debugSTM #-}  -------------------------------------------------------------------------------- 

@@ -5,12 +5,11 @@ module Di.Df1.Monad  ( Df1T  , MonadDf1-    -- * Hierarchy  , push    -- * Metadata  , attr-   -- * Messages+   -- * Logging  , debug  , info  , notice@@ -19,6 +18,15 @@  , alert  , critical  , emergency+   -- ** Type-inference helpers+ , debug'+ , info'+ , notice'+ , warning'+ , error'+ , alert'+ , critical'+ , emergency'  ) where  import Prelude hiding (error)@@ -70,60 +78,181 @@ -- | Push a new 'Df1.Segment' to the 'Di.MonadDi'. push   :: Di.MonadDi level Df1.Path msg m-  => Df1.Segment -> m a -> m a  -- ^+  => Df1.Segment+  -> m a+  -> m a  -- ^ push s = Di.push (Df1.Push s) {-# INLINE push #-}  -- | Push a new attribute 'Df1.Key' and 'Df1.Value' to the 'Di.MonadDi'. attr-  :: Di.MonadDi level Df1.Path msg m-  => Df1.Key -> Df1.Value -> m a -> m a -- ^-attr k v = Di.push (Df1.Attr k v)+  :: (Di.MonadDi level Df1.Path msg m, Df1.ToValue value)+  => Df1.Key+  -> value+  -> m a+  -> m a -- ^+attr k v = Di.push (Df1.Attr k (Df1.value v)) {-# INLINE attr #-}  --------------------------------------------------------------------------------+-- MonadIO variants.  -- | Log a message stating that the system is unusable.-emergency :: Di.MonadDi Df1.Level path Df1.Message m => Df1.Message -> m ()-emergency = Di.log Df1.Emergency+emergency+  :: (Di.MonadDi Df1.Level path Df1.Message m, Df1.ToMessage msg)+  => msg+  -> m ()+emergency = emergency' . Df1.message {-# INLINE emergency #-}  -- | Log a condition that should be corrected immediately, such as a corrupted -- database.-alert :: Di.MonadDi Df1.Level path Df1.Message m => Df1.Message -> m ()-alert = Di.log Df1.Alert+alert+  :: (Di.MonadDi Df1.Level path Df1.Message m, Df1.ToMessage msg)+  => msg+  -> m ()+alert = alert' . Df1.message {-# INLINE alert #-}  -- | Log a critical condition that could result in system failure, such as a -- disk running out of space.-critical :: Di.MonadDi Df1.Level path Df1.Message m => Df1.Message -> m ()-critical = Di.log Df1.Critical+critical+  :: (Di.MonadDi Df1.Level path Df1.Message m, Df1.ToMessage msg)+  => msg+  -> m ()+critical = critical' . Df1.message {-# INLINE critical #-}  -- | Log an error condition, such as an unhandled exception.-error :: Di.MonadDi Df1.Level path Df1.Message m => Df1.Message -> m ()-error = Di.log Df1.Error+error+  :: (Di.MonadDi Df1.Level path Df1.Message m, Df1.ToMessage msg)+  => msg+  -> m ()+error = error' . Df1.message {-# INLINE error #-}  -- | Log a warning condition, such as an exception being gracefully handled or -- some missing configuration setting being assigned a default value.-warning :: Di.MonadDi Df1.Level path Df1.Message m => Df1.Message -> m ()-warning = Di.log Df1.Warning+warning+  :: (Di.MonadDi Df1.Level path Df1.Message m, Df1.ToMessage msg)+  => msg+  -> m ()+warning = warning' . Df1.message {-# INLINE warning #-}  -- | Log a condition that is not an error, but should possibly be handled -- specially.-notice :: Di.MonadDi Df1.Level path Df1.Message m => Df1.Message -> m ()-notice = Di.log Df1.Notice+notice+  :: (Di.MonadDi Df1.Level path Df1.Message m, Df1.ToMessage msg)+  => msg+  -> m ()+notice = notice' . Df1.message {-# INLINE notice #-}  -- | Log an informational message.-info :: Di.MonadDi Df1.Level path Df1.Message m => Df1.Message -> m ()-info = Di.log Df1.Info+info+  :: (Di.MonadDi Df1.Level path Df1.Message m, Df1.ToMessage msg)+  => msg+  -> m ()+info = info' . Df1.message {-# INLINE info #-}  -- | Log a message intended to be useful only when deliberately debugging a -- program.-debug :: Di.MonadDi Df1.Level path Df1.Message m => Df1.Message -> m ()-debug = Di.log Df1.Debug+debug+  :: (Di.MonadDi Df1.Level path Df1.Message m, Df1.ToMessage msg)+  => msg+  -> m ()+debug = debug' . Df1.message {-# INLINE debug #-}++--------------------------------------------------------------------------------+-- MonadIO variants with better type inference++-- | Like 'emergency', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled.+emergency'+  :: Di.MonadDi Df1.Level path Df1.Message m+  => Df1.Message+  -> m ()+emergency' = Di.log Df1.Emergency+{-# INLINE emergency' #-}++-- | Like 'critical', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled.+critical'+  :: Di.MonadDi Df1.Level path Df1.Message m+  => Df1.Message+  -> m ()+critical' = Di.log Df1.Critical+{-# INLINE critical' #-}++-- | Like 'alert', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled.+alert'+  :: Di.MonadDi Df1.Level path Df1.Message m+  => Df1.Message+  -> m ()+alert' = Di.log Df1.Alert+{-# INLINE alert' #-}++-- | Like 'error', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled.+error'+  :: Di.MonadDi Df1.Level path Df1.Message m+  => Df1.Message+  -> m ()+error' = Di.log Df1.Error+{-# INLINE error' #-}++-- | Like 'warning', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled.+warning'+  :: Di.MonadDi Df1.Level path Df1.Message m+  => Df1.Message+  -> m ()+warning' = Di.log Df1.Warning+{-# INLINE warning' #-}++-- | Like 'notice', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled.+notice'+  :: Di.MonadDi Df1.Level path Df1.Message m+  => Df1.Message+  -> m ()+notice' = Di.log Df1.Notice+{-# INLINE notice' #-}++-- | Like 'info', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled.+info'+  :: Di.MonadDi Df1.Level path Df1.Message m+  => Df1.Message+  -> m ()+info' = Di.log Df1.Info+{-# INLINE info' #-}++-- | Like 'debug', but takes a 'Df1.Message' rather than any 'Df1.ToMessage'.+--+-- This helps with type inference in case you are trying to+-- log a literal string and have the @OverloadedStrings@ GHC extension enabled.+debug'+  :: Di.MonadDi Df1.Level path Df1.Message m+  => Df1.Message+  -> m ()+debug' = Di.log Df1.Debug+{-# INLINE debug' #-}

@@ -60,27 +60,19 @@  instance QC.Arbitrary Df1.Segment where   arbitrary = fromString <$> QC.arbitrary-  shrink = map Df1.segment . QC.shrink . Df1.unSegment+  shrink = map fromString . QC.shrink . TL.unpack . Df1.unSegment  instance QC.Arbitrary Df1.Key where   arbitrary = fromString <$> QC.arbitrary-  shrink = map Df1.key . QC.shrink . Df1.unKey+  shrink = map fromString . QC.shrink . TL.unpack . Df1.unKey  instance QC.Arbitrary Df1.Value where   arbitrary = fromString <$> QC.arbitrary-  shrink = map Df1.value . QC.shrink . Df1.unValue+  shrink = map fromString . QC.shrink . TL.unpack . Df1.unValue  instance QC.Arbitrary Df1.Message where   arbitrary = fromString <$> QC.arbitrary-  shrink = map Df1.message . QC.shrink . Df1.unMessage--instance QC.Arbitrary T.Text where-  arbitrary = T.pack <$> QC.arbitrary-  shrink = map T.pack . QC.shrink . T.unpack--instance QC.Arbitrary TL.Text where-  arbitrary = TL.pack <$> QC.arbitrary-  shrink = map TL.pack . QC.shrink . TL.unpack+  shrink = map fromString . QC.shrink . TL.unpack . Df1.unMessage  genSystemTime :: QC.Gen Time.SystemTime genSystemTime = do