diff --git a/df1-html/CHANGELOG.md b/df1-html/CHANGELOG.md index fe26e36..6a0601e 100644 --- a/df1-html/CHANGELOG.md +++ b/df1-html/CHANGELOG.md @@ -1,3 +1,8 @@ +# Version 0.1.1 + +* Catch-up with `xmlbf`. + + # Version 0.1 * Initial version diff --git a/df1-html/default.nix b/df1-html/default.nix index e92af50..5b36e2f 100644 --- a/df1-html/default.nix +++ b/df1-html/default.nix @@ -4,7 +4,7 @@ }: mkDerivation { pname = "df1-html"; - version = "0.1"; + version = "0.1.1"; src = ./.; libraryHaskellDepends = [ attoparsec base bytestring containers df1 text time xmlbf diff --git a/df1-html/df1-html.cabal b/df1-html/df1-html.cabal index 36d3c33..d373fb9 100644 --- a/df1-html/df1-html.cabal +++ b/df1-html/df1-html.cabal @@ -1,11 +1,11 @@ name: df1-html -version: 0.1 +version: 0.1.1 author: Melisa Laura Diaz maintainer: renĪ»ren.zone copyright: Renzo Carbonara 2020 license: BSD3 license-file: LICENSE.txt -extra-source-files: +extra-source-files: README.md CHANGELOG.md theme-solarized-dark.css @@ -52,5 +52,5 @@ test-suite test tasty-hunit, tasty-quickcheck, text, - time, + time, xmlbf diff --git a/df1-html/lib/Df1/Html/Parse.hs b/df1-html/lib/Df1/Html/Parse.hs index 8379b9f..74470d0 100644 --- a/df1-html/lib/Df1/Html/Parse.hs +++ b/df1-html/lib/Df1/Html/Parse.hs @@ -41,12 +41,12 @@ attrClass t = do parseTime :: X.Parser TL.Text parseTime = X.pElement "span" $ do attrClass "df1-time" - X.pText + X.pTextLazy parseLevel :: X.Parser TL.Text parseLevel = X.pElement "span" $ do attrClass "df1-level" - X.pText + X.pTextLazy parsePaths :: X.Parser TL.Text parsePaths = X.pElement "span" $ do @@ -56,34 +56,34 @@ parsePaths = X.pElement "span" $ do parsePush :: X.Parser TL.Text parsePush = X.pElement "span" $ do attrClass "df1-push" - t <- X.pText + t <- X.pTextLazy s <- parseSeg pure (t <> s) parseSeg :: X.Parser TL.Text parseSeg = X.pElement "span" $ do attrClass "df1-seg" - X.pText <|> pure "" + X.pTextLazy <|> pure "" parseAttr :: X.Parser TL.Text parseAttr = X.pElement "span" $ do attrClass "df1-attr" k <- parseKey - eq <- X.pText + eq <- X.pTextLazy v <- parseValue pure (k <> eq <> v) parseKey :: X.Parser TL.Text parseKey = X.pElement "span" $ do attrClass "df1-key" - X.pText <|> pure "" + X.pTextLazy <|> pure "" parseValue :: X.Parser TL.Text parseValue = X.pElement "span" $ do attrClass "df1-value" - X.pText <|> pure "" + X.pTextLazy <|> pure "" parseMessage :: X.Parser TL.Text parseMessage = X.pElement "span" $ do attrClass "df1-msg" - X.pText <|> pure "" + X.pTextLazy <|> pure "" diff --git a/df1-html/lib/Df1/Html/Render.hs b/df1-html/lib/Df1/Html/Render.hs index 2954788..8ccd251 100644 --- a/df1-html/lib/Df1/Html/Render.hs +++ b/df1-html/lib/Df1/Html/Render.hs @@ -25,20 +25,20 @@ import Prelude hiding (log) -- | Converts 'D.Log' into a list of 'X.Node's from "Xmlbf" to render it as HTML. -- --- Example log: +-- Example log: -- @1999-12-20T07:11:39.230553031Z \/foo x=a y=b \/bar \/qux z=c z=d WARNING Something@ -- --- The generated HTML matches the following CSS selectors: +-- The generated HTML matches the following CSS selectors: -- --- [@.df1-log.df1-debug@]: +-- [@.df1-log.df1-debug@]: -- --- [@.df1-log.df1-info@]: +-- [@.df1-log.df1-info@]: -- --- [@.df1-log.df1-notice@]: +-- [@.df1-log.df1-notice@]: -- --- [@.df1-log.df1-warning@]: +-- [@.df1-log.df1-warning@]: -- --- [@.df1-log.df1-error@]: +-- [@.df1-log.df1-error@]: -- -- [@.df1-log.df1-critical@]: -- @@ -49,17 +49,17 @@ import Prelude hiding (log) -- [@.df1-log .df1-time@]: Timestamp - Example: @1999-12-20T07:11:39.230553031Z@ -- -- [@.df1-log .df1-path@]: Full list of 'D.Path's - Example: @\/foo x=a y=b \/bar \/qux z=c z=d@ --- +-- -- [@.df1-log .df1-path .df1-push@]: Single 'D.Push' - Examples: @\/foo@, @\/bar@, @\/qux@ -- -- [@.df1-log .df1-path .df1-push .df1-seg@]: Single 'D.Segment' - Example: @foo@ --- +-- -- [@.df1-log .df1-path .df1-attr@]: Single 'D.Attr' - Example: @x=a@, @y=b@, @z=c@, @z=d@ -- -- [@.df1-log .df1-path .df1-attr .df1-key@]: Single 'D.Key' - Example: @x@, @y@, @z@, @z@ -- -- [@.df1-log .df1-path .df1-attr .df1-value@]: Single 'D.Value' - Example: @a@, @b@, @c@, @d@ --- +-- -- [@.df1-log .df1-level@]: 'D.Level' - Example: @WARNING@ -- -- [@.df1-log .df1-msg@]: 'D.Message' - Example: @Something@ @@ -78,10 +78,10 @@ log x = ] levelClass :: D.Level -> T.Text -levelClass l = "df1-" <> TL.toStrict (TL.toLower (levelToText l)) +levelClass l = "df1-" <> T.toLower (levelToText l) timeHtml :: Time.SystemTime -> [X.Node] -timeHtml t = spanClass "df1-time" (X.text (textLazyFromBuilder (DR.iso8601 t))) +timeHtml t = spanClass "df1-time" (X.textLazy (textLazyFromBuilder (DR.iso8601 t))) textLazyFromBuilder :: BB.Builder -> TL.Text textLazyFromBuilder b = TL.fromStrict (TE.decodeUtf8 (BL.toStrict (BB.toLazyByteString b))) @@ -89,7 +89,7 @@ textLazyFromBuilder b = TL.fromStrict (TE.decodeUtf8 (BL.toStrict (BB.toLazyByte levelHtml :: D.Level -> [X.Node] levelHtml l = spanClass "df1-level" (X.text (levelToText l)) -levelToText :: D.Level -> TL.Text +levelToText :: D.Level -> T.Text levelToText l = case l of D.Debug -> "DEBUG" @@ -102,7 +102,7 @@ levelToText l = D.Emergency -> "EMERGENCY" messageHtml :: D.Message -> [X.Node] -messageHtml m = spanClass "df1-msg" (X.text (textLazyFromBuilder (DR.message m))) +messageHtml m = spanClass "df1-msg" (X.textLazy (textLazyFromBuilder (DR.message m))) pathsHtml :: Seq.Seq D.Path -> [X.Node] pathsHtml ps = spanClass "df1-path" (intercalate (X.text " ") (fmap pathHtml (toList ps))) @@ -113,21 +113,21 @@ pathHtml p = case p of D.Attr key val -> spanClass "df1-attr" (keyHtml key <> X.text "=" <> valueHtml val) segmentHtml :: D.Segment -> [X.Node] -segmentHtml s = spanClass "df1-seg" (X.text (textLazyFromBuilder (DR.segment s))) +segmentHtml s = spanClass "df1-seg" (X.textLazy (textLazyFromBuilder (DR.segment s))) keyHtml :: D.Key -> [X.Node] -keyHtml k = spanClass "df1-key" (X.text (textLazyFromBuilder (DR.key k))) +keyHtml k = spanClass "df1-key" (X.textLazy (textLazyFromBuilder (DR.key k))) valueHtml :: D.Value -> [X.Node] -valueHtml v = spanClass "df1-value" (X.text (textLazyFromBuilder (DR.value v))) +valueHtml v = spanClass "df1-value" (X.textLazy (textLazyFromBuilder (DR.value v))) spanClass :: T.Text -> [X.Node] -> [X.Node] spanClass t = X.element "span" [("class", t)] -- $themes --- +-- -- If you need to style the rendered HTML, you can use some of the themes shipped with this library. --- +-- -- == [theme-solarized-dark.css](https://raw.githubusercontent.com/k0001/di/master/df1-html/theme-solarized-dark.css) -- -- To use this theme, wrap the @.df1-log@ elements in a @.df1-theme-solarized-dark@ element. diff --git a/df1-html/test/Main.hs b/df1-html/test/Main.hs index 8bf773c..fe67028 100644 --- a/df1-html/test/Main.hs +++ b/df1-html/test/Main.hs @@ -35,16 +35,16 @@ tt = [ HU.testCase "Given a D.Log, render it as HTML" $ do expected1 @=? DHR.log log1, - HU.testCase "Parse that HTML to reobtain the D.Log" $ do - case X.runParser DHP.log expected1 of + HU.testCase "Parse that HTML to reobtain the D.Log" $ do + case X.parse DHP.log expected1 of Left _ -> fail "Could not parse Log." Right a -> log1 @=? a, - + Tasty.localOption (QC.QuickCheckTests 2000) $ QC.testProperty "Render/Parse roundtrip" $ do QC.forAllShrink QC.arbitrary QC.shrink $ \log0 -> do let html = DHR.log log0 - Right log0 === X.runParser DHP.log html + Right log0 === X.parse DHP.log html ] @@ -156,4 +156,4 @@ genSystemTime :: QC.Gen Time.SystemTime genSystemTime = do a <- QC.choose (0, 253402300799) -- up to 4 digit years b <- QC.choose (0, 1000000000) - pure (Time.MkSystemTime a b) \ No newline at end of file + pure (Time.MkSystemTime a b)