{-#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
pNormalColor :: Maybe String
pLow :: Int
pLowColor :: Maybe String
pHigh :: Int
pHighColor :: Maybe String
pTemplate :: String
pExport :: [String]
pPpad :: Int
pDecDigits :: Int
pMinWidth :: Int
pMaxWidth :: Int
pMaxWidthEllipsis :: String
pPadChars :: String
pPadRight :: Bool
pBarBack :: String
pBarFore :: String
pBarWidth :: Int
pUseSuffix :: Bool
pNaString :: String
pMaxTotalWidth :: Int
pMaxTotalWidthEllipsis :: 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
..} = 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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
runExportParser (String
x:[String]
xs) = do
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
rest <- runExportParser xs
pure $ (x,s):rest
pureParseTemplate :: MonitorConfig -> TemplateInput -> IO String
pureParseTemplate :: MonitorConfig -> TemplateInput -> IO String
pureParseTemplate 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
pNormalColor :: Maybe String
pLow :: Int
pLowColor :: Maybe String
pHigh :: Int
pHighColor :: Maybe String
pTemplate :: String
pExport :: [String]
pPpad :: Int
pDecDigits :: Int
pMinWidth :: Int
pMaxWidth :: Int
pMaxWidthEllipsis :: String
pPadChars :: String
pPadRight :: Bool
pBarBack :: String
pBarFore :: String
pBarWidth :: Int
pUseSuffix :: Bool
pNaString :: String
pMaxTotalWidth :: Int
pMaxTotalWidthEllipsis :: String
..} TemplateInput{[String]
[(String, [(String, String, String)])]
[(String, String, String)]
temMonitorValues :: [String]
temInputTemplate :: [(String, String, String)]
temAllTemplate :: [(String, [(String, String, String)])]
temAllTemplate :: TemplateInput -> [(String, [(String, String, String)])]
temInputTemplate :: TemplateInput -> [(String, String, String)]
temMonitorValues :: TemplateInput -> [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
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 (n, s') = if pMaxTotalWidth > 0 && length s > pMaxTotalWidth
then trimTo (pMaxTotalWidth - length pMaxTotalWidthEllipsis) "" s
else (1, s)
return $ if n > 0 then s' else s' ++ 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 a. a -> IO a
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 next <- Map String ([(String, String, String)], String)
-> [(String, String, String)] -> IO String
minCombine Map String ([(String, String, String)], String)
m [(String, String, String)]
xs
str <- case Map.lookup ts m of
Maybe ([(String, String, String)], String)
Nothing -> String -> IO String
forall a. a -> IO a
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'
pure $ s ++ str ++ ss ++ next
runP :: Parser [a] -> String -> IO [a]
runP :: forall a. 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Right [a]
x -> [a] -> IO [a]
forall a. 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. HasCallStack => [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 a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. 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 a b.
ParsecT String () Identity a
-> (a -> ParsecT String () Identity b)
-> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
n -> Float -> Parser Float
forall a. a -> ParsecT String () Identity a
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 a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. 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 a b.
ParsecT String () Identity a
-> (a -> ParsecT String () Identity b)
-> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
n -> String -> Parser String
forall a. a -> ParsecT String () Identity a
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 a. a -> ParsecT String () Identity a
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 { s <- Parser String
nonPlaceHolder
; com <- templateCommandParser
; ss <- nonPlaceHolder
; return (s, com, ss)
}
where
nonPlaceHolder :: Parser String
nonPlaceHolder = ([String] -> String)
-> ParsecT String () Identity [String] -> Parser String
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
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 u (m :: * -> *) a. 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="
s <- ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. 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 '>'
return $ "<fc=" ++ s ++ ">")
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="
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
"/>"))
return $ "<icon=" ++ i ++ "/>")
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
'<'
; 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 '>'
; return 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 a. [a] -> 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 a. [a] -> 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 t <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
template
e <- getConfigValue export
w <- getConfigValue maxTotalWidth
ell <- getConfigValue maxTotalWidthEllipsis
let 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
s <- parseTemplate' t m
let (n, s') = if w > 0 && length s > w
then trimTo (w - length ell) "" s
else (1, s)
return $ if n > 0 then s' else s' ++ ell
parseTemplate' :: String -> Map.Map String String -> Monitor String
parseTemplate' :: String -> Map String String -> Monitor String
parseTemplate' String
t Map String String
m =
do 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
combine m 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 a. a -> ReaderT MConfig IO a
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 next <- Map String String -> [(String, String, String)] -> Monitor String
combine Map String String
m [(String, String, String)]
xs
str <- case Map.lookup ts m of
Maybe String
Nothing -> String -> Monitor String
forall a. a -> ReaderT MConfig IO a
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
return $ s ++ str ++ ss ++ next
parseOptsWith
:: [OptDescr (opts -> opts)]
-> opts
-> [String]
-> IO opts
parseOptsWith :: forall opts.
[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 a. a -> IO a
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 a b. (a -> b -> b) -> b -> [a] -> b
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