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