df1 0.1.1 → 0.2
raw patch · 7 files changed
+178/−64 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +28/−0
- df1.cabal +2/−2
- lib/Df1.hs +21/−0
- lib/Df1/Parse.hs +4/−5
- lib/Df1/Render.hs +96/−23
- lib/Df1/Types.hs +25/−32
- test/Main.hs +2/−2
CHANGELOG.md view
@@ -1,3 +1,31 @@+# Version 0.2++* BREAKING CHANGE: `Segment`, `Key`, `Value` and `Message` don't strip+ surrounding whitespace anymore. When rendering `Segment`, `Key` and `Value`,+ the whitespace will be percent-encoded. When rendering `Message`, the+ whitespace will be kept as is.++* BREAKING CHANGE: `Segment` and `Key` now wrap lazy `Text`, rather than strict+ `Text`. This is to align their APIs with `Value` and `Message`, which already+ wrapped lazy `Text` so as to prevent logged `Value`s and `Message`s from+ to use much memory. It's unlikely that `Segment`s and `Key`s are affected by+ this, since in practice they are almost always created statically. So, this+ change is mostly to make the API less surprising to users: Lazy `Text` is used+ throughout.++* Added draft BNF specification.+++# Version 0.1.2++* Fixed escaping of control characters in `Message`.++* Percent-escape less punctuation characters when rendering `Key`,+ `Segment` and `Value`.++ TODO: write spec.++ # Version 0.1.1 * Fixed compilation.
df1.cabal view
@@ -1,8 +1,8 @@ name: df1-version: 0.1.1+version: 0.2 author: Renzo Carbonara maintainer: renλren.zone-copyright: Renzo Carbonara 2018+copyright: Renzo Carbonara 2016-2018 license: BSD3 license-file: LICENSE.txt extra-source-files: README.md CHANGELOG.md
lib/Df1.hs view
@@ -3,6 +3,27 @@ -- -- Consider this a preview release: The API is likely to stay stable, but -- extensive testing, formalization and tooling is due.+--+-- Draft [BNF](https://en.wikipedia.org/wiki/Backus%E2%80%93Naur_form)+-- specification of the /df1/ log line format (TO BE VERIFIED):+--+-- > <log> ::= <timestamp> " " <path> " " <level> " " <message>+-- > <path> ::= <path1> " " <path> | <path1> | ""+-- > <path1> ::= "/" <segment> | <key> "=" <value>+-- > <segment> ::= zero or more characters until " "+-- > <key> ::= zero or more characters until (" " | "=")+-- > <value> ::= zero or more characters until " "+-- > <message> ::= zero or more characters until LF ("\n")+-- > <level> ::= "DEBUG" | "INFO" | "NOTICE" | "WARNING" | "ERROR" | "CRITICAL" | "ALERT" | "EMERGENCY"+-- > <timestamp> ::= <year> "-" <month> "-" <day> "T" <hour> ":" <minute> ":" <second> "." <nanosecond> "Z"+-- > <year> ::= <digit> <digit> <digit> <digit>+-- > <month> ::= <digit> <digit>+-- > <day> ::= <digit> <digit>+-- > <hour> ::= <digit> <digit>+-- > <minute> ::= <digit> <digit>+-- > <second> ::= <digit> <digit>+-- > <nanosecond> ::= <digit> <digit> <digit> <digit> <digit> <digit> <digit> <digit> <digit>+-- > <digit> ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" module Df1 ( -- * Types T.Log(Log, log_time, log_level, log_path, log_message)
lib/Df1/Parse.hs view
@@ -36,10 +36,10 @@ parse :: AB.Parser Log {-# INLINABLE parse #-} parse = (AB.<?> "parse") $ do- t <- AB.skipWhile (== 32) *> pIso8601+ t <- AB.skipWhile (== 32) *> pIso8601 -- :space: p <- AB.skipWhile (== 32) *> pPath l <- AB.skipWhile (== 32) *> pLevel- m <- AB.skipWhile (== 32) *> pMessage+ m <- AB.skip (== 32) *> pMessage pure (Log { log_time = Time.utcToSystemTime t , log_level = l, log_path = p, log_message = m }) @@ -128,14 +128,13 @@ pSegment = (AB.<?> "pSegment") $ do AB.skip (== 47) AB.<?> "/" bl <- pUtf8LtoL =<< pDecodePercents =<< AB.takeWhile (/= 32) -- :space:- pure (segment (TL.toStrict bl))+ pure (segment bl) pKey :: AB.Parser Key pKey = (AB.<?> "pKey") $ do- bl <- pUtf8LtoL =<< pDecodePercents =<< AB.takeWhile (\w -> w /= 61 && w /= 32) -- '=' or :space:- pure (key (TL.toStrict bl))+ pure (key bl) pValue :: AB.Parser Value pValue = (AB.<?> "pValue") $ do
lib/Df1/Render.hs view
@@ -12,6 +12,8 @@ import Data.Function (fix) import Data.Monoid ((<>)) import qualified Data.Sequence as Seq+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import qualified Data.Time as Time@@ -85,40 +87,97 @@ ps Seq.:|> Push s -> f ps <> slash <> renderSegment s <> space Seq.Empty -> mempty +-- | Escaping rules for 'Segment':+--+-- * A \'%' anywhere is always percent-escaped (\"%25")"+--+-- * A 'isControl7' char anywhere is always percent-escaped. renderMessage :: Message -> BB.Builder {-# INLINE renderMessage #-}-renderMessage = escapeMessage . unMessage--escapeMessage :: TL.Text -> BB.Builder-{-# INLINE escapeMessage #-}-escapeMessage = TL.encodeUtf8BuilderEscaped- $ BBP.condB (== 37) word8HexPercent -- '%'- $ BBP.condB (<= 31) word8HexPercent -- control characters- $ BBP.liftFixedToBounded BBP.word8+renderMessage x = eall (unMessage x)+ where+ {-# INLINE eall #-}+ eall = TL.encodeUtf8BuilderEscaped+ $ BBP.condB (== 37) word8HexPercent -- '%'+ $ BBP.condB isControl7 word8HexPercent+ $ BBP.liftFixedToBounded BBP.word8 +-- | Escaping rules for 'Segment':+--+-- * A 'isPunctuation7' in the first character is always percent-escaped.+--+-- * A 'isPunctuation7' 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 = escapeMetaL . TL.fromStrict . unSegment+renderSegment x = case TL.uncons (unSegment x) of+ Nothing -> mempty+ Just (hd,tl) -> ehead (T.singleton hd) <> etail tl+ where+ {-# INLINE ehead #-}+ ehead = T.encodeUtf8BuilderEscaped+ $ BBP.condB isPunctuation7 word8HexPercent+ $ BBP.condB isControl7 word8HexPercent+ $ BBP.liftFixedToBounded BBP.word8+ {-# INLINE etail #-}+ etail = TL.encodeUtf8BuilderEscaped+ $ BBP.condB (\w -> w == 0x2d -- '-'+ || w == 0x5f) -- '_'+ (BBP.liftFixedToBounded BBP.word8)+ $ BBP.condB isPunctuation7 word8HexPercent+ $ BBP.condB isControl7 word8HexPercent+ $ BBP.liftFixedToBounded BBP.word8 +-- | Escaping rules for 'Key':+--+-- * A 'isControl7' char anywhere is always percent-escaped.+--+-- * A 'isPunctuation7' in the first character is always percent-escaped.+--+-- * A 'isPunctuation7' anywhere else is always percent-escaped, unless it is+-- \'-' or \'_'. renderKey :: Key -> BB.Builder {-# INLINE renderKey #-}-renderKey = escapeMetaL . TL.fromStrict . unKey+renderKey x = case TL.uncons (unKey x) of+ Nothing -> mempty+ Just (hd,tl) -> ehead (T.singleton hd) <> etail tl+ where+ {-# INLINE ehead #-}+ ehead = T.encodeUtf8BuilderEscaped+ $ BBP.condB isPunctuation7 word8HexPercent+ $ BBP.condB isControl7 word8HexPercent+ $ BBP.liftFixedToBounded BBP.word8+ {-# INLINE etail #-}+ etail = TL.encodeUtf8BuilderEscaped+ $ BBP.condB (\w -> w == 0x2d -- '-'+ || w == 0x5f) -- '_'+ (BBP.liftFixedToBounded BBP.word8)+ $ BBP.condB isPunctuation7 word8HexPercent+ $ BBP.condB isControl7 word8HexPercent+ $ BBP.liftFixedToBounded BBP.word8 +-- | Escaping rules for 'Value':+--+-- * A \' ' anywhere is always percent-escaped (\"%20").+--+-- * A \'%' anywhere is always percent-escaped (\"%25")"+--+-- * A \'=' anywhere is always percent-escaped (\"%3d").+--+-- * A 'isControl7' char anywhere is always percent-escaped. renderValue :: Value -> BB.Builder {-# INLINE renderValue #-}-renderValue = escapeMetaL . unValue---- | Escape metadata such as path segments, attribute keys or attribute values.-escapeMetaL :: TL.Text -> BB.Builder-{-# INLINE escapeMetaL #-}-escapeMetaL = TL.encodeUtf8BuilderEscaped- $ BBP.condB- (\w -> (w <= 47) -- Control and separator-like- || (w >= 58 && w <= 64) -- Delimiter-like- || (w >= 91 && w <= 96) -- Delimiter-like- || (w >= 123 && w <= 127)) -- Delimiter-like and DEL- word8HexPercent- $ BBP.liftFixedToBounded BBP.word8+renderValue x = eall (unValue x)+ where+ {-# INLINE eall #-}+ eall = TL.encodeUtf8BuilderEscaped+ $ BBP.condB (== 0x20) word8HexPercent+ $ BBP.condB (== 0x25) word8HexPercent+ $ BBP.condB (== 0x3d) word8HexPercent+ $ BBP.condB isControl7 word8HexPercent+ $ BBP.liftFixedToBounded BBP.word8 -------------------------------------------------------------------------------- -- Some hardcoded stuff we use time and time again@@ -299,3 +358,17 @@ {-# INLINE _zero6 #-} {-# INLINE _zero7 #-} {-# INLINE _zero8 #-}++-- | 'True' for all ASCII-7 punctuation characters.+isPunctuation7 :: Word8 -> Bool+{-# INLINE isPunctuation7 #-}+isPunctuation7 w =+ (w >= 32 && w <= 47) ||+ (w >= 58 && w <= 64) ||+ (w >= 91 && w <= 96) ||+ (w >= 123 && w <= 126)++-- | 'True' for ASCII-7 control characters.+isControl7 :: Word8 -> Bool+{-# INLINE isControl7 #-}+isControl7 w = (w <= 31) || (w == 127)
lib/Df1/Types.hs view
@@ -12,7 +12,6 @@ import Data.Semigroup (Semigroup((<>))) import Data.Sequence as Seq-import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.String (IsString(fromString)) import qualified Data.Time.Clock.System as Time@@ -51,17 +50,15 @@ -- \"foo\" :: 'Message' -- @ ----- Please keep in mind that 'Message' will always strip surrounding whitespace.--- That is:+-- Otherwise, you can use 'fromString' or the 'message' function. ----- @--- \"x\" :: 'Message' == \" x\" == \"x \" == \" x \"--- @+-- Notice that @\"\" :: 'Message'@ is acceptable, and will be correctly rendered+-- and parsed back. newtype Message = Message TL.Text deriving (Eq, Show) message :: TL.Text -> Message-message = Message . TL.dropAround (== ' ')+message = Message {-# INLINE message #-} unMessage :: Message -> TL.Text@@ -130,20 +127,23 @@ -- \"foo\" :: 'Segment' -- @ ----- Otherwise, you can use 'fromString' or the 'Segment' constructor directly.-newtype Segment = Segment T.Text+-- Otherwise, you can use 'fromString' or the 'segment' function.+--+-- Notice that @\"\" :: 'Segment'@ is acceptable, and will be correctly rendered+-- and parsed back.+newtype Segment = Segment TL.Text deriving (Eq, Show) -segment :: T.Text -> Segment-segment = Segment . T.dropAround (== ' ')+segment :: TL.Text -> Segment+segment = Segment {-# INLINE segment #-} -unSegment :: Segment -> T.Text+unSegment :: Segment -> TL.Text unSegment = \(Segment x) -> x {-# INLINE unSegment #-} instance IsString Segment where- fromString = segment . T.pack+ fromString = segment . TL.pack {-# INLINE fromString #-} instance Semigroup Segment where@@ -169,25 +169,21 @@ -- -- Otherwise, you can use 'fromString' or the 'key' function. ----- Please keep in mind that 'Key' will always strip surrounding whitespace.--- That is:------ @--- \"x\" :: 'Key' == \" x\" == \"x \" == \" x \"--- @-newtype Key = Key T.Text+-- Notice that @\"\" :: 'Key'@ is acceptable, and will be correctly rendered and+-- parsed back.+newtype Key = Key TL.Text deriving (Eq, Show) -key :: T.Text -> Key-key = Key . T.dropAround (== ' ')+key :: TL.Text -> Key+key = Key {-# INLINE key #-} -unKey :: Key -> T.Text+unKey :: Key -> TL.Text unKey = \(Key x) -> x {-# INLINE unKey #-} instance IsString Key where- fromString = key . T.pack+ fromString = key . TL.pack {-# INLINE fromString #-} instance Semigroup Key where@@ -213,12 +209,8 @@ -- -- Otherwise, you can use 'fromString' or the 'value' function. ----- Please keep in mind that 'value' will always strip surrounding whitespace.--- That is:------ @--- \"x\" :: 'Value' == \" x\" == \"x \" == \" x \"--- @+-- Notice that @\"\" :: 'Value'@ is acceptable, and will be correctly rendered+-- and parsed back. newtype Value = Value TL.Text deriving (Eq, Show) @@ -227,7 +219,7 @@ {-# INLINE unValue #-} value :: TL.Text -> Value-value = Value . TL.dropAround (== ' ')+value = Value {-# INLINE value #-} instance IsString Value where@@ -251,7 +243,7 @@ -- For example, consider a /df1/ log line as like the following: -- -- @--- 1999-12-20T07:11:39.230553031Z /foo x=a y=b /qux z=c z=d WARNING Something+-- 1999-12-20T07:11:39.230553031Z \/foo x=a y=b \/bar \/qux z=c z=d WARNING Something -- @ -- -- For that line, the 'log_path' attribute of the 'Log' datatype will contain@@ -261,6 +253,7 @@ -- [ 'Push' ('segment' \"foo\") -- , 'Attr' ('key' \"x\") ('value' \"a\") -- , 'Attr' ('key' \"y\") ('value' \"b\")+-- , 'Push' ('segment' \"bar\") -- , 'Push' ('segment' \"qux\") -- , 'Attr' ('key' \"z\") ('value' \"c\") -- , 'Attr' ('key' \"z\") ('value' \"d\")
test/Main.hs view
@@ -29,13 +29,13 @@ tt :: Tasty.TestTree tt = Tasty.testGroup "df1"- [ Tasty.localOption (QC.QuickCheckTests 1000) $+ [ 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) - , Tasty.localOption (QC.QuickCheckTests 1000) $+ , 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)