> module Colour (getcol, getcolmask, get_colours) where

> import Type_Data
> import Library
> import System
> import Exception


Given a list of colour pairs and an identifier, getcol returns the
ANSI escape code corresponding to the identifier, or a default normal
colour. For example

Main> getcol [("fi", "00"), ("di", "01;34"), ("ln", "01;36")] "di"
"\ESC[01;34m"
Main> getcol [("fi", "00"), ("di", "01;34"), ("ln", "01;36")] "no"
"\ESC[0m"
Main>

> getcol :: [ColourP] -> String -> String
> getcol [] _ = '\027':"[0m"
> getcol ((ident, val):cs) want = if ident == want then ('\027':'[':val ++ "m")
>                                                  else getcol cs want


getcolmask gets the colour corresponding to a file mask
(of the form "*":const_string) from a list of colour pairs, e.g.

Main> getcolmask [("*.tgz", "01;31"), ("*.png", "01;35")] "a.b.c.tgz"
"\ESC[01;31m"
Main> getcolmask [("*.tgz", "01;31"), ("*.png", "01;35")] "a.b.c.txt"
""
Main>

> getcolmask :: [ColourP] -> String -> String
> getcolmask [] _ = ""
> getcolmask (("", _):cs) filename = getcolmask cs filename
> getcolmask ((ident, val):cs) filename
>  = if head ident == '*'
>    then if tail ident == end
>         then ('\027':'[':val ++ "m")
>         else getcolmask cs filename
>    else getcolmask cs filename
>  where end = reverse $ take (length $ tail ident) $ reverse filename


get_colours returns an IO list of colour pairs based on the environment
variable LS_COLORS, or the empty list if the variable doesn't exist.
e.g.

Main> get_colours >>= putStr . show   
[("no","00"),("fi","00"),("*.tgz","01;31"),("*.png","01;35")]
Main>

> get_colours :: IO [ColourP]
> get_colours = do envvar <- catchAllIO (System.getEnv "LS_COLORS")
>                                       (\_ -> return [])
>                  return $ split_colours envvar

Main> split_colours "no=00:fi=00:*.tgz=01;31:*.png=01;35:"
[("no","00"),("fi","00"),("*.tgz","01;31"),("*.png","01;35")]

> split_colours :: String -> [ColourP]
> split_colours [] = []
> split_colours ss = splitOn '=' this:split_colours rest
>  where (this, rest) = takeDropUntil ((==) ':') ss