    module Language.Haskell.HsColour.Colourise
      ( module Language.Haskell.HsColour.ColourHighlight
      , ColourPrefs(..)
      , readColourPrefs
      , colourise
      ) where

    import Language.Haskell.HsColour.ColourHighlight
    import Language.Haskell.HsColour.Classify (TokenType(..))

    import IO (hPutStrLn,stderr)
    import System (getEnv)
    import List

    -- | Colour preferences.
    data ColourPrefs = ColourPrefs
      { keyword, keyglyph, layout, comment
      , conid, varid, conop, varop
      , string, char, number, cpp
      , selection, variantselection, definition :: [Highlight]
      } deriving (Eq,Show,Read)

    defaultColourPrefs = ColourPrefs
      { keyword  = [Foreground Green,Underscore]
      , keyglyph = [Foreground Red]
      , layout   = [Foreground Cyan]
      , comment  = [Foreground Blue]
      , conid    = [Normal]
      , varid    = [Normal]
      , conop    = [Foreground Red,Bold]
      , varop    = [Foreground Cyan]
      , string   = [Foreground Magenta]
      , char     = [Foreground Magenta]
      , number   = [Foreground Magenta]
      , cpp      = [Foreground Magenta,Dim]
      , selection = [Bold, Foreground Magenta]
      , variantselection = [Dim, Foreground Red, Underscore]
      , definition = [Foreground Blue]
      }

    -- NOTE, should we give a warning message on a failed reading?
    parseColourPrefs :: String -> String -> IO ColourPrefs
    parseColourPrefs file x =
        case reads x of
            (res,_):_ -> return res
            _ -> do hPutStrLn stderr ("Could not parse colour prefs from "++file
                                      ++": reverting to defaults")
                    return defaultColourPrefs

    -- | Read colour preferences from .hscolour file in the current directory, or failing that,
    --   from \$HOME\/.hscolour, and failing that, returns a default set of prefs.
    readColourPrefs :: IO ColourPrefs
    readColourPrefs = catch
      (do val <- readFile ".hscolour"
          parseColourPrefs ".hscolour" val)
      (\_-> catch
        (do home <- getEnv "HOME"
            val <- readFile (home++"/.hscolour")
            parseColourPrefs (home++"/.hscolour") val)
        (\_-> return defaultColourPrefs))

    -- | Convert token classification to colour highlights.
    colourise :: ColourPrefs -> TokenType -> [Highlight]
    colourise pref Space    = [Normal]
    colourise pref Comment  = comment pref
    colourise pref Keyword  = keyword pref
    colourise pref Keyglyph = keyglyph pref
    colourise pref Layout   = layout pref
    colourise pref Conid    = conid pref
    colourise pref Varid    = varid pref
    colourise pref Conop    = conop pref
    colourise pref Varop    = varop pref
    colourise pref String   = string pref
    colourise pref Char     = char pref
    colourise pref Number   = number pref
    colourise pref Cpp      = cpp pref
    colourise pref Error    = selection pref
    colourise pref Definition = definition pref