{-#LANGUAGE RecordWildCards#-}
{-#LANGUAGE ScopedTypeVariables#-}

------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Plugins.Monitors.Parsers
-- Copyright: (c) 2018, 2020 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sun Dec 02, 2018 04:49
--
--
-- Parsing template strings
--
------------------------------------------------------------------------------


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

-- | Parses the output template string
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

-- | Recognizes color specification and returns it unchanged
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
">")

-- | Recognizes icon specification and returns it unchanged
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
"/>")

-- | Parses the command part of the template 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
       }

-- | Combines the template parsers
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'

-- | Takes a list of strings that represent the values of the exported
-- keys. The strings are joined with the exported keys to form a map
-- to be combined with 'combine' to the parsed template. Returns the
-- final output of the monitor, trimmed to MaxTotalWidth if that
-- configuration value is positive.
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

-- | Parses the template given to it with a map of export values and combines
-- them
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

-- | Given a finite "Map" and a parsed template t produces the
-- | resulting output string as the output of the monitor.
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

-- | Try to parse arguments from the config file and apply them to Options.
parseOptsWith
    :: [OptDescr (opts -> opts)]  -- ^ Options that are specifiable
    -> opts                       -- ^ Default options to use as a fallback
    -> [String]                   -- ^ Actual arguments given
    -> 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