    {-# 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
      { ColourPrefs -> [Highlight]
    keyword, ColourPrefs -> [Highlight]
    keyglyph, ColourPrefs -> [Highlight]
    layout, ColourPrefs -> [Highlight]
    comment
      , ColourPrefs -> [Highlight]
    conid, ColourPrefs -> [Highlight]
    varid, ColourPrefs -> [Highlight]
    conop, ColourPrefs -> [Highlight]
    varop
      , ColourPrefs -> [Highlight]
    string, ColourPrefs -> [Highlight]
    char, ColourPrefs -> [Highlight]
    number, ColourPrefs -> [Highlight]
    cpp
      , ColourPrefs -> [Highlight]
    selection, ColourPrefs -> [Highlight]
    variantselection, ColourPrefs -> [Highlight]
    definition :: [Highlight]
      } deriving (ColourPrefs -> ColourPrefs -> Bool
    (ColourPrefs -> ColourPrefs -> Bool)
    -> (ColourPrefs -> ColourPrefs -> Bool) -> Eq ColourPrefs
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ColourPrefs -> ColourPrefs -> Bool
    == :: ColourPrefs -> ColourPrefs -> Bool
    $c/= :: ColourPrefs -> ColourPrefs -> Bool
    /= :: ColourPrefs -> ColourPrefs -> Bool
    Eq,Int -> ColourPrefs -> ShowS
    [ColourPrefs] -> ShowS
    ColourPrefs -> String
    (Int -> ColourPrefs -> ShowS)
    -> (ColourPrefs -> String)
    -> ([ColourPrefs] -> ShowS)
    -> Show ColourPrefs
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ColourPrefs -> ShowS
    showsPrec :: Int -> ColourPrefs -> ShowS
    $cshow :: ColourPrefs -> String
    show :: ColourPrefs -> String
    $cshowList :: [ColourPrefs] -> ShowS
    showList :: [ColourPrefs] -> ShowS
    Show,ReadPrec [ColourPrefs]
    ReadPrec ColourPrefs
    Int -> ReadS ColourPrefs
    ReadS [ColourPrefs]
    (Int -> ReadS ColourPrefs)
    -> ReadS [ColourPrefs]
    -> ReadPrec ColourPrefs
    -> ReadPrec [ColourPrefs]
    -> Read ColourPrefs
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS ColourPrefs
    readsPrec :: Int -> ReadS ColourPrefs
    $creadList :: ReadS [ColourPrefs]
    readList :: ReadS [ColourPrefs]
    $creadPrec :: ReadPrec ColourPrefs
    readPrec :: ReadPrec ColourPrefs
    $creadListPrec :: ReadPrec [ColourPrefs]
    readListPrec :: ReadPrec [ColourPrefs]
    Read)

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

    -- NOTE, should we give a warning message on a failed reading?
    parseColourPrefs :: String -> String -> IO ColourPrefs
    parseColourPrefs :: String -> String -> IO ColourPrefs
    parseColourPrefs String
    file String
    x =
        case ReadS ColourPrefs
    forall a. Read a => ReadS a
    reads String
    x of
            (ColourPrefs
    res,String
    _):[(ColourPrefs, String)]
    _ -> ColourPrefs -> IO ColourPrefs
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ColourPrefs
    res
            [(ColourPrefs, String)]
    _ -> do Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String
    "Could not parse colour prefs from "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    file
                                      String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    ": reverting to defaults")
                    ColourPrefs -> IO ColourPrefs
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ColourPrefs
    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 :: IO ColourPrefs
    readColourPrefs = IO ColourPrefs -> (IOError -> IO ColourPrefs) -> IO ColourPrefs
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    catch
      (do val <- String -> IO String
    readFile String
    ".hscolour"
          parseColourPrefs ".hscolour" val)
      (\ (IOError
    _::IOError)-> IO ColourPrefs -> (IOError -> IO ColourPrefs) -> IO ColourPrefs
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    catch
        (do home <- String -> IO String
    getEnv String
    "HOME"
            val <- readFile (home++"/.hscolour")
            parseColourPrefs (home++"/.hscolour") val)
        (\ (IOError
    _::IOError)-> ColourPrefs -> IO ColourPrefs
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ColourPrefs
    defaultColourPrefs))

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