------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Config.Template
-- Copyright: (c) 2022 jao
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: mail@jao.io
-- Stability: unstable
-- Portability: portable
-- Created: Fri Sep 30, 2022 06:33
--
--
-- Parsing template strings
--
------------------------------------------------------------------------------


module Xmobar.Config.Template (parseString) where

import Data.Maybe (fromMaybe)
import qualified Control.Monad as CM

import Text.Parsec ((<|>))
import Text.Read (readMaybe)

import qualified Text.Parsec as P
import qualified Text.Parsec.Combinator as C

import Text.ParserCombinators.Parsec (Parser)

import qualified Xmobar.Config.Types as T

type Context = (T.TextRenderInfo, T.FontIndex, Maybe [T.Action])

retSegment :: Context -> T.Widget -> Parser [T.Segment]
retSegment :: Context -> Widget -> Parser [Segment]
retSegment (TextRenderInfo
i, Int
idx, Maybe [Action]
as) Widget
widget = [Segment] -> Parser [Segment]
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Widget
widget, TextRenderInfo
i, Int
idx, Maybe [Action]
as)]

-- | Run the template string parser for the given config, producing a list of
-- drawable segment specifications.
parseString :: T.Config -> String -> [T.Segment]
parseString :: Config -> String -> [Segment]
parseString Config
c String
s =
  case Parsec String () [[Segment]]
-> String -> String -> Either ParseError [[Segment]]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse (Context -> Parsec String () [[Segment]]
stringParser Context
forall {a}. (TextRenderInfo, Int, Maybe a)
ci) String
"" String
s of
    Left  ParseError
_ -> [(String -> Widget
T.Text (String -> Widget) -> String -> Widget
forall a b. (a -> b) -> a -> b
$ String
"Could not parse string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s, TextRenderInfo
ti, Int
0, Maybe [Action]
forall a. Maybe a
Nothing)]
    Right [[Segment]]
x -> [[Segment]] -> [Segment]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Segment]]
x
  where ci :: (TextRenderInfo, Int, Maybe a)
ci = (TextRenderInfo
ti , Int
0, Maybe a
forall a. Maybe a
Nothing)
        ti :: TextRenderInfo
ti = String -> Int32 -> Int32 -> [Box] -> TextRenderInfo
T.TextRenderInfo (Config -> String
T.fgColor Config
c) Int32
0 Int32
0 []

-- Top level parser reading the full template string
stringParser :: Context -> Parser [[T.Segment]]
stringParser :: Context -> Parsec String () [[Segment]]
stringParser Context
c = Parser [Segment]
-> ParsecT String () Identity () -> Parsec String () [[Segment]]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
C.manyTill (Context -> Parser [Segment]
allParsers Context
c) ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
C.eof

allParsers :: Context -> Parser [T.Segment]
allParsers :: Context -> Parser [Segment]
allParsers Context
c = [Parser [Segment]] -> Parser [Segment]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
C.choice (Context -> Parser [Segment]
textParser Context
cParser [Segment] -> [Parser [Segment]] -> [Parser [Segment]]
forall a. a -> [a] -> [a]
:((Context -> Parser [Segment]) -> Parser [Segment])
-> [Context -> Parser [Segment]] -> [Parser [Segment]]
forall a b. (a -> b) -> [a] -> [b]
map (\Context -> Parser [Segment]
f -> Parser [Segment] -> Parser [Segment]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Context -> Parser [Segment]
f Context
c)) [Context -> Parser [Segment]]
parsers)
  where parsers :: [Context -> Parser [Segment]]
parsers = [ Context -> Parser [Segment]
iconParser, Context -> Parser [Segment]
hspaceParser, Context -> Parser [Segment]
rawParser, Context -> Parser [Segment]
actionParser
                  , Context -> Parser [Segment]
fontParser, Context -> Parser [Segment]
boxParser, Context -> Parser [Segment]
colorParser ]

-- Wrapper for notFollowedBy that returns the result of the first parser.
-- Also works around the issue that, at least in Parsec 3.0.0, notFollowedBy
-- accepts only parsers with return type Char.
notFollowedBy' :: Parser a -> Parser b -> Parser a
notFollowedBy' :: forall a b. Parser a -> Parser b -> Parser a
notFollowedBy' Parser a
p Parser b
e = do x <- Parser a
p
                        C.notFollowedBy $ P.try (e >> return '*')
                        return x

-- Parse a maximal string without markup
textParser :: Context -> Parser [T.Segment]
textParser :: Context -> Parser [Segment]
textParser Context
c =
  ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
C.many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
"<" ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity Char
forall a b. Parser a -> Parser b -> Parser a
notFollowedBy' (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'<') ParsecT String () Identity String
forall {u}. ParsecT String u Identity String
suffixes))
  ParsecT String () Identity String
-> (String -> Parser [Segment]) -> Parser [Segment]
forall a b.
ParsecT String () Identity a
-> (a -> ParsecT String () Identity b)
-> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context -> Widget -> Parser [Segment]
retSegment Context
c (Widget -> Parser [Segment])
-> (String -> Widget) -> String -> Parser [Segment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Widget
T.Text
  where suffixes :: ParsecT String u Identity String
suffixes = [ParsecT String u Identity String]
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
C.choice ([ParsecT String u Identity String]
 -> ParsecT String u Identity String)
-> [ParsecT String u Identity String]
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$  (String -> ParsecT String u Identity String)
-> [String] -> [ParsecT String u Identity String]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT String u Identity String
-> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT String u Identity String
 -> ParsecT String u Identity String)
-> (String -> ParsecT String u Identity String)
-> String
-> ParsecT String u Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string)
                   [ String
"icon=" , String
"hspace=", String
"raw="
                   , String
"action=", String
"/action>", String
"fn=", String
"/fn>"
                   , String
"box", String
"/box>", String
"fc=", String
"/fc>" ]

-- Parse a "raw" tag, which we use to prevent other tags from creeping in.
-- The format here is net-string-esque: a literal "<raw=" followed by a string
-- of digits (base 10) denoting the length of the raw string, a literal ":" as
-- digit-string-terminator, the raw string itself, and then a literal "/>".
rawParser :: Context -> Parser [T.Segment]
rawParser :: Context -> Parser [Segment]
rawParser Context
c = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"<raw="
  lenstr <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
C.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
  P.char ':'
  case reads lenstr of
    [(Integer
len,[])] -> do
      Bool -> ParsecT String () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
CM.guard ((Integer
len :: Integer) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int))
      s <- Int
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
C.count (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
len) ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar
      P.string "/>"
      retSegment c (T.Text s)
    [(Integer, String)]
_ -> Parser [Segment]
forall a. ParsecT String () Identity a
forall (m :: * -> *) a. MonadPlus m => m a
CM.mzero

iconParser :: Context -> Parser [T.Segment]
iconParser :: Context -> Parser [Segment]
iconParser Context
c = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"<icon="
  i <- ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
C.manyTill (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
">") (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"/>"))
  retSegment c (T.Icon i)

hspaceParser :: Context -> Parser [T.Segment]
hspaceParser :: Context -> Parser [Segment]
hspaceParser Context
c = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"<hspace="
  pVal <- ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
C.manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"/>"))
  retSegment c (T.Hspace (fromMaybe 0 $ readMaybe pVal))

actionParser :: Context -> Parser [T.Segment]
actionParser :: Context -> Parser [Segment]
actionParser (TextRenderInfo
ti, Int
fi, Maybe [Action]
act) = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"<action="
  command <- ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
C.between (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'`') (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'`') (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
C.many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
"`"))
             ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
C.many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
">")
  buttons <- (P.char '>' >> return "1") <|> (P.space >> P.spaces >>
    C.between (P.string "button=") (P.string ">") (C.many1 (P.oneOf "12345")))
  let a = [Button] -> String -> Action
T.Spawn (String -> [Button]
toButtons String
buttons) String
command
      a' = case Maybe [Action]
act of
        Maybe [Action]
Nothing -> [Action] -> Maybe [Action]
forall a. a -> Maybe a
Just [Action
a]
        Just [Action]
act' -> [Action] -> Maybe [Action]
forall a. a -> Maybe a
Just ([Action] -> Maybe [Action]) -> [Action] -> Maybe [Action]
forall a b. (a -> b) -> a -> b
$ Action
a Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
: [Action]
act'
  s <- C.manyTill (allParsers (ti, fi, a')) (P.try $ P.string "</action>")
  return (concat s)

toButtons :: String -> [T.Button]
toButtons :: String -> [Button]
toButtons = (Char -> Button) -> String -> [Button]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> String -> Button
forall a. Read a => String -> a
read [Char
x])

colorParser :: Context -> Parser [T.Segment]
colorParser :: Context -> Parser [Segment]
colorParser (T.TextRenderInfo String
_ Int32
_ Int32
_ [Box]
bs, Int
fidx, Maybe [Action]
a) = do
  c <- ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
C.between (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"<fc=") (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
">") (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
C.many1 ParsecT String () Identity Char
forall {u}. ParsecT String u Identity Char
colorc)
  let colorParts = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') String
c
  let (ot,ob) = case break (==',') (drop 1 $ snd colorParts) of
                  (String
top,Char
',':String
btm) -> (String
top, String
btm)
                  (String
top,      String
_) -> (String
top, String
top)
      tri = String -> Int32 -> Int32 -> [Box] -> TextRenderInfo
T.TextRenderInfo ((String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
colorParts)
                           (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe (-Int32
1) (Maybe Int32 -> Int32) -> Maybe Int32 -> Int32
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int32
forall a. Read a => String -> Maybe a
readMaybe String
ot)
                           (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe (-Int32
1) (Maybe Int32 -> Int32) -> Maybe Int32 -> Int32
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int32
forall a. Read a => String -> Maybe a
readMaybe String
ob)
                           [Box]
bs
  s <- C.manyTill (allParsers (tri, fidx, a)) (P.try $ P.string "</fc>")
  return (concat s)
  where colorc :: ParsecT String u Identity Char
colorc = ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.alphaNum ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
",:#"

boxParser :: Context -> Parser [T.Segment]
boxParser :: Context -> Parser [Segment]
boxParser (T.TextRenderInfo String
cs Int32
ot Int32
ob [Box]
bs, Int
f, Maybe [Action]
a) = do
  c <- ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
C.between (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"<box") (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
">")
                 (String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
C.option String
"" (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
C.many1 (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.alphaNum ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"= #,")))
  let b = BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
T.Box BoxBorder
T.BBFull (Align -> Int32 -> BoxOffset
T.BoxOffset Align
T.C Int32
0) CInt
1 String
cs (Int32 -> Int32 -> Int32 -> Int32 -> BoxMargins
T.BoxMargins Int32
0 Int32
0 Int32
0 Int32
0)
  let g = Box -> [String] -> Box
boxReader Box
b (String -> [String]
words String
c)
  s <- C.manyTill
       (allParsers (T.TextRenderInfo cs ot ob (g : bs), f, a))
       (P.try $ P.string "</box>")
  return (concat s)

boxReader :: T.Box -> [String] -> T.Box
boxReader :: Box -> [String] -> Box
boxReader Box
b [] = Box
b
boxReader Box
b (String
x:[String]
xs) = Box -> [String] -> Box
boxReader (Box -> String -> String -> Box
boxParamReader Box
b String
param String
val) [String]
xs
  where (String
param,String
val) = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'=') String
x of
                        (String
p,Char
'=':String
v) -> (String
p, String
v)
                        (String
p,    String
_) -> (String
p, String
"")

boxParamReader :: T.Box -> String -> String -> T.Box
boxParamReader :: Box -> String -> String -> Box
boxParamReader Box
b String
_ String
"" = Box
b

boxParamReader (T.Box BoxBorder
bb BoxOffset
off CInt
lw String
fc BoxMargins
mgs) String
"type" String
val =
  BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
T.Box (BoxBorder -> Maybe BoxBorder -> BoxBorder
forall a. a -> Maybe a -> a
fromMaybe BoxBorder
bb (Maybe BoxBorder -> BoxBorder) -> Maybe BoxBorder -> BoxBorder
forall a b. (a -> b) -> a -> b
$ String -> Maybe BoxBorder
forall a. Read a => String -> Maybe a
readMaybe (String
"BB" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
val)) BoxOffset
off CInt
lw String
fc BoxMargins
mgs

boxParamReader (T.Box BoxBorder
bb (T.BoxOffset Align
alg Int32
off) CInt
lw String
fc BoxMargins
mgs) String
"offset" (Char
a:String
o) =
  BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
T.Box BoxBorder
bb (Align -> Int32 -> BoxOffset
T.BoxOffset Align
align Int32
offset) CInt
lw String
fc BoxMargins
mgs
  where offset :: Int32
offset = Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
off (Maybe Int32 -> Int32) -> Maybe Int32 -> Int32
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int32
forall a. Read a => String -> Maybe a
readMaybe String
o
        align :: Align
align = Align -> Maybe Align -> Align
forall a. a -> Maybe a -> a
fromMaybe Align
alg (Maybe Align -> Align) -> Maybe Align -> Align
forall a b. (a -> b) -> a -> b
$ String -> Maybe Align
forall a. Read a => String -> Maybe a
readMaybe [Char
a]

boxParamReader (T.Box BoxBorder
bb BoxOffset
off CInt
lw String
fc BoxMargins
mgs) String
"width" String
val =
  BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
T.Box BoxBorder
bb BoxOffset
off (CInt -> Maybe CInt -> CInt
forall a. a -> Maybe a -> a
fromMaybe CInt
lw (Maybe CInt -> CInt) -> Maybe CInt -> CInt
forall a b. (a -> b) -> a -> b
$ String -> Maybe CInt
forall a. Read a => String -> Maybe a
readMaybe String
val) String
fc BoxMargins
mgs

boxParamReader (T.Box BoxBorder
bb BoxOffset
off CInt
lw String
_ BoxMargins
mgs) String
"color" String
val =
  BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
T.Box BoxBorder
bb BoxOffset
off CInt
lw String
val BoxMargins
mgs

boxParamReader (T.Box BoxBorder
bb BoxOffset
off CInt
lw String
fc mgs :: BoxMargins
mgs@(T.BoxMargins Int32
mt Int32
mr Int32
mb Int32
ml)) (Char
'm':String
pos) String
v =
  let mgs' :: BoxMargins
mgs' = case String
pos of
               String
"t" -> Int32 -> Int32 -> Int32 -> Int32 -> BoxMargins
T.BoxMargins (Int32 -> Int32
forall {a}. Read a => a -> a
maybeVal Int32
mt) Int32
mr Int32
mb Int32
ml
               String
"r" -> Int32 -> Int32 -> Int32 -> Int32 -> BoxMargins
T.BoxMargins Int32
mt (Int32 -> Int32
forall {a}. Read a => a -> a
maybeVal Int32
mr) Int32
mb Int32
ml
               String
"b" -> Int32 -> Int32 -> Int32 -> Int32 -> BoxMargins
T.BoxMargins Int32
mt Int32
mr (Int32 -> Int32
forall {a}. Read a => a -> a
maybeVal Int32
mb) Int32
ml
               String
"l" -> Int32 -> Int32 -> Int32 -> Int32 -> BoxMargins
T.BoxMargins Int32
mt Int32
mr Int32
mb (Int32 -> Int32
forall {a}. Read a => a -> a
maybeVal Int32
ml)
               String
_   -> BoxMargins
mgs
      maybeVal :: a -> a
maybeVal a
d = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
d (String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
v)
  in BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
T.Box BoxBorder
bb BoxOffset
off CInt
lw String
fc BoxMargins
mgs'

boxParamReader Box
b String
_ String
_ = Box
b

fontParser :: Context -> Parser [T.Segment]
fontParser :: Context -> Parser [Segment]
fontParser (TextRenderInfo
i, Int
_, Maybe [Action]
a) = do
  f <- ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
C.between (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"<fn=") (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
">") (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
C.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit)
  s <- C.manyTill (allParsers (i, fromMaybe 0 $ readMaybe f, a))
                  (P.try $ P.string "</fn>")
  return (concat s)