df1 0.4 → 0.4.1

raw patch · 6 files changed

+163/−32 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +16/−0
• df1.cabal +2/−2
• lib/Df1.hs +5/−1
• lib/Df1/Parse.hs +2/−0
• lib/Df1/Render.hs +34/−8
• lib/Df1/Types.hs +104/−21

@@ -1,3 +1,19 @@+# Version 0.4.1++* Add `ToPath`, `path`.++* Add `ToValue` instances for `base`'s `Char`, `Fixed`; for `time`'s+  `SystemTime`, `UTCTime`, `CalendarDiffDays`, `CalendarDiffTime`, `Day`,+  `TimeZone`, `TimeOfDay`, `LocalTime`, `ZonedTime`, `NominalDiffTime`,+  `DiffTime`, `DayOfWeek`.++* Add `ToSegment` instances for `base`'s `Char`.++* Add `ToKey` instances for `base`'s `Char`.++* Add `Read` instance for `Level`.++ # Version 0.4  * COMPILER ASSISTED BREAKING CHANGE: Change functions names `Df1.render` to

@@ -1,5 +1,5 @@ name: df1-version: 0.4+version: 0.4.1 author: Renzo Carbonara maintainer: renλren.zone copyright: Renzo Carbonara 2016@@ -8,7 +8,7 @@ extra-source-files: README.md CHANGELOG.md category: Logging build-type: Simple-cabal-version: >=1.18+cabal-version: 1.18 synopsis: Type, render and parse the df1 hierarchical structured log format description:   Type, render and parse logs in /df1/ format, a hierarchical structured

@@ -28,12 +28,16 @@  ( -- * Types    T.Log(Log, log_time, log_level, log_path, log_message)  , T.Level(Debug, Info, Notice, Warning, Error, Critical, Alert, Emergency)- , T.Path(Attr, Push)+ , T.Path(Attr, Push), T.ToPath(path)  , T.Segment, T.unSegment, T.ToSegment(segment)  , T.Key, T.unKey, T.ToKey(key)  , T.Value, T.unValue, T.ToValue(value)  , T.Message, T.unMessage, T.ToMessage(message)  ) where +import Df1.Render () -- To make sure module instances are available here too.+import Df1.Parse ()  -- To make sure module instances are available here too.+ import qualified Df1.Types as T+ 

@@ -21,6 +21,8 @@ import Data.Word (Word8, Word16, Word32) import Prelude hiding (log) +import Df1.Render () -- To make sure module instances are available here too.+ import Df1.Types  (Log(Log, log_time, log_level, log_path, log_message),   Level(Debug, Info, Notice, Warning, Error, Critical, Alert, Emergency),

@@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module Df1.Render  ( log@@ -16,7 +17,7 @@ import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Builder.Prim as BBP import Data.Function (fix)-import Data.Monoid ((<>))+import Data.Semigroup ((<>)) import qualified Data.Sequence as Seq import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -33,8 +34,9 @@   Path(Attr, Push),   Segment, unSegment,   Key, unKey,-  Value, unValue,+  Value, unValue, ToValue,   Message, unMessage)+import qualified Df1.Types (value)  -------------------------------------------------------------------------------- @@ -73,7 +75,7 @@ -- 2019-11-15T18:05:54.949640299Z \/server port=80 INFO Listening for new clients -- 2019-11-15T18:05:54.949652133Z \/server port=80 \/handler client-address=10.0.0.8 INFO Connection established -- 2019-11-15T18:05:54.949664482Z \/server port=80 \/handler client-address=10.0.0.8 WARNING user error (Oops!)--- @ +-- @ log :: Log -> BB.Builder {-# INLINABLE log #-} log = \x ->@@ -108,7 +110,7 @@ -- -- * A \'%\' anywhere is always percent-escaped (\"%25\") ----- * An ASCII-7 control character anywhere is always percent-escaped. +-- * An ASCII-7 control character anywhere is always percent-escaped. -- -- The output is encoded as UTF-8. message :: Message -> BB.Builder@@ -128,7 +130,7 @@ -- * An ASCII-7 punctuation character anywhere else is always percent-escaped, unless it is --   \'-\' or \'_\'. ----- * An ASCII-7 control character anywhere is always percent-escaped. +-- * An ASCII-7 control character anywhere is always percent-escaped. -- -- The output is encoded as UTF-8. segment :: Segment -> BB.Builder@@ -336,9 +338,20 @@ -- The rendered string is 30 characters long, and it's encoded as ASCII/UTF-8. iso8601 :: Time.SystemTime -> BB.Builder {-# INLINE iso8601 #-}-iso8601 = \syst ->-  let Time.UTCTime tday tdaytime = Time.systemToUTCTime syst-      (year, month, day) = Time.toGregorian tday+iso8601 syst =+  iso8601SystemTimeUTCTime syst (Time.systemToUTCTime syst)++-- | Like 'iso8601', but takes a 'Time.UTCTime'.+iso8601UTCTime :: Time.UTCTime -> BB.Builder+{-# INLINE iso8601UTCTime #-}+iso8601UTCTime utct =+  iso8601SystemTimeUTCTime (Time.utcToSystemTime utct) utct++-- | INTERNAL. Used by 'iso8601' and 'iso8601UTCTime'.+iso8601SystemTimeUTCTime :: Time.SystemTime -> Time.UTCTime -> BB.Builder+{-# INLINE iso8601SystemTimeUTCTime #-}+iso8601SystemTimeUTCTime syst (Time.UTCTime tday tdaytime) =+  let (year, month, day) = Time.toGregorian tday       Time.TimeOfDay hour min' sec = Time.timeToTimeOfDay tdaytime   in -- Notice that 'TB.decimal' RULES dispatch to faster code for smaller      -- types (e.g., 'Word8' is faster to render than 'Int'), so we make@@ -402,3 +415,16 @@ isControl7 :: Word8 -> Bool {-# INLINE isControl7 #-} isControl7 w = (w <= 31) || (w == 127)++--------------------------------------------------------------------------------++-- | See 'iso8601'.+instance ToValue Time.SystemTime where+  value = Df1.Types.value . TL.decodeUtf8 . BB.toLazyByteString . iso8601+  {-# NOINLINE value #-}++-- | See 'iso8601'.+instance ToValue Time.UTCTime where+  value = Df1.Types.value . TL.decodeUtf8 . BB.toLazyByteString . iso8601UTCTime+  {-# NOINLINE value #-}+

@@ -6,7 +6,7 @@ module Df1.Types  ( Log(Log, log_time, log_level, log_path, log_message)  , Level(Debug, Info, Notice, Warning, Error, Critical, Alert, Emergency)- , Path(Attr, Push)+ , Path(Attr, Push), ToPath(path)  , Segment, unSegment, ToSegment(segment)  , Key, unKey, ToKey(key)  , Value, unValue, ToValue(value)@@ -14,6 +14,9 @@  ) where  import Control.Exception (SomeException)+import Data.Coerce (coerce)+import qualified Data.Fixed as Fixed+import Data.Foldable (toList) import Data.Semigroup (Semigroup((<>))) import Data.Sequence as Seq import qualified Data.Text as T@@ -22,7 +25,9 @@ import Data.Word (Word8, Word16, Word32, Word64) import Numeric.Natural (Natural) import Data.String (IsString(fromString))+import qualified Data.Time as Time import qualified Data.Time.Clock.System as Time+import qualified Data.Time.Format.ISO8601 as Time  -------------------------------------------------------------------------------- @@ -66,7 +71,7 @@   deriving (Eq, Show)  unMessage :: Message -> TL.Text-unMessage = \(Message x) -> x+unMessage = coerce {-# INLINE unMessage #-}  instance IsString Message where@@ -74,14 +79,12 @@   {-# INLINE fromString #-}  instance Semigroup Message where-  (<>) (Message a) (Message b) = Message (a <> b)+  (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)   {-# INLINE (<>) #-}  instance Monoid Message where   mempty = Message mempty   {-# INLINE mempty #-}-  mappend (Message a) (Message b) = Message (mappend a b)-  {-# INLINE mappend #-}  -- | Convert an arbitrary type to a 'Message'. --@@ -154,7 +157,7 @@   -- database.   | Emergency   -- ^ System is unusable.-  deriving (Eq, Show, Bounded, Enum)+  deriving (Eq, Show, Read, Bounded, Enum)  -- | Order of importance. For example, 'Emergency' is more important than -- 'Debug':@@ -183,7 +186,7 @@   deriving (Eq, Show)  unSegment :: Segment -> TL.Text-unSegment = \(Segment x) -> x+unSegment = coerce {-# INLINE unSegment #-}  instance IsString Segment where@@ -191,14 +194,12 @@   {-# INLINE fromString #-}  instance Semigroup Segment where-  (<>) (Segment a) (Segment b) = Segment (a <> b)+  (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)   {-# INLINE (<>) #-}  instance Monoid Segment where   mempty = Segment mempty   {-# INLINE mempty #-}-  mappend (Segment a) (Segment b) = Segment (mappend a b)-  {-# INLINE mappend #-}  -- | Convert an arbitrary type to a 'Segment'. --@@ -240,6 +241,10 @@   segment = Segment . TL.pack   {-# INLINE segment #-} +instance ToSegment Char where+  segment = Segment . TL.singleton+  {-# INLINE segment #-}+ --------------------------------------------------------------------------------  -- | An attribute key (see 'Attr').@@ -259,7 +264,7 @@   deriving (Eq, Show)  unKey :: Key -> TL.Text-unKey = \(Key x) -> x+unKey = coerce {-# INLINE unKey #-}  instance IsString Key where@@ -267,14 +272,12 @@   {-# INLINE fromString #-}  instance Semigroup Key where-  (<>) (Key a) (Key b) = Key (a <> b)+  (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)   {-# INLINE (<>) #-}  instance Monoid Key where   mempty = Key mempty   {-# INLINE mempty #-}-  mappend (Key a) (Key b) = Key (mappend a b)-  {-# INLINE mappend #-}  -- | Convert an arbitrary type to a 'Key'. --@@ -316,6 +319,10 @@   key = Key . TL.pack   {-# INLINE key #-} +instance ToKey Char where+  key = Key . TL.singleton+  {-# INLINE key #-}+ --------------------------------------------------------------------------------  -- | An attribute value (see 'Attr').@@ -335,7 +342,7 @@   deriving (Eq, Show)  unValue :: Value -> TL.Text-unValue = \(Value x) -> x+unValue = coerce {-# INLINE unValue #-}  instance IsString Value where@@ -343,14 +350,12 @@   {-# INLINE fromString #-}  instance Semigroup Value where-  (<>) (Value a) (Value b) = Value (a <> b)+  (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)   {-# INLINE (<>) #-}  instance Monoid Value where   mempty = Value mempty   {-# INLINE mempty #-}-  mappend (Value a) (Value b) = Value (mappend a b)-  {-# INLINE mappend #-}  -- | Convert an arbitrary type to a 'Value'. --@@ -395,11 +400,12 @@ instance ToValue SomeException where   value = value . show   {-# INLINE value #-}- instance ToValue Bool where-  value = \b -> if b then Value "true" else Value "false"+  value = \b -> if b then "true" else "false"   {-# INLINE value #-}-+instance ToValue Char where+  value = Value . TL.singleton+  {-# INLINE value #-} instance ToValue Int where   value = value . show   {-# INLINE value #-}@@ -442,6 +448,56 @@ instance ToValue Double where   value = value . show   {-# INLINE value #-}+-- | Chops trailing zeros.+instance Fixed.HasResolution a => ToValue (Fixed.Fixed a) where+  value = value . Fixed.showFixed True+  {-# INLINE value #-}+-- | See 'Time.ISO8601'.+instance ToValue Time.CalendarDiffDays where+  value = value . Time.iso8601Show+  {-# INLINE value #-}+-- | See 'Time.ISO8601'.+instance ToValue Time.CalendarDiffTime where+  value = value . Time.iso8601Show+  {-# INLINE value #-}+-- | See 'Time.ISO8601'.+instance ToValue Time.Day where+  value = value . Time.iso8601Show+  {-# INLINE value #-}+-- | See 'Time.ISO8601'.+instance ToValue Time.TimeZone where+  value = value . Time.iso8601Show+  {-# INLINE value #-}+-- | See 'Time.ISO8601'.+instance ToValue Time.TimeOfDay where+  value = value . Time.iso8601Show+  {-# INLINE value #-}+-- | See 'Time.ISO8601'.+instance ToValue Time.LocalTime where+  value = value . Time.iso8601Show+  {-# INLINE value #-}+-- | See 'Time.ISO8601'.+instance ToValue Time.ZonedTime where+  value = value . Time.iso8601Show+  {-# INLINE value #-}+-- | @123456s@+instance ToValue Time.NominalDiffTime where+  value = value . show+  {-# INLINE value #-}+-- | @123456s@+instance ToValue Time.DiffTime where+  value = value . show+  {-# INLINE value #-}+-- | Lowercase @monday@, @tuesday@, etc.+instance ToValue Time.DayOfWeek where+   value = \x -> case x of+     Time.Monday    -> "monday"+     Time.Tuesday   -> "tuesday"+     Time.Wednesday -> "wednesday"+     Time.Thursday  -> "thursday"+     Time.Friday    -> "friday"+     Time.Saturday  -> "saturday"+     Time.Sunday    -> "sunday"  -------------------------------------------------------------------------------- @@ -474,3 +530,30 @@   | Attr !Key !Value   deriving (Eq, Show) +-- | Convert an arbitrary type to a 'Seq'uence of 'Path's.+--+-- You are encouraged to create custom 'ToPath' instances for your types+-- making sure you avoid rendering sensitive details such as passwords, so that+-- they don't accidentally end up in logs.+--+-- Any characters that need to be escaped for rendering will be automatically+-- escaped at rendering time. You don't need to escape them here.+class ToPath a where+  -- | The leftmost 'Path' is the closest to the root. The rightmost 'Path' is+  -- the one closest to where the log was generated.+  --+  -- See the documentation for 'Path'.+  path :: a -> Seq.Seq Path++-- | Identity.+instance ToPath (Seq.Seq Path) where+  path = id+  {-# INLINE path #-}++-- |+-- @+-- 'path' = 'Seq.fromList' . 'toList'+-- @+instance {-# OVERLAPPABLE #-} Foldable f => ToPath (f Path) where+  path = Seq.fromList . toList+  {-# INLINE path #-}