1{-# LANGUAGE ScopedTypeVariables #-} 2module Language.Haskell.HsColour.Colourise 3 ( module Language.Haskell.HsColour.ColourHighlight 4 , ColourPrefs(..) 5 , readColourPrefs 6 , defaultColourPrefs 7 , colourise 8 ) where 9 10import Language.Haskell.HsColour.ColourHighlight 11import Language.Haskell.HsColour.Classify (TokenType(..)) 12 13import System.IO (hPutStrLn,stderr) 14import System.Environment (getEnv) 15import Data.List 16import Prelude hiding (catch) 17import Control.Exception.Base (catch) 18 19-- | Colour preferences. 20data ColourPrefs = ColourPrefs 21 { keyword, keyglyph, layout, comment 22 , conid, varid, conop, varop 23 , string, char, number, cpp 24 , selection, variantselection, definition :: [Highlight] 25 } deriving (Eq,Show,Read) 26 27defaultColourPrefs = ColourPrefs 28 { keyword = [Foreground Green,Underscore] 29 , keyglyph = [Foreground Red] 30 , layout = [Foreground Cyan] 31 , comment = [Foreground Blue, Italic] 32 , conid = [Normal] 33 , varid = [Normal] 34 , conop = [Foreground Red,Bold] 35 , varop = [Foreground Cyan] 36 , string = [Foreground Magenta] 37 , char = [Foreground Magenta] 38 , number = [Foreground Magenta] 39 , cpp = [Foreground Magenta,Dim] 40 , selection = [Bold, Foreground Magenta] 41 , variantselection = [Dim, Foreground Red, Underscore] 42 , definition = [Foreground Blue] 43 } 44 45-- NOTE, should we give a warning message on a failed reading? 46parseColourPrefs :: String -> String -> IO ColourPrefs 47parseColourPrefs file x = 48 case reads x of 49 (res,_):_ -> return res 50 _ -> do hPutStrLn stderr ("Could not parse colour prefs from "++file 51 ++": reverting to defaults") 52 return defaultColourPrefs 53 54-- | Read colour preferences from .hscolour file in the current directory, or failing that, 55-- from \$HOME\/.hscolour, and failing that, returns a default set of prefs. 56readColourPrefs :: IO ColourPrefs 57readColourPrefs = catch 58 (do val <- readFile ".hscolour" 59 parseColourPrefs ".hscolour" val) 60 (\ (_::IOError)-> catch 61 (do home <- getEnv "HOME" 62 val <- readFile (home++"/.hscolour") 63 parseColourPrefs (home++"/.hscolour") val) 64 (\ (_::IOError)-> return defaultColourPrefs)) 65 66-- | Convert token classification to colour highlights. 67colourise :: ColourPrefs -> TokenType -> [Highlight] 68colourise pref Space = [Normal] 69colourise pref Comment = comment pref 70colourise pref Keyword = keyword pref 71colourise pref Keyglyph = keyglyph pref 72colourise pref Layout = layout pref 73colourise pref Conid = conid pref 74colourise pref Varid = varid pref 75colourise pref Conop = conop pref 76colourise pref Varop = varop pref 77colourise pref String = string pref 78colourise pref Char = char pref 79colourise pref Number = number pref 80colourise pref Cpp = cpp pref 81colourise pref Error = selection pref 82colourise pref Definition = definition pref 83 84