Powerline prompt generator for bash, in haskell

haskell-powerline-prompt-generator.hs

--EXAMPLE : of course you need GHC installed, and ghci's `runhaskell
-- wanted prompt : [Segment 8 202 [Bold,Text " \\u "],Segment 202 16 [Bold,Text "@ "],Segment 240 255 [Underline,Text "\\H",StopUnderline,Text " "],Segment 220 16 [Bold,Text "$ "]]
-- run in shell export PS1=$(echo '[Segment 8 202 [Bold,Text " \\u "],Segment 202 16 [Bold,Text "@ "],Segment 240 255 [Underline,Text "\\H",StopUnderline,Text " "],Segment 220 16 [Bold,Text "$ "]]' | runhaskell haskell-powerline-prompt-generator.hs )

-- my prompt : [Segment 10 202 [Bold,Text " \\u "],Segment 202 16 [Bold,Text "\\H "],Segment 12 231 [Underline,Text "\\w",StopUnderline,Text " "],Segment 220 16 [Bold,Text "$ "]]
data PromptPart = ForegroundColor Int |BackgroundColor Int | Bold| StopBold|Underline|StopUnderline | Text String | Reset
  deriving (Show, Read, Ord, Eq)
data Segment = Segment Int Int [PromptPart] deriving (Show, Read, Ord, Eq)
--                     bg  fg

arrow = "\57520 " --powerline symbol

guard :: String -> String
guard t = "\\["++t++"\\]" -- needed in some terminals to enclose non-printable characters
formatText :: Int -> String
formatText i= "\\e["++(show i)++"m"
fgColor :: Int -> String
fgColor i = "\\e[38;5;"++(show i)++"m"
bgColor :: Int -> String
bgColor i = "\\e[48;5;"++(show i)++"m"

renderPart p = case p of
  (ForegroundColor c)->guard $ fgColor c
  (BackgroundColor c)->guard $ bgColor c
  Bold -> guard ("\\e[1m")
  StopBold -> guard "\\e[21m"
  Underline-> guard "\\e[4m"
  StopUnderline -> guard "\\e[24m"
  (Text t)->t
  Reset -> guard "\\e[0m\\e[39m\\e[39m"

renderParts :: [PromptPart] -> String
renderParts [] = ""
renderParts (p:rp) = (renderPart p)++(renderParts rp)

expandSegments :: Int -> [Segment] -> [PromptPart]
expandSegments _ [] = [Reset]
expandSegments prevbg ((Segment bg fg p):rx) = (expandSegments bg rx)++[(BackgroundColor bg), (ForegroundColor fg)]++p++[Reset, (ForegroundColor bg), (BackgroundColor prevbg), (Text arrow)]

makeEnd :: Int -> Int -> [PromptPart] -> [PromptPart]
makeEnd prevbg fg parts = [(BackgroundColor prevbg), (ForegroundColor fg)]++parts++[Reset,(ForegroundColor prevbg), (Text arrow), Reset]

renderPrompt :: [Segment] -> String
renderPrompt p = renderParts $ (expandSegments bgend $ tail $ reverse p)++(makeEnd bgend fgend lastpart)
  where (Segment bgend fgend lastpart)=head $ reverse p

examplePrompt = [
  (Segment 8 202 [Bold, (Text " \\u ")]),
  (Segment 202 16 [Bold, (Text "\\H ")]),
  (Segment 240 255 [Underline, (Text "\\w"), StopUnderline, (Text " ")]),
  (Segment 220 16 [Bold, (Text "$ ")])
  ]

s=renderPrompt examplePrompt

reduceGuard [x,y,z,t]=[x,y,z,t] -- remove unnnecessary \]\[ (closing-opening )
reduceGuard (x:y:z:t:xs)
  | (x:y:[])=="\\]" && (z:[t])=="\\[" = reduceGuard (xs)
  | otherwise = x:(reduceGuard (y:z:t:xs))

main = do
  --putStrLn $ reduceGuard ((renderPrompt examplePrompt)++(guard "\\e[0m"))
  str <- getLine
  putStrLn $ reduceGuard $ reduceGuard ((renderPrompt (read str :: [Segment]))++(guard "\\e[0m"))