df1 0.3.2 → 0.4

raw patch · 6 files changed

+99/−69 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• df1.cabal +3/−3
• lib/Df1.hs +0/−7
• lib/Df1/Parse.hs +5/−4
• lib/Df1/Render.hs +73/−49
• test/Main.hs +8/−6

@@ -1,3 +1,13 @@+# Version 0.4++* COMPILER ASSISTED BREAKING CHANGE: Change functions names `Df1.render` to+  `Df1.Render.log`, `Df1.renderColor` to `Df1.Render.logColorANSI`, and+  `Df1.parse` to `Df1.Parse.log`.++* Exported `key`, `message`, `iso8601`, `segment` and `value` from module+  `Df1.Render`.++ # Version 0.3.2  * Added `ToValue` instances for common types like `Int`, `Bool`, etc.

@@ -1,5 +1,5 @@ name: df1-version: 0.3.2+version: 0.4 author: Renzo Carbonara maintainer: renλren.zone copyright: Renzo Carbonara 2016@@ -19,8 +19,8 @@ library   hs-source-dirs: lib   default-language: Haskell2010-  exposed-modules: Df1-  other-modules: Df1.Render Df1.Parse Df1.Types+  exposed-modules: Df1 Df1.Render Df1.Parse+  other-modules: Df1.Types   build-depends:     attoparsec,     base >=4.9 && <5.0,

@@ -33,14 +33,7 @@  , T.Key, T.unKey, T.ToKey(key)  , T.Value, T.unValue, T.ToValue(value)  , T.Message, T.unMessage, T.ToMessage(message)-   -- * Parsing- , P.parse-   -- * Rendering- , R.render- , R.renderColor  ) where -import qualified Df1.Parse as P-import qualified Df1.Render as R import qualified Df1.Types as T 

@@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-}  module Df1.Parse- ( parse+ ( log  ) where  import Control.Applicative ((<|>), many, empty)@@ -19,6 +19,7 @@ import qualified Data.Time as Time import qualified Data.Time.Clock.System as Time import Data.Word (Word8, Word16, Word32)+import Prelude hiding (log)  import Df1.Types  (Log(Log, log_time, log_level, log_path, log_message),@@ -33,9 +34,9 @@  -- | If sucessful, parsing will stop after the first CR or LF newline marker if -- any, otherwise it will consume all input.-parse :: AB.Parser Log-{-# INLINABLE parse #-}-parse = (AB.<?> "parse") $ do+log :: AB.Parser Log+{-# INLINABLE log #-}+log = (AB.<?> "log") $ do   t <- AB.skipWhile (== 32) *> pIso8601 -- :space:   p <- AB.skipWhile (== 32) *> pPath   l <- AB.skipWhile (== 32) *> pLevel

@@ -4,8 +4,13 @@ {-# LANGUAGE OverloadedStrings #-}  module Df1.Render- ( render- , renderColor+ ( log+ , logColorANSI+ , key+ , message+ , iso8601+ , segment+ , value  ) where  import qualified Data.ByteString.Builder as BB@@ -33,14 +38,14 @@  -------------------------------------------------------------------------------- --- This is rather ugly, but whatever.-renderColor :: Log -> BB.Builder-{-# INLINABLE renderColor #-}-renderColor = \log_ ->- let t = renderIso8601 (log_time log_) <> space+-- | Like 'log', but with ANSI colors.+logColorANSI :: Log -> BB.Builder+{-# INLINABLE logColorANSI #-}+logColorANSI = \log_ ->+ let t = iso8601 (log_time log_) <> space      pDef = \fg -> renderPathColor fg fgBlue fgCyan (log_path log_)      pRed = renderPathColor fgBlack fgWhite fgCyan (log_path log_)-     m = space <> renderMessage (log_message log_) <> reset+     m = space <> message (log_message log_) <> reset  in case log_level log_ of      Debug -> reset <> t <> pDef fgDefault <> fgDefault <> debug <> m      Info -> reset <> t <> pDef fgDefault <> fgDefault <> info <> m@@ -57,14 +62,25 @@      Emergency ->        bgRed <> fgBlack <> t <> pRed <> fgWhite <> emergency <> fgBlack <> m --- | Like 'renderColor', but without color.-render :: Log -> BB.Builder-{-# INLINABLE render #-}-render = \x ->-  renderIso8601 (log_time x) <> space <>+-- | Renders a 'Log' on its own line. Doesn't include a trailing newline character.+--+-- For example:+--+-- @+-- 2019-11-15T18:05:54.949470902Z NOTICE Welcome to my program!+-- 2019-11-15T18:05:54.949623731Z \/initialization NOTICE Starting web server+-- 2019-11-15T18:05:54.949630205Z \/initialization ALERT Disk is almost full!!!+-- 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 ->+  iso8601 (log_time x) <> space <>   renderPath (log_path x) <>   level (log_level x) <> space <>-  renderMessage (log_message x)+  message (log_message x)  -- | @'renderPathColor' a b c p@ renders @p@ using @a@ as the default color (for -- things like whitespace or attribute values), @b@ as the color for path names,@@ -75,27 +91,29 @@ {-# INLINE renderPathColor #-} renderPathColor defc pathc keyc = fix $ \f -> \case   ps Seq.:|> Attr k v ->-    f ps <> defc <> keyc <> renderKey k <>-    defc <> equals <> renderValue v <> space-  ps Seq.:|> Push s -> f ps <> defc <> pathc <> slash <> renderSegment s <> space+    f ps <> defc <> keyc <> key k <>+    defc <> equals <> value v <> space+  ps Seq.:|> Push s -> f ps <> defc <> pathc <> slash <> segment s <> space   Seq.Empty -> mempty  -- | Like 'renderPathColor', but without color. renderPath :: Seq.Seq Path -> BB.Builder {-# INLINE renderPath #-} renderPath = fix $ \f -> \case-  ps Seq.:|> Attr k v -> f ps <> renderKey k <> equals <> renderValue v <> space-  ps Seq.:|> Push s -> f ps <> slash <> renderSegment s <> space+  ps Seq.:|> Attr k v -> f ps <> key k <> equals <> value v <> space+  ps Seq.:|> Push s -> f ps <> slash <> segment s <> space   Seq.Empty -> mempty  -- | Escaping rules for 'Segment': ----- * A \'%' anywhere is always percent-escaped (\"%25")"+-- * A \'%\' anywhere is always percent-escaped (\"%25\") ----- * A 'isControl7' char anywhere is always percent-escaped.-renderMessage :: Message -> BB.Builder-{-# INLINE renderMessage #-}-renderMessage x = eall (unMessage x)+-- * An ASCII-7 control character anywhere is always percent-escaped. +--+-- The output is encoded as UTF-8.+message :: Message -> BB.Builder+{-# INLINE message #-}+message x = eall (unMessage x)   where     {-# INLINE eall #-}     eall = TL.encodeUtf8BuilderEscaped@@ -105,15 +123,17 @@  -- | Escaping rules for 'Segment': ----- * A 'isPunctuation7' in the first character is always percent-escaped.+-- * An ASCII-7 punctuation character as first character is always percent-escaped. ----- * A 'isPunctuation7' anywhere else is always percent-escaped, unless it is---   \'-' or \'_'.+-- * An ASCII-7 punctuation character anywhere else is always percent-escaped, unless it is+--   \'-\' or \'_\'. ----- * A 'isControl7' char anywhere is always percent-escaped.-renderSegment :: Segment -> BB.Builder-{-# INLINE renderSegment #-}-renderSegment x = case TL.uncons (unSegment x) of+-- * An ASCII-7 control character anywhere is always percent-escaped. +--+-- The output is encoded as UTF-8.+segment :: Segment -> BB.Builder+{-# INLINE segment #-}+segment x = case TL.uncons (unSegment x) of     Nothing -> mempty     Just (hd,tl) -> ehead (T.singleton hd) <> etail tl   where@@ -133,15 +153,17 @@  -- | Escaping rules for 'Key': ----- * A 'isControl7' char anywhere is always percent-escaped.+-- * An ASCII-7 control character is always percent-escaped. ----- * A 'isPunctuation7' in the first character is always percent-escaped.+-- * An ASCII-7 punctuation character is always percent-escaped. ----- * A 'isPunctuation7' anywhere else is always percent-escaped, unless it is---   \'-' or \'_'.-renderKey :: Key -> BB.Builder-{-# INLINE renderKey #-}-renderKey x = case TL.uncons (unKey x) of+-- * An ASCII-7 punctuation character anywhere else is always percent-escaped, unless it is+--   \'-\' or \'_\'.+--+-- The output is encoded as UTF-8.+key :: Key -> BB.Builder+{-# INLINE key #-}+key x = case TL.uncons (unKey x) of     Nothing -> mempty     Just (hd,tl) -> ehead (T.singleton hd) <> etail tl   where@@ -161,16 +183,18 @@  -- | Escaping rules for 'Value': ----- * A \' ' anywhere is always percent-escaped (\"%20").+-- * A \' \' anywhere is always percent-escaped (\"%20\"). ----- * A \'%' anywhere is always percent-escaped (\"%25")"+-- * A \'%\' anywhere is always percent-escaped (\"%25\")" ----- * A \'=' anywhere is always percent-escaped (\"%3d").+-- * A \'=\' anywhere is always percent-escaped (\"%3d\"). ----- * A 'isControl7' char anywhere is always percent-escaped.-renderValue :: Value -> BB.Builder-{-# INLINE renderValue #-}-renderValue x = eall (unValue x)+-- * An ASCII-7 control character anywhere is always percent-escaped.+--+-- The output is encoded as UTF-8.+value :: Value -> BB.Builder+{-# INLINE value #-}+value x = eall (unValue x)   where     {-# INLINE eall #-}     eall = TL.encodeUtf8BuilderEscaped@@ -309,10 +333,10 @@  -- | Renders /YYYY-MM-DDThh:mm:ss.sssssssssZ/ (nanosecond precision). ----- The rendered string is a 30 characters long, and it's ASCII-encoded.-renderIso8601 :: Time.SystemTime -> BB.Builder-{-# INLINE renderIso8601 #-}-renderIso8601 = \syst ->+-- 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       Time.TimeOfDay hour min' sec = Time.timeToTimeOfDay tdaytime

@@ -18,6 +18,8 @@ import qualified Test.Tasty.Runners as Tasty  import qualified Df1+import qualified Df1.Render+import qualified Df1.Parse  -------------------------------------------------------------------------------- @@ -32,14 +34,14 @@   [ Tasty.localOption (QC.QuickCheckTests 2000) $     QC.testProperty "Render/Parse roundtrip" $ do       QC.forAllShrink QC.arbitrary QC.shrink $ \log0 -> do-         let bl = BB.toLazyByteString (Df1.render log0)-         Right log0 === ABL.eitherResult (ABL.parse Df1.parse bl)+         let bl = BB.toLazyByteString (Df1.Render.log log0)+         Right log0 === ABL.eitherResult (ABL.parse Df1.Parse.log bl)    , Tasty.localOption (QC.QuickCheckTests 2000) $     QC.testProperty "Color renders the same content" $ do       QC.forAllShrink QC.arbitrary QC.shrink $ \log0 -> do-         let bl = BB.toLazyByteString (Df1.render log0)-             blColor = BB.toLazyByteString (Df1.renderColor log0)+         let bl = BB.toLazyByteString (Df1.Render.log log0)+             blColor = BB.toLazyByteString (Df1.Render.logColorANSI log0)          bl === removeAnsiEscapes blColor   ] @@ -88,8 +90,8 @@ -- -- @ -- forall x.---    'BB.toByteString' . 'render'---        == 'removeAnsiEscapes' . 'BB.toByteString' . 'renderColor'+--    'BB.toByteString' . 'log'+--        == 'removeAnsiEscapes' . 'BB.toByteString' . 'logColor' -- @ removeAnsiEscapes :: BL.ByteString -> BL.ByteString removeAnsiEscapes b0 = do