df1 0.4.2 → 0.4.3
raw patch · 5 files changed
+271/−206 lines, 5 filesdep +HUnitdep +tasty-hunitPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, tasty-hunit
API changes (from Hackage documentation)
Files
- CHANGELOG.md +7/−0
- df1.cabal +3/−1
- lib/Df1/Render.hs +4/−7
- lib/Df1/Types.hs +253/−198
- test/Main.hs +4/−0
CHANGELOG.md view
@@ -1,3 +1,10 @@+# Version 0.4.3++* Added instances for `text`'s `Builder`.++* Don't escape `=` in `Value`.++ # Version 0.4.2 * Remove a lot of inlining to make compilation faster.
df1.cabal view
@@ -1,5 +1,5 @@ name: df1-version: 0.4.2+version: 0.4.3 author: Renzo Carbonara maintainer: renλren.zone copyright: Renzo Carbonara 2016@@ -42,7 +42,9 @@ bytestring, df1, QuickCheck,+ HUnit, text, time, tasty,+ tasty-hunit, tasty-quickcheck
lib/Df1/Render.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-} module Df1.Render ( log@@ -119,7 +119,7 @@ where {-# INLINE eall #-} eall = TL.encodeUtf8BuilderEscaped- $ BBP.condB (== 37) word8HexPercent -- '%'+ $ BBP.condB (== 0x25) word8HexPercent -- '%' $ BBP.condB isControl7 word8HexPercent $ BBP.liftFixedToBounded BBP.word8 @@ -189,8 +189,6 @@ -- -- * A \'%\' anywhere is always percent-escaped (\"%25\")" ----- * A \'=\' anywhere is always percent-escaped (\"%3d\").--- -- * An ASCII-7 control character anywhere is always percent-escaped. -- -- The output is encoded as UTF-8.@@ -200,9 +198,8 @@ where {-# INLINE eall #-} eall = TL.encodeUtf8BuilderEscaped- $ BBP.condB (== 0x20) word8HexPercent- $ BBP.condB (== 0x25) word8HexPercent- $ BBP.condB (== 0x3d) word8HexPercent+ $ BBP.condB (== 0x20) word8HexPercent -- ' '+ $ BBP.condB (== 0x25) word8HexPercent -- '%' $ BBP.condB isControl7 word8HexPercent $ BBP.liftFixedToBounded BBP.word8
lib/Df1/Types.hs view
@@ -2,55 +2,67 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_GHC -Wno-unused-imports #-} 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), ToPath(path)- , Segment, unSegment, ToSegment(segment)- , Key, unKey, ToKey(key)- , Value, unValue, ToValue(value)- , Message, unMessage, ToMessage(message)- ) where+ ( Log (Log, log_time, log_level, log_path, log_message)+ , Level (Debug, Info, Notice, Warning, Error, Critical, Alert, Emergency)+ , Path (Attr, Push)+ , ToPath (path)+ , Segment+ , unSegment+ , ToSegment (segment)+ , Key+ , unKey+ , ToKey (key)+ , Value+ , unValue+ , ToValue (value)+ , Message+ , unMessage+ , ToMessage (message)+ ) 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.Int (Int16, Int32, Int64, Int8)+import Data.Semigroup (Semigroup ((<>))) import Data.Sequence as Seq+import Data.String (IsString (fromString)) import qualified Data.Text as T import qualified Data.Text.Lazy as TL-import Data.Int (Int8, Int16, Int32, Int64)-import Data.Word (Word8, Word16, Word32, Word64)-import Numeric.Natural (Natural)-import Data.String (IsString(fromString))+import qualified Data.Text.Lazy.Builder as TB import qualified Data.Time as Time import qualified Data.Time.Clock.System as Time import qualified Data.Time.Format.ISO8601 as Time+import Data.Word (Word16, Word32, Word64, Word8)+import Numeric.Natural (Natural) -------------------------------------------------------------------------------- data Log = Log- { log_time :: !Time.SystemTime- -- ^ First known timestamp when the log was generated.- --- -- We use 'Time.SystemTime' rather than 'Time.UTCTime' because it is- -- cheaper to obtain and to render. You can use- -- 'Data.Time.Clock.System.systemToUTCTime' to convert it if necessary.- , log_level :: !Level- -- ^ Importance level of the logged message.- , log_path :: !(Seq.Seq Path)- -- ^ 'Path' where the logged message was created from.- --- -- The leftmost 'Path' is the closest to the root. The rightmost 'Path' is- -- the one closest to where the log was generated.- --- -- An 'Seq.empty' 'Seq.Seq' is acceptable, conveying the idea of the “root- -- path”.- , log_message :: !Message- -- ^ Human-readable message itself.- } deriving (Eq, Show)+ { log_time :: !Time.SystemTime+ -- ^ First known timestamp when the log was generated.+ --+ -- We use 'Time.SystemTime' rather than 'Time.UTCTime' because it is+ -- cheaper to obtain and to render. You can use+ -- 'Data.Time.Clock.System.systemToUTCTime' to convert it if necessary.+ , log_level :: !Level+ -- ^ Importance level of the logged message.+ , log_path :: !(Seq.Seq Path)+ -- ^ 'Path' where the logged message was created from.+ --+ -- The leftmost 'Path' is the closest to the root. The rightmost 'Path' is+ -- the one closest to where the log was generated.+ --+ -- An 'Seq.empty' 'Seq.Seq' is acceptable, conveying the idea of the “root+ -- path”.+ , log_message :: !Message+ -- ^ Human-readable message itself.+ }+ deriving (Eq, Show) -------------------------------------------------------------------------------- @@ -68,23 +80,23 @@ -- Notice that @\"\" :: 'Message'@ is acceptable, and will be correctly rendered -- and parsed back. newtype Message = Message TL.Text- deriving (Eq, Show)+ deriving (Eq, Show) unMessage :: Message -> TL.Text unMessage = coerce {-# INLINE unMessage #-} instance IsString Message where- fromString = message- {-# INLINE fromString #-}+ fromString = message+ {-# INLINE fromString #-} instance Semigroup Message where- (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)- {-# INLINE (<>) #-}+ (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)+ {-# INLINE (<>) #-} instance Monoid Message where- mempty = Message mempty- {-# INLINE mempty #-}+ mempty = Message mempty+ {-# INLINE mempty #-} -- | Convert an arbitrary type to a 'Message'. --@@ -95,40 +107,48 @@ -- 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 ToMessage a where- message :: a -> Message+ message :: a -> Message -- | Identity. instance ToMessage Message where- message = id- {-# INLINE message #-}+ message = id+ {-# INLINE message #-} -- | -- @ -- x :: 'TL.Text' == 'unMessage' ('message' x) -- @ instance ToMessage TL.Text where- message = Message- {-# INLINE message #-}+ message = Message+ {-# INLINE message #-} -- | -- @+-- 'TB.toLazyText' (x :: 'TB.Builder') == 'unMessage' ('message' x)+-- @+instance ToMessage TB.Builder where+ message = Message . TB.toLazyText+ {-# INLINE message #-}++-- |+-- @ -- x :: 'T.Text' == 'TL.toStrict' ('unMessage' ('message' x)) -- @ instance ToMessage T.Text where- message = Message . TL.fromStrict- {-# INLINE message #-}+ message = Message . TL.fromStrict+ {-# INLINE message #-} -- | -- @ -- x :: 'String' == 'TL.unpack' ('unMessage' ('message' x)) -- @ instance ToMessage String where- message = Message . TL.pack- {-# INLINE message #-}+ message = Message . TL.pack+ {-# INLINE message #-} instance ToMessage SomeException where- message = message . show- {-# INLINE message #-}+ message = message . show+ {-# INLINE message #-} -------------------------------------------------------------------------------- @@ -137,27 +157,27 @@ -- These levels, listed in increasing order of importance, correspond to the -- levels used by [syslog(3)](https://linux.die.net/man/3/syslog). data Level- = Debug- -- ^ Message intended to be useful only when deliberately debugging a program.- | Info- -- ^ Informational message.- | Notice- -- ^ A condition that is not an error, but should possibly be handled- -- specially.- | Warning- -- ^ A warning condition, such as an exception being gracefully handled or- -- some missing configuration setting being assigned a default value.- | Error- -- ^ Error condition, such as an unhandled exception.- | Critical- -- ^ Critical condition that could result in system failure, such as a disk- -- running out of space.- | Alert- -- ^ A condition that should be corrected immediately, such as a corrupted- -- database.- | Emergency- -- ^ System is unusable.- deriving (Eq, Show, Read, Bounded, Enum)+ = -- | Message intended to be useful only when deliberately debugging a program.+ Debug+ | -- | Informational message.+ Info+ | -- | A condition that is not an error, but should possibly be handled+ -- specially.+ Notice+ | -- | A warning condition, such as an exception being gracefully handled or+ -- some missing configuration setting being assigned a default value.+ Warning+ | -- | Error condition, such as an unhandled exception.+ Error+ | -- | Critical condition that could result in system failure, such as a disk+ -- running out of space.+ Critical+ | -- | A condition that should be corrected immediately, such as a corrupted+ -- database.+ Alert+ | -- | System is unusable.+ Emergency+ deriving (Eq, Show, Read, Bounded, Enum) -- | Order of importance. For example, 'Emergency' is more important than -- 'Debug':@@ -183,23 +203,23 @@ -- Notice that @\"\" :: 'Segment'@ is acceptable, and will be correctly rendered -- and parsed back. newtype Segment = Segment TL.Text- deriving (Eq, Show)+ deriving (Eq, Show) unSegment :: Segment -> TL.Text unSegment = coerce {-# INLINE unSegment #-} instance IsString Segment where- fromString = segment- {-# INLINE fromString #-}+ fromString = segment+ {-# INLINE fromString #-} instance Semigroup Segment where- (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)- {-# INLINE (<>) #-}+ (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)+ {-# INLINE (<>) #-} instance Monoid Segment where- mempty = Segment mempty- {-# INLINE mempty #-}+ mempty = Segment mempty+ {-# INLINE mempty #-} -- | Convert an arbitrary type to a 'Segment'. --@@ -210,40 +230,48 @@ -- 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 ToSegment a where- segment :: a -> Segment+ segment :: a -> Segment -- | Identity. instance ToSegment Segment where- segment = id- {-# INLINE segment #-}+ segment = id+ {-# INLINE segment #-} -- | -- @ -- x :: 'TL.Text' == 'unSegment' ('segment' x) -- @ instance ToSegment TL.Text where- segment = Segment- {-# INLINE segment #-}+ segment = Segment+ {-# INLINE segment #-} -- | -- @+-- 'TB.toLazyText' (x :: 'TB.Builder') == 'unSegment' ('segment' x)+-- @+instance ToSegment TB.Builder where+ segment = Segment . TB.toLazyText+ {-# INLINE segment #-}++-- |+-- @ -- x :: 'T.Text' == 'TL.toStrict' ('unSegment' ('segment' x)) -- @ instance ToSegment T.Text where- segment = Segment . TL.fromStrict- {-# INLINE segment #-}+ segment = Segment . TL.fromStrict+ {-# INLINE segment #-} -- | -- @ -- x :: 'String' == 'TL.unpack' ('unSegment' ('segment' x)) -- @ instance ToSegment String where- segment = Segment . TL.pack- {-# INLINE segment #-}+ segment = Segment . TL.pack+ {-# INLINE segment #-} instance ToSegment Char where- segment = Segment . TL.singleton- {-# INLINE segment #-}+ segment = Segment . TL.singleton+ {-# INLINE segment #-} -------------------------------------------------------------------------------- @@ -261,23 +289,23 @@ -- Notice that @\"\" :: 'Key'@ is acceptable, and will be correctly rendered and -- parsed back. newtype Key = Key TL.Text- deriving (Eq, Show)+ deriving (Eq, Show) unKey :: Key -> TL.Text unKey = coerce {-# INLINE unKey #-} instance IsString Key where- fromString = key- {-# INLINE fromString #-}+ fromString = key+ {-# INLINE fromString #-} instance Semigroup Key where- (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)- {-# INLINE (<>) #-}+ (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)+ {-# INLINE (<>) #-} instance Monoid Key where- mempty = Key mempty- {-# INLINE mempty #-}+ mempty = Key mempty+ {-# INLINE mempty #-} -- | Convert an arbitrary type to a 'Key'. --@@ -288,40 +316,48 @@ -- 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 ToKey a where- key :: a -> Key+ key :: a -> Key -- | Identity. instance ToKey Key where- key = id- {-# INLINE key #-}+ key = id+ {-# INLINE key #-} -- | -- @ -- x :: 'TL.Text' == 'unKey' ('key' x) -- @ instance ToKey TL.Text where- key = Key- {-# INLINE key #-}+ key = Key+ {-# INLINE key #-} -- | -- @+-- 'TB.toLazyText' (x :: 'TB.Builder') == 'unKey' ('key' x)+-- @+instance ToKey TB.Builder where+ key = Key . TB.toLazyText+ {-# INLINE key #-}++-- |+-- @ -- x :: 'T.Text' == 'TL.toStrict' ('unKey' ('key' x)) -- @ instance ToKey T.Text where- key = Key . TL.fromStrict- {-# INLINE key #-}+ key = Key . TL.fromStrict+ {-# INLINE key #-} -- | -- @ -- x :: 'String' == 'TL.unpack' ('unKey' ('key' x)) -- @ instance ToKey String where- key = Key . TL.pack- {-# INLINE key #-}+ key = Key . TL.pack+ {-# INLINE key #-} instance ToKey Char where- key = Key . TL.singleton- {-# INLINE key #-}+ key = Key . TL.singleton+ {-# INLINE key #-} -------------------------------------------------------------------------------- @@ -339,23 +375,23 @@ -- Notice that @\"\" :: 'Value'@ is acceptable, and will be correctly rendered -- and parsed back. newtype Value = Value TL.Text- deriving (Eq, Show)+ deriving (Eq, Show) unValue :: Value -> TL.Text unValue = coerce {-# INLINE unValue #-} instance IsString Value where- fromString = value- {-# INLINE fromString #-}+ fromString = value+ {-# INLINE fromString #-} instance Semigroup Value where- (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)- {-# INLINE (<>) #-}+ (<>) = coerce ((<>) :: TL.Text -> TL.Text -> TL.Text)+ {-# INLINE (<>) #-} instance Monoid Value where- mempty = Value mempty- {-# INLINE mempty #-}+ mempty = Value mempty+ {-# INLINE mempty #-} -- | Convert an arbitrary type to a 'Value'. --@@ -366,138 +402,157 @@ -- 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 ToValue a where- value :: a -> Value+ value :: a -> Value -- | Identity. instance ToValue Value where- value = id- {-# INLINE value #-}+ value = id+ {-# INLINE value #-} -- | -- @ -- x :: 'TL.Text' == 'unValue' ('value' x) -- @ instance ToValue TL.Text where- value = Value- {-# INLINE value #-}+ value = Value+ {-# INLINE value #-} -- | -- @+-- 'TB.toLazyText' (x :: 'TB.Builder') == 'unValue' ('value' x)+-- @+instance ToValue TB.Builder where+ value = Value . TB.toLazyText+ {-# INLINE value #-}++-- |+-- @ -- x :: 'T.Text' == 'TL.toStrict' ('unValue' ('value' x)) -- @ instance ToValue T.Text where- value = Value . TL.fromStrict- {-# INLINE value #-}+ value = Value . TL.fromStrict+ {-# INLINE value #-} -- | -- @ -- x :: 'String' == 'TL.unpack' ('unValue' ('value' x)) -- @ instance ToValue String where- value = Value . TL.pack- {-# INLINE value #-}+ value = Value . TL.pack+ {-# INLINE value #-} instance ToValue SomeException where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Bool where- value = \b -> if b then "true" else "false"- {-# INLINE value #-}+ value = \b -> if b then "true" else "false"+ {-# INLINE value #-} instance ToValue Char where- value = Value . TL.singleton- {-# INLINE value #-}+ value = Value . TL.singleton+ {-# INLINE value #-} instance ToValue Int where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Int8 where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Int16 where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Int32 where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Int64 where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Word where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Word8 where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Word16 where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Word32 where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Word64 where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Integer where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Natural where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Float where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-} instance ToValue Double where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-}+ -- | Chops trailing zeros.-instance Fixed.HasResolution a => ToValue (Fixed.Fixed a) where- value = value . Fixed.showFixed True- {-# INLINE value #-}+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 #-}+ value = value . Time.iso8601Show+ {-# INLINE value #-}+ -- | See 'Time.ISO8601'. instance ToValue Time.CalendarDiffTime where- value = value . Time.iso8601Show- {-# INLINE value #-}+ value = value . Time.iso8601Show+ {-# INLINE value #-}+ -- | See 'Time.ISO8601'. instance ToValue Time.Day where- value = value . Time.iso8601Show- {-# INLINE value #-}+ value = value . Time.iso8601Show+ {-# INLINE value #-}+ -- | See 'Time.ISO8601'. instance ToValue Time.TimeZone where- value = value . Time.iso8601Show- {-# INLINE value #-}+ value = value . Time.iso8601Show+ {-# INLINE value #-}+ -- | See 'Time.ISO8601'. instance ToValue Time.TimeOfDay where- value = value . Time.iso8601Show- {-# INLINE value #-}+ value = value . Time.iso8601Show+ {-# INLINE value #-}+ -- | See 'Time.ISO8601'. instance ToValue Time.LocalTime where- value = value . Time.iso8601Show- {-# INLINE value #-}+ value = value . Time.iso8601Show+ {-# INLINE value #-}+ -- | See 'Time.ISO8601'. instance ToValue Time.ZonedTime where- value = value . Time.iso8601Show- {-# INLINE value #-}+ value = value . Time.iso8601Show+ {-# INLINE value #-}+ -- | @123456s@ instance ToValue Time.NominalDiffTime where- value = value . show- {-# INLINE value #-}+ value = value . show+ {-# INLINE value #-}+ -- | @123456s@ instance ToValue Time.DiffTime where- value = value . show- {-# INLINE value #-}+ 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"+ Time.Monday -> "monday"+ Time.Tuesday -> "tuesday"+ Time.Wednesday -> "wednesday"+ Time.Thursday -> "thursday"+ Time.Friday -> "friday"+ Time.Saturday -> "saturday"+ Time.Sunday -> "sunday" -------------------------------------------------------------------------------- @@ -526,9 +581,9 @@ -- Please notice that @[] :: 'Seq.Seq' 'Path'@ is a valid path insofar as /df1/ -- is concerned, and that 'Attr' and 'Push' can be juxtapositioned in any order. data Path- = Push !Segment- | Attr !Key !Value- deriving (Eq, Show)+ = Push !Segment+ | Attr !Key !Value+ deriving (Eq, Show) -- | Convert an arbitrary type to a 'Seq'uence of 'Path's. --@@ -539,21 +594,21 @@ -- 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+ -- | 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 = id+ {-# INLINE path #-} -- | -- @ -- 'path' = 'Seq.fromList' . 'toList' -- @-instance {-# OVERLAPPABLE #-} Foldable f => ToPath (f Path) where- path = Seq.fromList . toList- {-# INLINE path #-}+instance {-# OVERLAPPABLE #-} (Foldable f) => ToPath (f Path) where+ path = Seq.fromList . toList+ {-# INLINE path #-}
test/Main.hs view
@@ -14,6 +14,7 @@ import Data.Time.Clock.System as Time import qualified Test.Tasty as Tasty import Test.Tasty.QuickCheck ((===))+import Test.Tasty.HUnit ((@=?), testCase) import qualified Test.Tasty.QuickCheck as QC import qualified Test.Tasty.Runners as Tasty @@ -43,6 +44,9 @@ let bl = BB.toLazyByteString (Df1.Render.log log0) blColor = BB.toLazyByteString (Df1.Render.logColorANSI log0) bl === removeAnsiEscapes blColor++ , testCase "render.value" $ do+ "a%20b%25c=d" @=? BB.toLazyByteString (Df1.Render.value "a b%c=d") ] instance QC.Arbitrary Df1.Log where