{-# 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)
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
""