{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.HsColour.Colourise
  ( module Language.Haskell.HsColour.ColourHighlight
  , ColourPrefs(..)
  , readColourPrefs
  , defaultColourPrefs
  , colourise
  ) where

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

import System.IO (hPutStrLn,stderr)
import System.Environment (getEnv)
import Data.List
import Prelude hiding (catch)
import Control.Exception.Base (catch)

-- | 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, Italic]
  , 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)
  (\ (_::IOError)-> catch
    (do home <- getEnv "HOME"
        val <- readFile (home++"/.hscolour")
        parseColourPrefs (home++"/.hscolour") val)
    (\ (_::IOError)-> 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