{-# 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 :: Parser Log
log = forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
X.pElement Text
"div" forall a b. (a -> b) -> a -> b
$ do
  Text -> Parser ()
attrClass Text
"df1-log"
  Text
t <- Parser Text
parseTime
  Text
p <- Parser Text
parsePaths
  Text
l <- Parser Text
parseLevel
  Text
m <- Parser Text
parseMessage
  let raw :: ByteString
raw = ByteString -> ByteString
BL.toStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TLE.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
TL.intercalate Text
" " [Text
t, Text
p, Text
l, Text
m]
  case forall a. Parser a -> ByteString -> Either String a
AB.parseOnly Parser Log
Df1.Parse.log ByteString
raw of
    Left String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse Log."
    Right Log
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Log
a

attrClass :: T.Text -> X.Parser ()
attrClass :: Text -> Parser ()
attrClass Text
t = do
  Text
attrs <- forall (m :: * -> *). Applicative m => Text -> ParserT m Text
X.pAttr Text
"class"
  case forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
t (Text -> [Text]
T.words Text
attrs) of
    Bool
False -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Expected \"class\" value to contain " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
t forall a. Semigroup a => a -> a -> a
<> String
".")
    Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

parseTime :: X.Parser TL.Text
parseTime :: Parser Text
parseTime = forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
X.pElement Text
"span" forall a b. (a -> b) -> a -> b
$ do
  Text -> Parser ()
attrClass Text
"df1-time"
  forall (m :: * -> *). Applicative m => ParserT m Text
X.pTextLazy

parseLevel :: X.Parser TL.Text
parseLevel :: Parser Text
parseLevel = forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
X.pElement Text
"span" forall a b. (a -> b) -> a -> b
$ do
  Text -> Parser ()
attrClass Text
"df1-level"
  forall (m :: * -> *). Applicative m => ParserT m Text
X.pTextLazy

parsePaths :: X.Parser TL.Text
parsePaths :: Parser Text
parsePaths = forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
X.pElement Text
"span" forall a b. (a -> b) -> a -> b
$ do
  Text -> Parser ()
attrClass Text
"df1-path"
  Text -> [Text] -> Text
TL.intercalate Text
" " forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text
parsePush forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
parseAttr)

parsePush :: X.Parser TL.Text
parsePush :: Parser Text
parsePush = forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
X.pElement Text
"span" forall a b. (a -> b) -> a -> b
$ do
  Text -> Parser ()
attrClass Text
"df1-push"
  Text
t <- forall (m :: * -> *). Applicative m => ParserT m Text
X.pTextLazy
  Text
s <- Parser Text
parseSeg
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
t forall a. Semigroup a => a -> a -> a
<> Text
s)

parseSeg :: X.Parser TL.Text
parseSeg :: Parser Text
parseSeg = forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
X.pElement Text
"span" forall a b. (a -> b) -> a -> b
$ do
  Text -> Parser ()
attrClass Text
"df1-seg"
  forall (m :: * -> *). Applicative m => ParserT m Text
X.pTextLazy forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""

parseAttr :: X.Parser TL.Text
parseAttr :: Parser Text
parseAttr = forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
X.pElement Text
"span" forall a b. (a -> b) -> a -> b
$ do
  Text -> Parser ()
attrClass Text
"df1-attr"
  Text
k <- Parser Text
parseKey
  Text
eq <- forall (m :: * -> *). Applicative m => ParserT m Text
X.pTextLazy
  Text
v <- Parser Text
parseValue
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
k forall a. Semigroup a => a -> a -> a
<> Text
eq forall a. Semigroup a => a -> a -> a
<> Text
v)

parseKey :: X.Parser TL.Text
parseKey :: Parser Text
parseKey = forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
X.pElement Text
"span" forall a b. (a -> b) -> a -> b
$ do
  Text -> Parser ()
attrClass Text
"df1-key"
  forall (m :: * -> *). Applicative m => ParserT m Text
X.pTextLazy forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""

parseValue :: X.Parser TL.Text
parseValue :: Parser Text
parseValue = forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
X.pElement Text
"span" forall a b. (a -> b) -> a -> b
$ do
  Text -> Parser ()
attrClass Text
"df1-value"
  forall (m :: * -> *). Applicative m => ParserT m Text
X.pTextLazy forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""

parseMessage :: X.Parser TL.Text
parseMessage :: Parser Text
parseMessage = forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
X.pElement Text
"span" forall a b. (a -> b) -> a -> b
$ do
  Text -> Parser ()
attrClass Text
"df1-msg"
  forall (m :: * -> *). Applicative m => ParserT m Text
X.pTextLazy forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""