{-# LANGUAGE FlexibleContexts #-}

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

module Xmobar.X11.Parsers (parseString, Widget(..)) where

import Xmobar.Config.Types
import Xmobar.X11.Actions

import Control.Monad (guard, mzero)
import Text.ParserCombinators.Parsec
import Graphics.X11.Types (Button)

data Widget = Icon String | Text String

type ColorString = String
type FontIndex   = Int

-- | Runs the string parser
parseString :: Config -> String
               -> IO [(Widget, ColorString, FontIndex, Maybe [Action])]
parseString :: Config
-> String -> IO [(Widget, String, FontIndex, Maybe [Action])]
parseString Config
c String
s =
    case Parsec String () [[(Widget, String, FontIndex, Maybe [Action])]]
-> String
-> String
-> Either
     ParseError [[(Widget, String, FontIndex, Maybe [Action])]]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (String
-> FontIndex
-> Maybe [Action]
-> Parsec String () [[(Widget, String, FontIndex, Maybe [Action])]]
stringParser (Config -> String
fgColor Config
c) FontIndex
0 Maybe [Action]
forall a. Maybe a
Nothing) String
"" String
s of
      Left  ParseError
_ -> [(Widget, String, FontIndex, Maybe [Action])]
-> IO [(Widget, String, FontIndex, Maybe [Action])]
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 -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
                          , Config -> String
fgColor Config
c
                          , FontIndex
0
                          , Maybe [Action]
forall a. Maybe a
Nothing)]
      Right [[(Widget, String, FontIndex, Maybe [Action])]]
x -> [(Widget, String, FontIndex, Maybe [Action])]
-> IO [(Widget, String, FontIndex, Maybe [Action])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Widget, String, FontIndex, Maybe [Action])]]
-> [(Widget, String, FontIndex, Maybe [Action])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Widget, String, FontIndex, Maybe [Action])]]
x)

allParsers :: ColorString
           -> FontIndex
           -> Maybe [Action]
           -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
allParsers :: String
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
allParsers String
c FontIndex
f Maybe [Action]
a =  String
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
textParser String
c FontIndex
f Maybe [Action]
a
                Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
iconParser String
c FontIndex
f Maybe [Action]
a)
                Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
rawParser String
c FontIndex
f Maybe [Action]
a)
                Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
actionParser String
c FontIndex
f Maybe [Action]
a)
                Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
fontParser String
c Maybe [Action]
a)
                Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
colorParser FontIndex
f Maybe [Action]
a

-- | Gets the string and combines the needed parsers
stringParser :: String -> FontIndex -> Maybe [Action]
                -> Parser [[(Widget, ColorString, FontIndex, Maybe [Action])]]
stringParser :: String
-> FontIndex
-> Maybe [Action]
-> Parsec String () [[(Widget, String, FontIndex, Maybe [Action])]]
stringParser String
c FontIndex
f Maybe [Action]
a = Parser [(Widget, String, FontIndex, Maybe [Action])]
-> ParsecT String () Identity ()
-> Parsec String () [[(Widget, String, FontIndex, Maybe [Action])]]
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
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
allParsers String
c FontIndex
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 :: String -> FontIndex -> Maybe [Action]
              -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
textParser :: String
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
textParser String
c FontIndex
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
"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
"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
<|>
                                     String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/fc>"))
                      [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String -> Widget
Text String
s, String
c, FontIndex
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 :: ColorString
          -> FontIndex
          -> Maybe [Action]
          -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
rawParser :: String
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
rawParser String
c FontIndex
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
<= FontIndex -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FontIndex
forall a. Bounded a => a
maxBound :: Int))
      String
s <- FontIndex
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
FontIndex -> ParsecT s u m a -> ParsecT s u m [a]
count (Integer -> FontIndex
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
"/>"
      [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String -> Widget
Text String
s, String
c, FontIndex
f, Maybe [Action]
a)]
    [(Integer, String)]
_ -> Parser [(Widget, String, FontIndex, Maybe [Action])]
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 :: String -> FontIndex -> Maybe [Action]
              -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
iconParser :: String
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
iconParser String
c FontIndex
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
"/>"))
  [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String -> Widget
Icon String
i, String
c, FontIndex
f, Maybe [Action]
a)]

actionParser :: String -> FontIndex -> Maybe [Action]
                -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
actionParser :: String
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
actionParser String
c FontIndex
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'
  [[(Widget, String, FontIndex, Maybe [Action])]]
s <- Parser [(Widget, String, FontIndex, Maybe [Action])]
-> ParsecT String () Identity String
-> Parsec String () [[(Widget, String, FontIndex, Maybe [Action])]]
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
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
allParsers String
c FontIndex
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>")
  [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Widget, String, FontIndex, Maybe [Action])]]
-> [(Widget, String, FontIndex, Maybe [Action])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Widget, String, FontIndex, Maybe [Action])]]
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 :: FontIndex -> Maybe [Action]
               -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
colorParser :: FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
colorParser FontIndex
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
  [[(Widget, String, FontIndex, Maybe [Action])]]
s <- Parser [(Widget, String, FontIndex, Maybe [Action])]
-> ParsecT String () Identity String
-> Parsec String () [[(Widget, String, FontIndex, Maybe [Action])]]
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
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
allParsers String
c FontIndex
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>")
  [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Widget, String, FontIndex, Maybe [Action])]]
-> [(Widget, String, FontIndex, Maybe [Action])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Widget, String, FontIndex, Maybe [Action])]]
s)

-- | Parsers a string wrapped in a font specification.
fontParser :: ColorString -> Maybe [Action]
              -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])]
fontParser :: String
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
fontParser String
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
  [[(Widget, String, FontIndex, Maybe [Action])]]
s <- Parser [(Widget, String, FontIndex, Maybe [Action])]
-> ParsecT String () Identity String
-> Parsec String () [[(Widget, String, FontIndex, Maybe [Action])]]
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
-> FontIndex
-> Maybe [Action]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
allParsers String
c (String -> FontIndex
forall a. Read a => String -> a
read 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>")
  [(Widget, String, FontIndex, Maybe [Action])]
-> Parser [(Widget, String, FontIndex, Maybe [Action])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Widget, String, FontIndex, Maybe [Action])]]
-> [(Widget, String, FontIndex, Maybe [Action])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Widget, String, FontIndex, Maybe [Action])]]
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
'#')