{-#LANGUAGE RecordWildCards#-}
{-#LANGUAGE ScopedTypeVariables#-}
module Xmobar.Plugins.Monitors.Common.Parsers ( runP
, skipRestOfLine
, getNumbers
, getNumbersAsString
, getAllBut
, getAfterString
, skipTillString
, parseTemplate
, parseTemplate'
, parseOptsWith
, templateParser
, runExportParser
, runTemplateParser
, pureParseTemplate
) where
import Xmobar.Plugins.Monitors.Common.Types
import qualified Data.Map as Map
import System.Console.GetOpt (ArgOrder(Permute), OptDescr, getOpt)
import Text.ParserCombinators.Parsec
runTemplateParser :: MonitorConfig -> IO [(String, String, String)]
runTemplateParser :: MonitorConfig -> IO [(String, String, String)]
runTemplateParser MonitorConfig{Bool
Int
String
[String]
Maybe String
pMaxTotalWidthEllipsis :: MonitorConfig -> String
pMaxTotalWidth :: MonitorConfig -> Int
pNaString :: MonitorConfig -> String
pUseSuffix :: MonitorConfig -> Bool
pBarWidth :: MonitorConfig -> Int
pBarFore :: MonitorConfig -> String
pBarBack :: MonitorConfig -> String
pPadRight :: MonitorConfig -> Bool
pPadChars :: MonitorConfig -> String
pMaxWidthEllipsis :: MonitorConfig -> String
pMaxWidth :: MonitorConfig -> Int
pMinWidth :: MonitorConfig -> Int
pDecDigits :: MonitorConfig -> Int
pPpad :: MonitorConfig -> Int
pExport :: MonitorConfig -> [String]
pTemplate :: MonitorConfig -> String
pHighColor :: MonitorConfig -> Maybe String
pHigh :: MonitorConfig -> Int
pLowColor :: MonitorConfig -> Maybe String
pLow :: MonitorConfig -> Int
pNormalColor :: MonitorConfig -> Maybe String
pMaxTotalWidthEllipsis :: String
pMaxTotalWidth :: Int
pNaString :: String
pUseSuffix :: Bool
pBarWidth :: Int
pBarFore :: String
pBarBack :: String
pPadRight :: Bool
pPadChars :: String
pMaxWidthEllipsis :: String
pMaxWidth :: Int
pMinWidth :: Int
pDecDigits :: Int
pPpad :: Int
pExport :: [String]
pTemplate :: String
pHighColor :: Maybe String
pHigh :: Int
pLowColor :: Maybe String
pLow :: Int
pNormalColor :: Maybe String
..} = Parser [(String, String, String)]
-> String -> IO [(String, String, String)]
forall a. Parser [a] -> String -> IO [a]
runP Parser [(String, String, String)]
templateParser String
pTemplate
runExportParser :: [String] -> IO [(String, [(String, String,String)])]
runExportParser :: [String] -> IO [(String, [(String, String, String)])]
runExportParser [] = [(String, [(String, String, String)])]
-> IO [(String, [(String, String, String)])]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
runExportParser (String
x:[String]
xs) = do
[(String, String, String)]
s <- Parser [(String, String, String)]
-> String -> IO [(String, String, String)]
forall a. Parser [a] -> String -> IO [a]
runP Parser [(String, String, String)]
templateParser String
x
[(String, [(String, String, String)])]
rest <- [String] -> IO [(String, [(String, String, String)])]
runExportParser [String]
xs
[(String, [(String, String, String)])]
-> IO [(String, [(String, String, String)])]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, [(String, String, String)])]
-> IO [(String, [(String, String, String)])])
-> [(String, [(String, String, String)])]
-> IO [(String, [(String, String, String)])]
forall a b. (a -> b) -> a -> b
$ (String
x,[(String, String, String)]
s)(String, [(String, String, String)])
-> [(String, [(String, String, String)])]
-> [(String, [(String, String, String)])]
forall a. a -> [a] -> [a]
:[(String, [(String, String, String)])]
rest
pureParseTemplate :: MonitorConfig -> TemplateInput -> IO String
pureParseTemplate :: MonitorConfig -> TemplateInput -> IO String
pureParseTemplate MonitorConfig{Bool
Int
String
[String]
Maybe String
pMaxTotalWidthEllipsis :: String
pMaxTotalWidth :: Int
pNaString :: String
pUseSuffix :: Bool
pBarWidth :: Int
pBarFore :: String
pBarBack :: String
pPadRight :: Bool
pPadChars :: String
pMaxWidthEllipsis :: String
pMaxWidth :: Int
pMinWidth :: Int
pDecDigits :: Int
pPpad :: Int
pExport :: [String]
pTemplate :: String
pHighColor :: Maybe String
pHigh :: Int
pLowColor :: Maybe String
pLow :: Int
pNormalColor :: Maybe String
pMaxTotalWidthEllipsis :: MonitorConfig -> String
pMaxTotalWidth :: MonitorConfig -> Int
pNaString :: MonitorConfig -> String
pUseSuffix :: MonitorConfig -> Bool
pBarWidth :: MonitorConfig -> Int
pBarFore :: MonitorConfig -> String
pBarBack :: MonitorConfig -> String
pPadRight :: MonitorConfig -> Bool
pPadChars :: MonitorConfig -> String
pMaxWidthEllipsis :: MonitorConfig -> String
pMaxWidth :: MonitorConfig -> Int
pMinWidth :: MonitorConfig -> Int
pDecDigits :: MonitorConfig -> Int
pPpad :: MonitorConfig -> Int
pExport :: MonitorConfig -> [String]
pTemplate :: MonitorConfig -> String
pHighColor :: MonitorConfig -> Maybe String
pHigh :: MonitorConfig -> Int
pLowColor :: MonitorConfig -> Maybe String
pLow :: MonitorConfig -> Int
pNormalColor :: MonitorConfig -> Maybe String
..} TemplateInput{[String]
[(String, [(String, String, String)])]
[(String, String, String)]
temAllTemplate :: TemplateInput -> [(String, [(String, String, String)])]
temInputTemplate :: TemplateInput -> [(String, String, String)]
temMonitorValues :: TemplateInput -> [String]
temAllTemplate :: [(String, [(String, String, String)])]
temInputTemplate :: [(String, String, String)]
temMonitorValues :: [String]
..} =
do let m :: Map String ([(String, String, String)], String)
m = let [([(String, String, String)], String)]
expSnds :: [([(String, String, String)], String)] = [[(String, String, String)]]
-> [String] -> [([(String, String, String)], String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((String, [(String, String, String)])
-> [(String, String, String)])
-> [(String, [(String, String, String)])]
-> [[(String, String, String)]]
forall a b. (a -> b) -> [a] -> [b]
map (String, [(String, String, String)]) -> [(String, String, String)]
forall a b. (a, b) -> b
snd [(String, [(String, String, String)])]
temAllTemplate) [String]
temMonitorValues
in [(String, ([(String, String, String)], String))]
-> Map String ([(String, String, String)], String)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, ([(String, String, String)], String))]
-> Map String ([(String, String, String)], String))
-> [(String, ([(String, String, String)], String))]
-> Map String ([(String, String, String)], String)
forall a b. (a -> b) -> a -> b
$ [String]
-> [([(String, String, String)], String)]
-> [(String, ([(String, String, String)], String))]
forall a b. [a] -> [b] -> [(a, b)]
zip (((String, [(String, String, String)]) -> String)
-> [(String, [(String, String, String)])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [(String, String, String)]) -> String
forall a b. (a, b) -> a
fst [(String, [(String, String, String)])]
temAllTemplate) [([(String, String, String)], String)]
expSnds
String
s <- Map String ([(String, String, String)], String)
-> [(String, String, String)] -> IO String
minCombine Map String ([(String, String, String)], String)
m [(String, String, String)]
temInputTemplate
let (Int
n, String
s') = if Int
pMaxTotalWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pMaxTotalWidth
then Int -> String -> String -> (Int, String)
trimTo (Int
pMaxTotalWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
pMaxTotalWidthEllipsis) String
"" String
s
else (Int
1, String
s)
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then String
s' else String
s' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pMaxTotalWidthEllipsis
minCombine :: Map.Map String ([(String, String, String)], String) -> [(String, String, String)] -> IO String
minCombine :: Map String ([(String, String, String)], String)
-> [(String, String, String)] -> IO String
minCombine Map String ([(String, String, String)], String)
_ [] = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return []
minCombine Map String ([(String, String, String)], String)
m ((String
s,String
ts,String
ss):[(String, String, String)]
xs) =
do String
next <- Map String ([(String, String, String)], String)
-> [(String, String, String)] -> IO String
minCombine Map String ([(String, String, String)], String)
m [(String, String, String)]
xs
String
str <- case String
-> Map String ([(String, String, String)], String)
-> Maybe ([(String, String, String)], String)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ts Map String ([(String, String, String)], String)
m of
Maybe ([(String, String, String)], String)
Nothing -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ts String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
Just ([(String, String, String)]
s',String
r) -> let f :: String -> String
f String
"" = String
r; f String
n = String
n; in String -> String
f (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String ([(String, String, String)], String)
-> [(String, String, String)] -> IO String
minCombine Map String ([(String, String, String)], String)
m [(String, String, String)]
s'
String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ss String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
next
runP :: Parser [a] -> String -> IO [a]
runP :: Parser [a] -> String -> IO [a]
runP Parser [a]
p String
i =
case Parser [a] -> String -> String -> Either ParseError [a]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser [a]
p String
"" String
i of
Left ParseError
_ -> [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Right [a]
x -> [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
x
getAllBut :: String -> Parser String
getAllBut :: String -> Parser String
getAllBut String
s =
ParsecT String () Identity Char
-> ParsecT String () Identity Char -> Parser 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
s) (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)
-> Char -> ParsecT String () Identity Char
forall a b. (a -> b) -> a -> b
$ String -> Char
forall a. [a] -> a
head String
s)
getNumbers :: Parser Float
getNumbers :: Parser Float
getNumbers = ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT String () Identity () -> Parser String -> Parser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity Char -> Parser 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 Parser String -> (String -> Parser Float) -> Parser Float
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
n -> Float -> Parser Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> Parser Float) -> Float -> Parser Float
forall a b. (a -> b) -> a -> b
$ String -> Float
forall a. Read a => String -> a
read String
n
getNumbersAsString :: Parser String
getNumbersAsString :: Parser String
getNumbersAsString = ParsecT String () Identity Char -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space ParsecT String () Identity () -> Parser String -> Parser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity Char -> Parser 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 Parser String -> (String -> Parser String) -> Parser String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
n -> String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
skipRestOfLine :: Parser Char
skipRestOfLine :: ParsecT String () Identity Char
skipRestOfLine =
do ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char -> Parser String)
-> ParsecT String () Identity Char -> Parser 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
"\n\r"
ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
getAfterString :: String -> Parser String
getAfterString :: String -> Parser String
getAfterString String
s =
do { Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char -> Parser String -> Parser 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
skipRestOfLine (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
s
; ParsecT String () Identity Char
-> ParsecT String () Identity Char -> Parser 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
anyChar ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
} Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
skipTillString :: String -> Parser String
skipTillString :: String -> Parser String
skipTillString String
s =
ParsecT String () Identity Char -> Parser String -> Parser 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
skipRestOfLine (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
s
templateStringParser :: Parser (String,String,String)
templateStringParser :: Parser (String, String, String)
templateStringParser =
do { String
s <- Parser String
nonPlaceHolder
; String
com <- Parser String
templateCommandParser
; String
ss <- Parser String
nonPlaceHolder
; (String, String, String) -> Parser (String, String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
s, String
com, String
ss)
}
where
nonPlaceHolder :: Parser String
nonPlaceHolder = ([String] -> String)
-> ParsecT String () Identity [String] -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ParsecT String () Identity [String] -> Parser String)
-> (Parser String -> ParsecT String () Identity [String])
-> Parser String
-> Parser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser String -> ParsecT String () Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$
ParsecT String () Identity Char -> Parser 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
"<") Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
colorSpec Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
iconSpec
colorSpec :: Parser String
colorSpec :: Parser String
colorSpec = Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"</fc>") Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (
do String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<fc="
String
s <- ParsecT String () Identity Char -> Parser 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
'#')
Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ String
"<fc=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">")
iconSpec :: Parser String
iconSpec :: Parser String
iconSpec = Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<icon="
String
i <- ParsecT String () Identity Char -> Parser String -> Parser 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
">") (Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"/>"))
String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ String
"<icon=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/>")
templateCommandParser :: Parser String
templateCommandParser :: Parser String
templateCommandParser =
do { Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
; String
com <- ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char -> Parser String)
-> ParsecT String () Identity Char -> Parser 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
">"
; Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
; String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
com
}
templateParser :: Parser [(String,String,String)]
templateParser :: Parser [(String, String, String)]
templateParser = Parser (String, String, String)
-> Parser [(String, String, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (String, String, String)
templateStringParser
trimTo :: Int -> String -> String -> (Int, String)
trimTo :: Int -> String -> String -> (Int, String)
trimTo Int
n String
p String
"" = (Int
n, String
p)
trimTo Int
n String
p (Char
'<':String
cs) = Int -> String -> String -> (Int, String)
trimTo Int
n String
p' String
s
where p' :: String
p' = String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>') String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
s :: String
s = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>') String
cs)
trimTo Int
0 String
p String
s = Int -> String -> String -> (Int, String)
trimTo Int
0 String
p ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<') String
s)
trimTo Int
n String
p String
s = let p' :: String
p' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<') String
s
s' :: String
s' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<') String
s
in
if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
then Int -> String -> String -> (Int, String)
trimTo (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p') (String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p') String
s'
else Int -> String -> String -> (Int, String)
trimTo Int
0 (String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n String
p') String
s'
parseTemplate :: [String] -> Monitor String
parseTemplate :: [String] -> Monitor String
parseTemplate [String]
l =
do String
t <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
template
[String]
e <- Selector [String] -> Monitor [String]
forall a. Selector a -> Monitor a
getConfigValue Selector [String]
export
Int
w <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
maxTotalWidth
String
ell <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
maxTotalWidthEllipsis
let m :: Map String String
m = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, String)] -> Map String String)
-> ([String] -> [(String, String)])
-> [String]
-> Map String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
e ([String] -> Map String String) -> [String] -> Map String String
forall a b. (a -> b) -> a -> b
$ [String]
l
String
s <- String -> Map String String -> Monitor String
parseTemplate' String
t Map String String
m
let (Int
n, String
s') = if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w
then Int -> String -> String -> (Int, String)
trimTo (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ell) String
"" String
s
else (Int
1, String
s)
String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then String
s' else String
s' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ell
parseTemplate' :: String -> Map.Map String String -> Monitor String
parseTemplate' :: String -> Map String String -> Monitor String
parseTemplate' String
t Map String String
m =
do [(String, String, String)]
s <- IO [(String, String, String)] -> Monitor [(String, String, String)]
forall a. IO a -> Monitor a
io (IO [(String, String, String)]
-> Monitor [(String, String, String)])
-> IO [(String, String, String)]
-> Monitor [(String, String, String)]
forall a b. (a -> b) -> a -> b
$ Parser [(String, String, String)]
-> String -> IO [(String, String, String)]
forall a. Parser [a] -> String -> IO [a]
runP Parser [(String, String, String)]
templateParser String
t
Map String String -> [(String, String, String)] -> Monitor String
combine Map String String
m [(String, String, String)]
s
combine :: Map.Map String String -> [(String, String, String)] -> Monitor String
combine :: Map String String -> [(String, String, String)] -> Monitor String
combine Map String String
_ [] = String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return []
combine Map String String
m ((String
s,String
ts,String
ss):[(String, String, String)]
xs) =
do String
next <- Map String String -> [(String, String, String)] -> Monitor String
combine Map String String
m [(String, String, String)]
xs
String
str <- case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ts Map String String
m of
Maybe String
Nothing -> String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$ String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ts String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
Just String
r -> let f :: String -> String
f String
"" = String
r; f String
n = String
n; in String -> String
f (String -> String) -> Monitor String -> Monitor String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Map String String -> Monitor String
parseTemplate' String
r Map String String
m
String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ss String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
next
parseOptsWith
:: [OptDescr (opts -> opts)]
-> opts
-> [String]
-> IO opts
parseOptsWith :: [OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (opts -> opts)]
options opts
defaultOpts [String]
argv =
case ArgOrder (opts -> opts)
-> [OptDescr (opts -> opts)]
-> [String]
-> ([opts -> opts], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder (opts -> opts)
forall a. ArgOrder a
Permute [OptDescr (opts -> opts)]
options [String]
argv of
([opts -> opts]
o, [String]
_, [] ) -> opts -> IO opts
forall (f :: * -> *) a. Applicative f => a -> f a
pure (opts -> IO opts) -> opts -> IO opts
forall a b. (a -> b) -> a -> b
$ ((opts -> opts) -> opts -> opts) -> opts -> [opts -> opts] -> opts
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (opts -> opts) -> opts -> opts
forall a. a -> a
id opts
defaultOpts [opts -> opts]
o
([opts -> opts]
_, [String]
_, [String]
errs) -> IOError -> IO opts
forall a. IOError -> IO a
ioError (IOError -> IO opts) -> (String -> IOError) -> String -> IO opts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IO opts) -> String -> IO opts
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
errs