------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Template
-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sun Nov 25, 2018 05:49
--
--
-- Handling the top-level output template
--
------------------------------------------------------------------------------


module Xmobar.Run.Template(parseTemplate, splitTemplate) where

import qualified Data.Map as Map
import Text.ParserCombinators.Parsec

import Xmobar.Plugins.Command

import Xmobar.Run.Exec
import Xmobar.Run.Runnable

defaultAlign :: String
defaultAlign :: String
defaultAlign = String
"}{"

allTillSep :: String -> Parser String
allTillSep :: String -> Parser String
allTillSep = 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)
-> (String -> ParsecT String () Identity Char)
-> String
-> Parser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf

-- | Parses the output template string
templateStringParser :: String -> Parser (String,String,String)
templateStringParser :: String -> Parser (String, String, String)
templateStringParser String
sepChar = do
  String
s   <- String -> Parser String
allTillSep String
sepChar
  String
com <- String -> Parser String
templateCommandParser String
sepChar
  String
ss  <- String -> Parser String
allTillSep String
sepChar
  (String, String, String) -> Parser (String, String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
com, String
s, String
ss)

-- | Parses the command part of the template string
templateCommandParser :: String -> Parser String
templateCommandParser :: String -> Parser String
templateCommandParser String
sepChar =
  let chr :: ParsecT String u Identity Char
chr = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (String -> Char
forall a. [a] -> a
head String
sepChar) in ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> Parser String
-> Parser 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 ParsecT String () Identity Char
forall u. ParsecT String u Identity Char
chr ParsecT String () Identity Char
forall u. ParsecT String u Identity Char
chr (String -> Parser String
allTillSep String
sepChar)

-- | Combines the template parsers
templateParser :: String -> Parser [(String,String,String)]
templateParser :: String -> Parser [(String, String, String)]
templateParser String
s = 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)
 -> Parser [(String, String, String)])
-> Parser (String, String, String)
-> Parser [(String, String, String)]
forall a b. (a -> b) -> a -> b
$ String -> Parser (String, String, String)
templateStringParser String
s

-- | Actually runs the template parsers over a (segment of) a template
-- string, returning a list of runnables with their prefix and suffix.
parseTemplate :: [Runnable] -> String -> String -> IO [(Runnable,String,String)]
parseTemplate :: [Runnable] -> String -> String -> IO [(Runnable, String, String)]
parseTemplate [Runnable]
c String
sepChar String
s =
    do [(String, String, String)]
str <- case Parser [(String, String, String)]
-> String -> String -> Either ParseError [(String, String, String)]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (String -> Parser [(String, String, String)]
templateParser String
sepChar) String
"" String
s of
                Left ParseError
_  -> [(String, String, String)] -> IO [(String, String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String
"", String
s, String
"")]
                Right [(String, String, String)]
x -> [(String, String, String)] -> IO [(String, String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String, String, String)]
x
       let cl :: [String]
cl = (Runnable -> String) -> [Runnable] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Runnable -> String
forall e. Exec e => e -> String
alias [Runnable]
c
           m :: Map String Runnable
m  = [(String, Runnable)] -> Map String Runnable
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, Runnable)] -> Map String Runnable)
-> [(String, Runnable)] -> Map String Runnable
forall a b. (a -> b) -> a -> b
$ [String] -> [Runnable] -> [(String, Runnable)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
cl [Runnable]
c
       [(Runnable, String, String)] -> IO [(Runnable, String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Runnable, String, String)] -> IO [(Runnable, String, String)])
-> [(Runnable, String, String)] -> IO [(Runnable, String, String)]
forall a b. (a -> b) -> a -> b
$ [Runnable]
-> Map String Runnable
-> [(String, String, String)]
-> [(Runnable, String, String)]
combine [Runnable]
c Map String Runnable
m [(String, String, String)]
str

-- | Given a finite "Map" and a parsed template produce the resulting
-- output string.
combine :: [Runnable] -> Map.Map String Runnable -> [(String, String, String)]
           -> [(Runnable,String,String)]
combine :: [Runnable]
-> Map String Runnable
-> [(String, String, String)]
-> [(Runnable, String, String)]
combine [Runnable]
_ Map String Runnable
_ [] = []
combine [Runnable]
c Map String Runnable
m ((String
ts,String
s,String
ss):[(String, String, String)]
xs) = (Runnable
com, String
s, String
ss) (Runnable, String, String)
-> [(Runnable, String, String)] -> [(Runnable, String, String)]
forall a. a -> [a] -> [a]
: [Runnable]
-> Map String Runnable
-> [(String, String, String)]
-> [(Runnable, String, String)]
combine [Runnable]
c Map String Runnable
m [(String, String, String)]
xs
    where com :: Runnable
com  = Runnable -> String -> Map String Runnable -> Runnable
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Runnable
dflt String
ts Map String Runnable
m
          dflt :: Runnable
dflt = Command -> Runnable
forall r. (Exec r, Read r, Show r) => r -> Runnable
Run (Command -> Runnable) -> Command -> Runnable
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> Rate -> Command
Com String
ts [] [] Rate
10

-- | Given an two-char alignment separator and a template string,
-- splits it into its segments, that can then be parsed via parseCommands
splitTemplate :: String -> String -> [String]
splitTemplate :: String -> String -> [String]
splitTemplate String
alignSep String
template =
  case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
l) String
template of
    (String
le,Char
_:String
re) -> case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
r) String
re of
                   (String
ce,Char
_:String
ri) -> [String
le, String
ce, String
ri]
                   (String, String)
_         -> [String]
def
    (String, String)
_         -> [String]
def
  where [Char
l, Char
r] = if String -> Rate
forall (t :: * -> *) a. Foldable t => t a -> Rate
length String
alignSep Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
2 then String
alignSep else String
defaultAlign
        def :: [String]
def = [String
template, String
"", String
""]