{-# LANGUAGE FlexibleContexts #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Xmobar.Run.Parsers
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  portable
--
-- Parsing for template substrings
--
-----------------------------------------------------------------------------

module Xmobar.Run.Parsers ( parseString
                          , colorComponents
                          , Segment
                          , FontIndex
                          , Box(..)
                          , BoxBorder(..)
                          , BoxOffset(..)
                          , BoxMargins(..)
                          , TextRenderInfo(..)
                          , Widget(..)) where

import Control.Monad (guard, mzero)
import Data.Maybe (fromMaybe)
import Data.Int (Int32)
import Text.ParserCombinators.Parsec
import Text.Read (readMaybe)
import Foreign.C.Types (CInt)

import Xmobar.Config.Types
import Xmobar.Run.Actions

data Widget = Icon String | Text String | Hspace Int32 deriving Int -> Widget -> ShowS
[Widget] -> ShowS
Widget -> String
(Int -> Widget -> ShowS)
-> (Widget -> String) -> ([Widget] -> ShowS) -> Show Widget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Widget] -> ShowS
$cshowList :: [Widget] -> ShowS
show :: Widget -> String
$cshow :: Widget -> String
showsPrec :: Int -> Widget -> ShowS
$cshowsPrec :: Int -> Widget -> ShowS
Show

data BoxOffset = BoxOffset Align Int32 deriving (BoxOffset -> BoxOffset -> Bool
(BoxOffset -> BoxOffset -> Bool)
-> (BoxOffset -> BoxOffset -> Bool) -> Eq BoxOffset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoxOffset -> BoxOffset -> Bool
$c/= :: BoxOffset -> BoxOffset -> Bool
== :: BoxOffset -> BoxOffset -> Bool
$c== :: BoxOffset -> BoxOffset -> Bool
Eq, Int -> BoxOffset -> ShowS
[BoxOffset] -> ShowS
BoxOffset -> String
(Int -> BoxOffset -> ShowS)
-> (BoxOffset -> String)
-> ([BoxOffset] -> ShowS)
-> Show BoxOffset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoxOffset] -> ShowS
$cshowList :: [BoxOffset] -> ShowS
show :: BoxOffset -> String
$cshow :: BoxOffset -> String
showsPrec :: Int -> BoxOffset -> ShowS
$cshowsPrec :: Int -> BoxOffset -> ShowS
Show)
-- margins: Top, Right, Bottom, Left
data BoxMargins = BoxMargins Int32 Int32 Int32 Int32 deriving (BoxMargins -> BoxMargins -> Bool
(BoxMargins -> BoxMargins -> Bool)
-> (BoxMargins -> BoxMargins -> Bool) -> Eq BoxMargins
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoxMargins -> BoxMargins -> Bool
$c/= :: BoxMargins -> BoxMargins -> Bool
== :: BoxMargins -> BoxMargins -> Bool
$c== :: BoxMargins -> BoxMargins -> Bool
Eq, Int -> BoxMargins -> ShowS
[BoxMargins] -> ShowS
BoxMargins -> String
(Int -> BoxMargins -> ShowS)
-> (BoxMargins -> String)
-> ([BoxMargins] -> ShowS)
-> Show BoxMargins
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoxMargins] -> ShowS
$cshowList :: [BoxMargins] -> ShowS
show :: BoxMargins -> String
$cshow :: BoxMargins -> String
showsPrec :: Int -> BoxMargins -> ShowS
$cshowsPrec :: Int -> BoxMargins -> ShowS
Show)
data BoxBorder = BBTop
               | BBBottom
               | BBVBoth
               | BBLeft
               | BBRight
               | BBHBoth
               | BBFull
                 deriving ( ReadPrec [BoxBorder]
ReadPrec BoxBorder
Int -> ReadS BoxBorder
ReadS [BoxBorder]
(Int -> ReadS BoxBorder)
-> ReadS [BoxBorder]
-> ReadPrec BoxBorder
-> ReadPrec [BoxBorder]
-> Read BoxBorder
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BoxBorder]
$creadListPrec :: ReadPrec [BoxBorder]
readPrec :: ReadPrec BoxBorder
$creadPrec :: ReadPrec BoxBorder
readList :: ReadS [BoxBorder]
$creadList :: ReadS [BoxBorder]
readsPrec :: Int -> ReadS BoxBorder
$creadsPrec :: Int -> ReadS BoxBorder
Read, BoxBorder -> BoxBorder -> Bool
(BoxBorder -> BoxBorder -> Bool)
-> (BoxBorder -> BoxBorder -> Bool) -> Eq BoxBorder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoxBorder -> BoxBorder -> Bool
$c/= :: BoxBorder -> BoxBorder -> Bool
== :: BoxBorder -> BoxBorder -> Bool
$c== :: BoxBorder -> BoxBorder -> Bool
Eq, Int -> BoxBorder -> ShowS
[BoxBorder] -> ShowS
BoxBorder -> String
(Int -> BoxBorder -> ShowS)
-> (BoxBorder -> String)
-> ([BoxBorder] -> ShowS)
-> Show BoxBorder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoxBorder] -> ShowS
$cshowList :: [BoxBorder] -> ShowS
show :: BoxBorder -> String
$cshow :: BoxBorder -> String
showsPrec :: Int -> BoxBorder -> ShowS
$cshowsPrec :: Int -> BoxBorder -> ShowS
Show )
data Box = Box BoxBorder BoxOffset CInt String BoxMargins deriving (Box -> Box -> Bool
(Box -> Box -> Bool) -> (Box -> Box -> Bool) -> Eq Box
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Box -> Box -> Bool
$c/= :: Box -> Box -> Bool
== :: Box -> Box -> Bool
$c== :: Box -> Box -> Bool
Eq, Int -> Box -> ShowS
[Box] -> ShowS
Box -> String
(Int -> Box -> ShowS)
-> (Box -> String) -> ([Box] -> ShowS) -> Show Box
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Box] -> ShowS
$cshowList :: [Box] -> ShowS
show :: Box -> String
$cshow :: Box -> String
showsPrec :: Int -> Box -> ShowS
$cshowsPrec :: Int -> Box -> ShowS
Show)
data TextRenderInfo =
    TextRenderInfo { TextRenderInfo -> String
tColorsString   :: String
                   , TextRenderInfo -> Int32
tBgTopOffset    :: Int32
                   , TextRenderInfo -> Int32
tBgBottomOffset :: Int32
                   , TextRenderInfo -> [Box]
tBoxes          :: [Box]
                   } deriving Int -> TextRenderInfo -> ShowS
[TextRenderInfo] -> ShowS
TextRenderInfo -> String
(Int -> TextRenderInfo -> ShowS)
-> (TextRenderInfo -> String)
-> ([TextRenderInfo] -> ShowS)
-> Show TextRenderInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextRenderInfo] -> ShowS
$cshowList :: [TextRenderInfo] -> ShowS
show :: TextRenderInfo -> String
$cshow :: TextRenderInfo -> String
showsPrec :: Int -> TextRenderInfo -> ShowS
$cshowsPrec :: Int -> TextRenderInfo -> ShowS
Show
type FontIndex   = Int

type Segment = (Widget, TextRenderInfo, FontIndex, Maybe [Action])

-- | Runs the string parser
parseString :: Config -> String -> IO [Segment]
parseString :: Config -> String -> IO [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
parse (TextRenderInfo
-> Int -> Maybe [Action] -> Parsec String () [[Segment]]
stringParser TextRenderInfo
ci Int
0 Maybe [Action]
forall a. Maybe a
Nothing) String
"" String
s of
      Left  ParseError
_ -> [Segment] -> IO [Segment]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String -> Widget
Text (String -> Widget) -> String -> Widget
forall a b. (a -> b) -> a -> b
$ String
"Could not parse string: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
                          , TextRenderInfo
ci
                          , Int
0
                          , Maybe [Action]
forall a. Maybe a
Nothing)]
      Right [[Segment]]
x -> [Segment] -> IO [Segment]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Segment]] -> [Segment]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Segment]]
x)
    where ci :: TextRenderInfo
ci = String -> Int32 -> Int32 -> [Box] -> TextRenderInfo
TextRenderInfo (Config -> String
fgColor Config
c) Int32
0 Int32
0 []

-- | Splits a colors string into its two components
colorComponents :: Config -> String -> (String, String)
colorComponents :: Config -> String -> (String, String)
colorComponents Config
conf String
c =
  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
c of
    (String
f,Char
',':String
b) -> (String
f, String
b)
    (String
f,    String
_) -> (String
f, Config -> String
bgColor Config
conf)

allParsers :: TextRenderInfo
           -> FontIndex
           -> Maybe [Action]
           -> Parser [Segment]
allParsers :: TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
allParsers TextRenderInfo
c Int
f Maybe [Action]
a =  TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
textParser TextRenderInfo
c Int
f Maybe [Action]
a
                Parser [Segment] -> Parser [Segment] -> Parser [Segment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Segment] -> Parser [Segment]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
iconParser TextRenderInfo
c Int
f Maybe [Action]
a)
                Parser [Segment] -> Parser [Segment] -> Parser [Segment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Segment] -> Parser [Segment]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
hspaceParser TextRenderInfo
c Int
f Maybe [Action]
a)
                Parser [Segment] -> Parser [Segment] -> Parser [Segment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Segment] -> Parser [Segment]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
rawParser TextRenderInfo
c Int
f Maybe [Action]
a)
                Parser [Segment] -> Parser [Segment] -> Parser [Segment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Segment] -> Parser [Segment]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
actionParser TextRenderInfo
c Int
f Maybe [Action]
a)
                Parser [Segment] -> Parser [Segment] -> Parser [Segment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Segment] -> Parser [Segment]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (TextRenderInfo -> Maybe [Action] -> Parser [Segment]
fontParser TextRenderInfo
c Maybe [Action]
a)
                Parser [Segment] -> Parser [Segment] -> Parser [Segment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [Segment] -> Parser [Segment]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
boxParser TextRenderInfo
c Int
f Maybe [Action]
a)
                Parser [Segment] -> Parser [Segment] -> Parser [Segment]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
colorParser TextRenderInfo
c Int
f Maybe [Action]
a

-- | Gets the string and combines the needed parsers
stringParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [[Segment]]
stringParser :: TextRenderInfo
-> Int -> Maybe [Action] -> Parsec String () [[Segment]]
stringParser TextRenderInfo
c Int
f Maybe [Action]
a = 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]
manyTill (TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
allParsers TextRenderInfo
c Int
f Maybe [Action]
a) ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

-- | Parses a maximal string without markup.
textParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]
textParser :: TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
textParser TextRenderInfo
c Int
f Maybe [Action]
a = do String
s <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char
 -> ParsecT String () Identity String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$
                            String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
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 tok st a. GenParser tok st a -> GenParser tok st a
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
char Char
'<')
                                    (ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"fc=")  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 String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"box")  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 String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"fn=")  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 String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"action=") 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 String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/action>") 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 String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"icon=") 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 String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"hspace=") 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 String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"raw=") 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 String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/fn>") 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 String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/box>") 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
<|>
                                     String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/fc>"))
                      [Segment] -> Parser [Segment]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String -> Widget
Text String
s, TextRenderInfo
c, Int
f, Maybe [Action]
a)]

-- | 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 :: TextRenderInfo
          -> FontIndex
          -> Maybe [Action]
          -> Parser [Segment]
rawParser :: TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
rawParser TextRenderInfo
c Int
f Maybe [Action]
a = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<raw="
  String
lenstr <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  case ReadS Integer
forall a. Read a => ReadS a
reads String
lenstr of
    [(Integer
len,[])] -> do
      Bool -> ParsecT String () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
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))
      String
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]
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
anyChar
      String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/>"
      [Segment] -> Parser [Segment]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String -> Widget
Text String
s, TextRenderInfo
c, Int
f, Maybe [Action]
a)]
    [(Integer, String)]
_ -> Parser [Segment]
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | 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' :: Parser a -> Parser b -> Parser a
notFollowedBy' Parser a
p Parser b
e = do a
x <- Parser a
p
                        ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char -> ParsecT String () Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser b
e Parser b
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String () Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'*')
                        a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

iconParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]
iconParser :: TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
iconParser TextRenderInfo
c Int
f Maybe [Action]
a = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<icon="
  String
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]
manyTill (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
">") (ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/>"))
  [Segment] -> Parser [Segment]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String -> Widget
Icon String
i, TextRenderInfo
c, Int
f, Maybe [Action]
a)]

hspaceParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]
hspaceParser :: TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
hspaceParser TextRenderInfo
c Int
f Maybe [Action]
a = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<hspace="
  String
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]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit (ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/>"))
  [Segment] -> Parser [Segment]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int32 -> Widget
Hspace (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 (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
pVal), TextRenderInfo
c, Int
f, Maybe [Action]
a)]

actionParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]
actionParser :: TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
actionParser TextRenderInfo
c Int
f Maybe [Action]
act = do
  String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<action="
  String
command <- [ParsecT String () Identity String]
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [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
between (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`') (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`') (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"`")),
                   ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
">")]
  String
buttons <- (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>' ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"1") 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
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT String () Identity Char
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String () Identity ()
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    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
between (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"button=") (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
">") (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"12345")))
  let a :: Action
a = [Button] -> String -> Action
Spawn (String -> [Button]
toButtons String
buttons) String
command
      a' :: Maybe [Action]
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'
  [[Segment]]
s <- Parser [Segment]
-> ParsecT String () Identity String
-> 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]
manyTill (TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
allParsers TextRenderInfo
c Int
f Maybe [Action]
a') (ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"</action>")
  [Segment] -> Parser [Segment]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Segment]] -> [Segment]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Segment]]
s)

toButtons :: String -> [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])

-- | Parsers a string wrapped in a color specification.
colorParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]
colorParser :: TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
colorParser (TextRenderInfo String
_ Int32
_ Int32
_ [Box]
bs) Int
f Maybe [Action]
a = do
  String
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
between (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<fc=") (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
">") ParsecT String () Identity String
colors
  let colorParts :: (String, String)
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 (String
ot,String
ob) = 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
',') (Int -> ShowS
forall a. Int -> [a] -> [a]
Prelude.drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
colorParts) of
             (String
top,Char
',':String
btm) -> (String
top, String
btm)
             (String
top,      String
_) -> (String
top, String
top)
  [[Segment]]
s <- Parser [Segment]
-> ParsecT String () Identity String
-> 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]
manyTill
       (TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
allParsers (String -> Int32 -> Int32 -> [Box] -> TextRenderInfo
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) Int
f Maybe [Action]
a)
       (ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"</fc>")
  [Segment] -> Parser [Segment]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Segment]] -> [Segment]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Segment]]
s)

-- | Parses a string wrapped in a box specification.
boxParser :: TextRenderInfo -> FontIndex -> Maybe [Action] -> Parser [Segment]
boxParser :: TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
boxParser (TextRenderInfo String
cs Int32
ot Int32
ob [Box]
bs) Int
f Maybe [Action]
a = do
  String
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
between (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<box") (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
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
option String
"" (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
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
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=' 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
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' 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
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' 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
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')))
  let b :: Box
b = BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
Box BoxBorder
BBFull (Align -> Int32 -> BoxOffset
BoxOffset Align
C Int32
0) CInt
1 String
cs (Int32 -> Int32 -> Int32 -> Int32 -> BoxMargins
BoxMargins Int32
0 Int32
0 Int32
0 Int32
0)
  let g :: Box
g = Box -> [String] -> Box
boxReader Box
b (String -> [String]
words String
c)
  [[Segment]]
s <- Parser [Segment]
-> ParsecT String () Identity String
-> 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]
manyTill
       (TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
allParsers (String -> Int32 -> Int32 -> [Box] -> TextRenderInfo
TextRenderInfo String
cs Int32
ot Int32
ob (Box
g Box -> [Box] -> [Box]
forall a. a -> [a] -> [a]
: [Box]
bs)) Int
f Maybe [Action]
a)
       (ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"</box>")
  [Segment] -> Parser [Segment]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Segment]] -> [Segment]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Segment]]
s)

boxReader :: Box -> [String] -> Box
boxReader :: Box -> [String] -> Box
boxReader Box
b [] = Box
b
boxReader Box
b (String
x:[String]
xs) = do
  let (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
"")
  Box -> [String] -> Box
boxReader (Box -> String -> String -> Box
boxParamReader Box
b String
param String
val) [String]
xs

boxParamReader :: Box -> String -> String -> Box
boxParamReader :: Box -> String -> String -> Box
boxParamReader Box
b String
_ String
"" = Box
b
boxParamReader (Box BoxBorder
bb BoxOffset
off CInt
lw String
fc BoxMargins
mgs) String
"type" String
val =
  BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ String
val)) BoxOffset
off CInt
lw String
fc BoxMargins
mgs
boxParamReader (Box BoxBorder
bb (BoxOffset Align
alg Int32
off) CInt
lw String
fc BoxMargins
mgs) String
"offset" (Char
a:String
o) =
  BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
Box BoxBorder
bb (Align -> Int32 -> BoxOffset
BoxOffset (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]) (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)) CInt
lw String
fc BoxMargins
mgs
boxParamReader (Box BoxBorder
bb BoxOffset
off CInt
lw String
fc BoxMargins
mgs) String
"width" String
val =
  BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
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 (Box BoxBorder
bb BoxOffset
off CInt
lw String
_ BoxMargins
mgs) String
"color" String
val =
  BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
Box BoxBorder
bb BoxOffset
off CInt
lw String
val BoxMargins
mgs
boxParamReader (Box BoxBorder
bb BoxOffset
off CInt
lw String
fc mgs :: BoxMargins
mgs@(BoxMargins Int32
mt Int32
mr Int32
mb Int32
ml)) (Char
'm':String
pos) String
val = do
  let mgs' :: BoxMargins
mgs' = case String
pos of
         String
"t" -> Int32 -> Int32 -> Int32 -> Int32 -> BoxMargins
BoxMargins (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
mt (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
val) Int32
mr Int32
mb Int32
ml
         String
"r" -> Int32 -> Int32 -> Int32 -> Int32 -> BoxMargins
BoxMargins Int32
mt (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
mr (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
val) Int32
mb Int32
ml
         String
"b" -> Int32 -> Int32 -> Int32 -> Int32 -> BoxMargins
BoxMargins Int32
mt Int32
mr (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
mb (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
val) Int32
ml
         String
"l" -> Int32 -> Int32 -> Int32 -> Int32 -> BoxMargins
BoxMargins Int32
mt Int32
mr Int32
mb (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
ml (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
val)
         String
_ -> BoxMargins
mgs
  BoxBorder -> BoxOffset -> CInt -> String -> BoxMargins -> Box
Box BoxBorder
bb BoxOffset
off CInt
lw String
fc BoxMargins
mgs'
boxParamReader Box
b String
_ String
_ = Box
b

-- | Parsers a string wrapped in a font specification.
fontParser :: TextRenderInfo -> Maybe [Action] -> Parser [Segment]
fontParser :: TextRenderInfo -> Maybe [Action] -> Parser [Segment]
fontParser TextRenderInfo
c Maybe [Action]
a = do
  String
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
between (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<fn=") (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
">") ParsecT String () Identity String
colors
  [[Segment]]
s <- Parser [Segment]
-> ParsecT String () Identity String
-> 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]
manyTill (TextRenderInfo -> Int -> Maybe [Action] -> Parser [Segment]
allParsers TextRenderInfo
c (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
f) Maybe [Action]
a) (ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"</fn>")
  [Segment] -> Parser [Segment]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Segment]] -> [Segment]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Segment]]
s)

-- | Parses a color specification (hex or named)
colors :: Parser String
colors :: ParsecT String () Identity String
colors = ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
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
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' 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
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':' 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
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#')