df1-html (empty) → 0.1

raw patch · 12 files changed

+616/−0 lines, 12 filesdep +QuickCheckdep +attoparsecdep +basesetup-changedbinary-added

Dependencies added: QuickCheck, attoparsec, base, bytestring, containers, df1, df1-html, tasty, tasty-hunit, tasty-quickcheck, text, time, xmlbf

Files

• CHANGELOG.md +4/−0
• LICENSE.txt +30/−0
• README.md +7/−0
• Setup.hs +4/−0
• df1-html.cabal +56/−0
• lib/Df1/Html/Parse.hs +89/−0
• lib/Df1/Html/Render.hs +141/−0
• test/Main.hs +159/−0
• theme-solarized-dark.css +63/−0
• theme-solarized-dark.png binary
• theme-solarized-light.css +63/−0
• theme-solarized-light.png binary

@@ -0,0 +1,4 @@+# Version 0.1++* Initial version+

@@ -0,0 +1,30 @@+Copyright (c) 2020, Renzo Carbonara++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Renzo Carbonara nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,7 @@+# df1-html++Render and parse logs from [df1] (https://hackage.haskell.org/package/df1) as HTML using the library [xmlbf] (https://hackage.haskell.org/package/xmlbf).++See the [BSD3 LICENSE](https://github.com/k0001/di/blob/master/df1-html/LICENSE.txt)+file to learn about the legal terms and conditions for this library.+

@@ -0,0 +1,4 @@+#! /usr/bin/env nix-shell+#! nix-shell ./shell.nix -i runghc+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,56 @@+name: df1-html+version: 0.1+author: Melisa Laura Diaz+maintainer: renλren.zone+copyright: Renzo Carbonara 2020+license: BSD3+license-file: LICENSE.txt+extra-source-files: +  README.md+  CHANGELOG.md+  theme-solarized-dark.css+  theme-solarized-dark.png+  theme-solarized-light.css+  theme-solarized-light.png+category: Logging+build-type: Simple+cabal-version: >=1.18+synopsis: Render and parse df1 logs as HTML+description: Render and parse df1 logs as HTML+homepage: https://github.com/k0001/di+bug-reports: https://github.com/k0001/di/issues++library+  hs-source-dirs: lib+  default-language: Haskell2010+  exposed-modules: Df1.Html.Render, Df1.Html.Parse+  build-depends:+    attoparsec,+    base >=4.9 && <5.0,+    bytestring,+    containers,+    df1,+    text,+    time,+    xmlbf+  ghcjs-options: -Wall -O3+  ghc-options: -Wall -O2++test-suite test+  default-language: Haskell2010+  ghc-options: -threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-depends:+    base,+    containers,+    df1,+    df1-html,+    QuickCheck,+    tasty,+    tasty-hunit,+    tasty-quickcheck,+    text,+    time,    +    xmlbf

@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Df1.Html.Parse (log) where++import Control.Applicative+import qualified Data.Attoparsec.ByteString as AB+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE+import qualified Df1 as D+import qualified Df1.Parse+import qualified Xmlbf as X+import Prelude hiding (log)++-- | An "Xmlbf" parser for a 'D.Log' rendered as HTML as 'Df1.Html.Render.log' renders it.+--+-- Notice that this parser will not ignore leading and trailing white space in the HTML.+-- It will become part of the parsed 'D.Key', 'D.Value', 'D.Segment', 'D.Message'.+log :: X.Parser D.Log+log = X.pElement "div" $ do+  attrClass "df1-log"+  t <- parseTime+  p <- parsePaths+  l <- parseLevel+  m <- parseMessage+  let raw = BL.toStrict $ TLE.encodeUtf8 $ TL.intercalate " " [t, p, l, m]+  case AB.parseOnly Df1.Parse.log raw of+    Left _ -> fail "Could not parse Log."+    Right a -> pure a++attrClass :: T.Text -> X.Parser ()+attrClass t = do+  attrs <- X.pAttr "class"+  case elem t (T.words attrs) of+    False -> fail ("Expected \"class\" value to contain " <> show t <> ".")+    True -> pure ()++parseTime :: X.Parser TL.Text+parseTime = X.pElement "span" $ do+  attrClass "df1-time"+  X.pText++parseLevel :: X.Parser TL.Text+parseLevel = X.pElement "span" $ do+  attrClass "df1-level"+  X.pText++parsePaths :: X.Parser TL.Text+parsePaths = X.pElement "span" $ do+  attrClass "df1-path"+  TL.intercalate " " <$> many (parsePush <|> parseAttr)++parsePush :: X.Parser TL.Text+parsePush = X.pElement "span" $ do+  attrClass "df1-push"+  t <- X.pText+  s <- parseSeg+  pure (t <> s)++parseSeg :: X.Parser TL.Text+parseSeg = X.pElement "span" $ do+  attrClass "df1-seg"+  X.pText <|> pure ""++parseAttr :: X.Parser TL.Text+parseAttr = X.pElement "span" $ do+  attrClass "df1-attr"+  k <- parseKey+  eq <- X.pText+  v <- parseValue+  pure (k <> eq <> v)++parseKey :: X.Parser TL.Text+parseKey = X.pElement "span" $ do+  attrClass "df1-key"+  X.pText <|> pure ""++parseValue :: X.Parser TL.Text+parseValue = X.pElement "span" $ do+  attrClass "df1-value"+  X.pText <|> pure ""++parseMessage :: X.Parser TL.Text+parseMessage = X.pElement "span" $ do+  attrClass "df1-msg"+  X.pText <|> pure ""

@@ -0,0 +1,141 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}++module Df1.Html.Render+  ( log,+   -- * Themes+   --+   -- $themes+  )+where++import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import Data.Foldable (toList)+import Data.List (intercalate)+import qualified Data.Sequence as Seq+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Time.Clock.System as Time+import qualified Df1 as D+import qualified Df1.Render as DR+import qualified Xmlbf as X+import Prelude hiding (log)++-- | Converts 'D.Log' into a list of 'X.Node's from "Xmlbf" to render it as HTML.+--+-- 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: +--+-- [@.df1-log.df1-debug@]: +--+-- [@.df1-log.df1-info@]: +--+-- [@.df1-log.df1-notice@]: +--+-- [@.df1-log.df1-warning@]: +--+-- [@.df1-log.df1-error@]: +--+-- [@.df1-log.df1-critical@]:+--+-- [@.df1-log.df1-alert@]:+--+-- [@.df1-log.df1-emergency@]: Top level container for a 'D.Log' entry of a particular 'D.Level'.+--+-- [@.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@+--+log :: D.Log -> [X.Node]+log x =+  X.element "div" [("class", "df1-log " <> levelClass (D.log_level x))] $+    mconcat+      [ timeHtml (D.log_time x),+        X.text " ",+        pathsHtml (D.log_path x),+        X.text " ",+        levelHtml (D.log_level x),+        X.text " ",+        messageHtml (D.log_message x)+      ]++levelClass :: D.Level -> T.Text+levelClass l = "df1-" <> TL.toStrict (TL.toLower (levelToText l))++timeHtml :: Time.SystemTime -> [X.Node]+timeHtml t = spanClass "df1-time" (X.text (textLazyFromBuilder (DR.iso8601 t)))++textLazyFromBuilder :: BB.Builder -> TL.Text+textLazyFromBuilder b = TL.fromStrict (TE.decodeUtf8 (BL.toStrict (BB.toLazyByteString b)))++levelHtml :: D.Level -> [X.Node]+levelHtml l = spanClass "df1-level" (X.text (levelToText l))++levelToText :: D.Level -> TL.Text+levelToText l =+  case l of+    D.Debug -> "DEBUG"+    D.Info -> "INFO"+    D.Notice -> "NOTICE"+    D.Warning -> "WARNING"+    D.Error -> "ERROR"+    D.Critical -> "CRITICAL"+    D.Alert -> "ALERT"+    D.Emergency -> "EMERGENCY"++messageHtml :: D.Message -> [X.Node]+messageHtml m = spanClass "df1-msg" (X.text (textLazyFromBuilder (DR.message m)))++pathsHtml :: Seq.Seq D.Path -> [X.Node]+pathsHtml ps = spanClass "df1-path" (intercalate (X.text " ") (fmap pathHtml (toList ps)))++pathHtml :: D.Path -> [X.Node]+pathHtml p = case p of+  D.Push seg -> spanClass "df1-push" (X.text "/" <> segmentHtml seg)+  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)))++keyHtml :: D.Key -> [X.Node]+keyHtml k = spanClass "df1-key" (X.text (textLazyFromBuilder (DR.key k)))++valueHtml :: D.Value -> [X.Node]+valueHtml v = spanClass "df1-value" (X.text (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.+--+-- ![theme-solarized-dark](https://raw.githubusercontent.com/k0001/di/master/df1-html/theme-solarized-dark.png)+--+-- == [theme-solarized-light.css](https://raw.githubusercontent.com/k0001/di/master/df1-html/theme-solarized-light.css)+--+-- To use this theme, wrap the @.df1-log@ elements in a @.df1-theme-solarized-light@ element.+--+-- ![theme-solarized-light](https://raw.githubusercontent.com/k0001/di/master/df1-html/theme-solarized-light.png)

@@ -0,0 +1,159 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import qualified Data.Sequence as Seq+import Data.String (fromString)+import qualified Data.Text.Lazy as TL+import qualified Data.Time.Clock.System as Time+import qualified Df1 as D+import qualified Df1.Html.Parse as DHP+import qualified Df1.Html.Render as DHR+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.HUnit as HU+import Test.Tasty.HUnit ((@=?))+import Test.Tasty.QuickCheck ((===))+import qualified Test.Tasty.QuickCheck as QC+import qualified Test.Tasty.Runners as Tasty+import qualified Xmlbf as X++--------------------------------------------------------------------------------++main :: IO ()+main =+  Tasty.defaultMainWithIngredients+    [ Tasty.consoleTestReporter,+      Tasty.listingTests+    ]+    tt++tt :: Tasty.TestTree+tt =+  Tasty.testGroup+    "df1-html"+    [ 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 +           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 +    ]+++log1 :: D.Log+log1 =+  D.Log+    { D.log_time = Time.MkSystemTime 355 43,+      D.log_level = D.Warning,+      D.log_path = examplePath,+      D.log_message = D.message ("example" :: String)+    }++examplePath :: Seq.Seq D.Path+examplePath =+  [ D.Push (D.segment ("foo" :: String)),+    D.Attr (D.key ("=" :: String)) (D.value ("a" :: String)),+    D.Attr (D.key ("y" :: String)) (D.value ("b" :: String)),+    D.Push (D.segment ("bar" :: String)),+    D.Push (D.segment ("qux" :: String)),+    D.Attr (D.key ("z" :: String)) (D.value ("c" :: String)),+    D.Attr (D.key ("z" :: String)) (D.value ("d" :: String))+  ]+++expected1 :: [X.Node]+expected1 =+  X.element+    "div"+    [("class", "df1-log df1-warning")]+    $ mconcat+      [ X.element "span" [("class", "df1-time")] (X.text "1970-01-01T00:05:55.000000043Z"),+        X.text " ",+        X.element "span" [("class", "df1-path")] $+          mconcat+            [ X.element "span" [("class", "df1-push")] $ mconcat [X.text "/", X.element "span" [("class", "df1-seg")] (X.text "foo")],+              X.text " ",+              X.element "span" [("class", "df1-attr")] $+                mconcat+                  [ X.element "span" [("class", "df1-key")] (X.text "%3d"),+                    X.text "=",+                    X.element "span" [("class", "df1-value")] (X.text "a")+                  ],+              X.text " ",+              X.element "span" [("class", "df1-attr")] $+                mconcat+                  [ X.element "span" [("class", "df1-key")] (X.text "y"),+                    X.text "=",+                    X.element "span" [("class", "df1-value")] (X.text "b")+                  ],+              X.text " ",+              X.element "span" [("class", "df1-push")] $ mconcat [X.text "/", X.element "span" [("class", "df1-seg")] (X.text "bar")],+              X.text " ",+              X.element "span" [("class", "df1-push")] $ mconcat [X.text "/", X.element "span" [("class", "df1-seg")] (X.text "qux")],+              X.text " ",+              X.element "span" [("class", "df1-attr")] $+                mconcat+                  [ X.element "span" [("class", "df1-key")] (X.text "z"),+                    X.text "=",+                    X.element "span" [("class", "df1-value")] (X.text "c")+                  ],+              X.text " ",+              X.element "span" [("class", "df1-attr")] $+                mconcat+                  [ X.element "span" [("class", "df1-key")] (X.text "z"),+                    X.text "=",+                    X.element "span" [("class", "df1-value")] (X.text "d")+                  ]+            ],+        X.text " ",+        X.element "span" [("class", "df1-level")] (X.text "WARNING"),+        X.text " ",+        X.element "span" [("class", "df1-msg")] (X.text "example")+      ]+++instance QC.Arbitrary D.Log where+  arbitrary = D.Log+    <$> genSystemTime <*> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary+  shrink (D.Log a b c d) = D.Log+    <$> pure a <*> QC.shrink b <*> QC.shrink c <*> QC.shrink d++instance QC.Arbitrary D.Path where+  arbitrary = QC.oneof+    [ D.Push <$> QC.arbitrary+    , D.Attr <$> QC.arbitrary <*> QC.arbitrary ]+  shrink (D.Push s) = D.Push <$> QC.shrink s+  shrink (D.Attr k v) = D.Attr <$> QC.shrink k <*> QC.shrink v++instance QC.Arbitrary D.Level where+  arbitrary = QC.elements [minBound .. minBound]++instance QC.Arbitrary D.Segment where+  arbitrary = fromString <$> QC.arbitrary+  shrink = map fromString . QC.shrink . TL.unpack . D.unSegment++instance QC.Arbitrary D.Key where+  arbitrary = fromString <$> QC.arbitrary+  shrink = map fromString . QC.shrink . TL.unpack . D.unKey++instance QC.Arbitrary D.Value where+  arbitrary = fromString <$> QC.arbitrary+  shrink = map fromString . QC.shrink . TL.unpack . D.unValue++instance QC.Arbitrary D.Message where+  arbitrary = fromString <$> QC.arbitrary+  shrink = map fromString . QC.shrink . TL.unpack . D.unMessage++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)

@@ -0,0 +1,63 @@+.df1-theme-solarized-dark .df1-log {+    font-family: monospace;+}++.df1-theme-solarized-dark .df1-debug,+.df1-theme-solarized-dark .df1-info,+.df1-theme-solarized-dark .df1-notice,+.df1-theme-solarized-dark .df1-warning {+   background-color: #002b36;+   color: #93a1a1;+}++.df1-theme-solarized-dark .df1-debug .df1-push,+.df1-theme-solarized-dark .df1-info .df1-push,+.df1-theme-solarized-dark .df1-notice .df1-push,+.df1-theme-solarized-dark .df1-warning .df1-push,+.df1-theme-solarized-dark .df1-error .df1-push {+    color: #268bd2;+}++.df1-theme-solarized-dark .df1-debug .df1-key,+.df1-theme-solarized-dark .df1-info .df1-key,+.df1-theme-solarized-dark .df1-notice .df1-key,+.df1-theme-solarized-dark .df1-warning .df1-key,+.df1-theme-solarized-dark .df1-error .df1-key,+.df1-theme-solarized-dark .df1-critical .df1-key,+.df1-theme-solarized-dark .df1-alert .df1-key,+.df1-theme-solarized-dark .df1-emergency .df1-key  {+    color: #2aa198;+}++.df1-theme-solarized-dark .df1-notice .df1-level {+    color: #859900;+}++.df1-theme-solarized-dark .df1-warning .df1-level {+    color: #b58900;+}++.df1-theme-solarized-dark .df1-error {+    background-color: #fdf6e3;+    color: #002b36;+}++.df1-theme-solarized-dark .df1-error .df1-level {+    color: #dc322f;+}++.df1-theme-solarized-dark .df1-critical, +.df1-theme-solarized-dark .df1-alert, +.df1-theme-solarized-dark .df1-emergency {+    background-color: #dc322f;+    color: #002b36;+}++.df1-theme-solarized-dark .df1-critical .df1-push,+.df1-theme-solarized-dark .df1-alert .df1-push,+.df1-theme-solarized-dark .df1-emergency .df1-push,+.df1-theme-solarized-dark .df1-critical .df1-level, +.df1-theme-solarized-dark .df1-alert .df1-level, +.df1-theme-solarized-dark .df1-emergency .df1-level {+    color: #fdf6e3;+}

binary file changed (absent → 136367 bytes)

@@ -0,0 +1,63 @@+.df1-theme-solarized-light .df1-log {+    font-family: monospace;+}++.df1-theme-solarized-light .df1-debug,+.df1-theme-solarized-light .df1-info,+.df1-theme-solarized-light .df1-notice,+.df1-theme-solarized-light .df1-warning {+   background-color: #fdf6e3;+   color: #93a1a1;+}++.df1-theme-solarized-light .df1-debug .df1-push,+.df1-theme-solarized-light .df1-info .df1-push,+.df1-theme-solarized-light .df1-notice .df1-push,+.df1-theme-solarized-light .df1-warning .df1-push,+.df1-theme-solarized-light .df1-error .df1-push {+    color: #268bd2;+}++.df1-theme-solarized-light .df1-debug .df1-key,+.df1-theme-solarized-light .df1-info .df1-key,+.df1-theme-solarized-light .df1-notice .df1-key,+.df1-theme-solarized-light .df1-warning .df1-key,+.df1-theme-solarized-light .df1-error .df1-key,+.df1-theme-solarized-light .df1-critical .df1-key,+.df1-theme-solarized-light .df1-alert .df1-key,+.df1-theme-solarized-light .df1-emergency .df1-key  {+    color: #2aa198;+}++.df1-theme-solarized-light .df1-notice .df1-level {+    color: #859900;+}++.df1-theme-solarized-light .df1-warning .df1-level {+    color: #b58900;+}++.df1-theme-solarized-light .df1-error {+    background-color: #073642;+    color: #eee8d5;+}++.df1-theme-solarized-light .df1-error .df1-level {+    color: #dc322f;+}++.df1-theme-solarized-light .df1-critical, +.df1-theme-solarized-light .df1-alert, +.df1-theme-solarized-light .df1-emergency {+    background-color: #dc322f;+    color: #002b36;+}++.df1-theme-solarized-light .df1-critical .df1-push,+.df1-theme-solarized-light .df1-alert .df1-push,+.df1-theme-solarized-light .df1-emergency .df1-push,+.df1-theme-solarized-light .df1-critical .df1-level, +.df1-theme-solarized-light .df1-alert .df1-level, +.df1-theme-solarized-light .df1-emergency .df1-level {+    color: #fdf6e3;+}

binary file changed (absent → 134302 bytes)