{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP, DeriveDataTypeable #-}
{- |
   Module      : Text.Highlighting.Kate.Types
   Copyright   : Copyright (C) 2008 John MacFarlane
   License     : GNU GPL, version 2 or above 

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha 
   Portability : portable

Definitions for data structures needed by highlighting-kate.
-}

module Text.Highlighting.Kate.Types where
import Text.ParserCombinators.Parsec
import Data.Word
import Text.Printf
import Data.Data (Data)
import Data.Bits
import Data.Typeable (Typeable)

-- | A context: pair of syntax name and context name.
type Context = (String, String)

-- | A stack of contexts.  (Language-specific context
-- stacks must be maintained because of IncludeRules.)
type ContextStack = [Context]

-- | State for syntax parser.
data SyntaxState = SyntaxState
  { SyntaxState -> ContextStack
synStContexts             :: ContextStack -- ^ Stack of contexts
  , SyntaxState -> Int
synStLineNumber           :: Int          -- ^ Number of current line
  , SyntaxState -> Char
synStPrevChar             :: Char         -- ^ Last character parsed
  , SyntaxState -> Bool
synStPrevNonspace         :: Bool         -- ^ True if we've parsed a nonspace
  , SyntaxState -> Bool
synStContinuation         :: Bool         -- ^ True if last thing parsed is
                                              --   a LineContinue
  , SyntaxState -> Bool
synStCaseSensitive        :: Bool         -- ^ Language is case-sensitive
  , SyntaxState -> Bool
synStKeywordCaseSensitive :: Bool         -- ^ Keywords are case-sensitive
  , SyntaxState -> [String]
synStCaptures             :: [String]     -- ^ List of regex captures from
                                              --   last capturing match
  } deriving Int -> SyntaxState -> ShowS
[SyntaxState] -> ShowS
SyntaxState -> String
(Int -> SyntaxState -> ShowS)
-> (SyntaxState -> String)
-> ([SyntaxState] -> ShowS)
-> Show SyntaxState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SyntaxState -> ShowS
showsPrec :: Int -> SyntaxState -> ShowS
$cshow :: SyntaxState -> String
show :: SyntaxState -> String
$cshowList :: [SyntaxState] -> ShowS
showList :: [SyntaxState] -> ShowS
Show

defaultSyntaxState :: SyntaxState
defaultSyntaxState :: SyntaxState
defaultSyntaxState = SyntaxState{
    synStContexts :: ContextStack
synStContexts = []
  , synStLineNumber :: Int
synStLineNumber = Int
0
  , synStPrevNonspace :: Bool
synStPrevNonspace = Bool
False
  , synStContinuation :: Bool
synStContinuation = Bool
False
  , synStPrevChar :: Char
synStPrevChar = Char
'\n'
  , synStCaseSensitive :: Bool
synStCaseSensitive = Bool
True
  , synStKeywordCaseSensitive :: Bool
synStKeywordCaseSensitive = Bool
True
  , synStCaptures :: [String]
synStCaptures = []
  }

-- | A pair consisting of a list of attributes and some text.
type Token = (TokenType, String)

data TokenType = KeywordTok
               | DataTypeTok
               | DecValTok
               | BaseNTok
               | FloatTok
               | ConstantTok
               | CharTok
               | SpecialCharTok
               | StringTok
               | VerbatimStringTok
               | SpecialStringTok
               | ImportTok
               | CommentTok
               | DocumentationTok
               | AnnotationTok
               | CommentVarTok
               | OtherTok
               | FunctionTok
               | VariableTok
               | ControlFlowTok
               | OperatorTok
               | BuiltInTok
               | ExtensionTok
               | PreprocessorTok
               | AttributeTok
               | RegionMarkerTok
               | InformationTok
               | WarningTok
               | AlertTok
               | ErrorTok
               | NormalTok
               deriving (ReadPrec [TokenType]
ReadPrec TokenType
Int -> ReadS TokenType
ReadS [TokenType]
(Int -> ReadS TokenType)
-> ReadS [TokenType]
-> ReadPrec TokenType
-> ReadPrec [TokenType]
-> Read TokenType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TokenType
readsPrec :: Int -> ReadS TokenType
$creadList :: ReadS [TokenType]
readList :: ReadS [TokenType]
$creadPrec :: ReadPrec TokenType
readPrec :: ReadPrec TokenType
$creadListPrec :: ReadPrec [TokenType]
readListPrec :: ReadPrec [TokenType]
Read, Int -> TokenType -> ShowS
[TokenType] -> ShowS
TokenType -> String
(Int -> TokenType -> ShowS)
-> (TokenType -> String)
-> ([TokenType] -> ShowS)
-> Show TokenType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenType -> ShowS
showsPrec :: Int -> TokenType -> ShowS
$cshow :: TokenType -> String
show :: TokenType -> String
$cshowList :: [TokenType] -> ShowS
showList :: [TokenType] -> ShowS
Show, TokenType -> TokenType -> Bool
(TokenType -> TokenType -> Bool)
-> (TokenType -> TokenType -> Bool) -> Eq TokenType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokenType -> TokenType -> Bool
== :: TokenType -> TokenType -> Bool
$c/= :: TokenType -> TokenType -> Bool
/= :: TokenType -> TokenType -> Bool
Eq, Int -> TokenType
TokenType -> Int
TokenType -> [TokenType]
TokenType -> TokenType
TokenType -> TokenType -> [TokenType]
TokenType -> TokenType -> TokenType -> [TokenType]
(TokenType -> TokenType)
-> (TokenType -> TokenType)
-> (Int -> TokenType)
-> (TokenType -> Int)
-> (TokenType -> [TokenType])
-> (TokenType -> TokenType -> [TokenType])
-> (TokenType -> TokenType -> [TokenType])
-> (TokenType -> TokenType -> TokenType -> [TokenType])
-> Enum TokenType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TokenType -> TokenType
succ :: TokenType -> TokenType
$cpred :: TokenType -> TokenType
pred :: TokenType -> TokenType
$ctoEnum :: Int -> TokenType
toEnum :: Int -> TokenType
$cfromEnum :: TokenType -> Int
fromEnum :: TokenType -> Int
$cenumFrom :: TokenType -> [TokenType]
enumFrom :: TokenType -> [TokenType]
$cenumFromThen :: TokenType -> TokenType -> [TokenType]
enumFromThen :: TokenType -> TokenType -> [TokenType]
$cenumFromTo :: TokenType -> TokenType -> [TokenType]
enumFromTo :: TokenType -> TokenType -> [TokenType]
$cenumFromThenTo :: TokenType -> TokenType -> TokenType -> [TokenType]
enumFromThenTo :: TokenType -> TokenType -> TokenType -> [TokenType]
Enum, Typeable TokenType
Typeable TokenType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TokenType -> c TokenType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TokenType)
-> (TokenType -> Constr)
-> (TokenType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TokenType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenType))
-> ((forall b. Data b => b -> b) -> TokenType -> TokenType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TokenType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TokenType -> r)
-> (forall u. (forall d. Data d => d -> u) -> TokenType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TokenType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TokenType -> m TokenType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TokenType -> m TokenType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TokenType -> m TokenType)
-> Data TokenType
TokenType -> Constr
TokenType -> DataType
(forall b. Data b => b -> b) -> TokenType -> TokenType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TokenType -> u
forall u. (forall d. Data d => d -> u) -> TokenType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenType -> c TokenType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenType -> c TokenType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenType -> c TokenType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenType
$ctoConstr :: TokenType -> Constr
toConstr :: TokenType -> Constr
$cdataTypeOf :: TokenType -> DataType
dataTypeOf :: TokenType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenType)
$cgmapT :: (forall b. Data b => b -> b) -> TokenType -> TokenType
gmapT :: (forall b. Data b => b -> b) -> TokenType -> TokenType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TokenType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TokenType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenType -> m TokenType
Data, Typeable)

-- | A line of source, list of labeled source items.
type SourceLine = [Token]

type KateParser = GenParser Char SyntaxState

data TokenStyle = TokenStyle {
    TokenStyle -> Maybe Color
tokenColor      :: Maybe Color
  , TokenStyle -> Maybe Color
tokenBackground :: Maybe Color
  , TokenStyle -> Bool
tokenBold       :: Bool
  , TokenStyle -> Bool
tokenItalic     :: Bool
  , TokenStyle -> Bool
tokenUnderline  :: Bool
  } deriving (Int -> TokenStyle -> ShowS
[TokenStyle] -> ShowS
TokenStyle -> String
(Int -> TokenStyle -> ShowS)
-> (TokenStyle -> String)
-> ([TokenStyle] -> ShowS)
-> Show TokenStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenStyle -> ShowS
showsPrec :: Int -> TokenStyle -> ShowS
$cshow :: TokenStyle -> String
show :: TokenStyle -> String
$cshowList :: [TokenStyle] -> ShowS
showList :: [TokenStyle] -> ShowS
Show, ReadPrec [TokenStyle]
ReadPrec TokenStyle
Int -> ReadS TokenStyle
ReadS [TokenStyle]
(Int -> ReadS TokenStyle)
-> ReadS [TokenStyle]
-> ReadPrec TokenStyle
-> ReadPrec [TokenStyle]
-> Read TokenStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TokenStyle
readsPrec :: Int -> ReadS TokenStyle
$creadList :: ReadS [TokenStyle]
readList :: ReadS [TokenStyle]
$creadPrec :: ReadPrec TokenStyle
readPrec :: ReadPrec TokenStyle
$creadListPrec :: ReadPrec [TokenStyle]
readListPrec :: ReadPrec [TokenStyle]
Read, Typeable TokenStyle
Typeable TokenStyle
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TokenStyle -> c TokenStyle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TokenStyle)
-> (TokenStyle -> Constr)
-> (TokenStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TokenStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TokenStyle))
-> ((forall b. Data b => b -> b) -> TokenStyle -> TokenStyle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TokenStyle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TokenStyle -> r)
-> (forall u. (forall d. Data d => d -> u) -> TokenStyle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TokenStyle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle)
-> Data TokenStyle
TokenStyle -> Constr
TokenStyle -> DataType
(forall b. Data b => b -> b) -> TokenStyle -> TokenStyle
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TokenStyle -> u
forall u. (forall d. Data d => d -> u) -> TokenStyle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenStyle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenStyle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenStyle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenStyle -> c TokenStyle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenStyle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenStyle)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenStyle -> c TokenStyle
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TokenStyle -> c TokenStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenStyle
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TokenStyle
$ctoConstr :: TokenStyle -> Constr
toConstr :: TokenStyle -> Constr
$cdataTypeOf :: TokenStyle -> DataType
dataTypeOf :: TokenStyle -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenStyle)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TokenStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenStyle)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TokenStyle)
$cgmapT :: (forall b. Data b => b -> b) -> TokenStyle -> TokenStyle
gmapT :: (forall b. Data b => b -> b) -> TokenStyle -> TokenStyle
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenStyle -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TokenStyle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenStyle -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TokenStyle -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TokenStyle -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TokenStyle -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenStyle -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TokenStyle -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TokenStyle -> m TokenStyle
Data, Typeable)

defStyle :: TokenStyle
defStyle :: TokenStyle
defStyle = TokenStyle {
    tokenColor :: Maybe Color
tokenColor      = Maybe Color
forall a. Maybe a
Nothing
  , tokenBackground :: Maybe Color
tokenBackground = Maybe Color
forall a. Maybe a
Nothing
  , tokenBold :: Bool
tokenBold       = Bool
False
  , tokenItalic :: Bool
tokenItalic     = Bool
False
  , tokenUnderline :: Bool
tokenUnderline  = Bool
False
  }

data Color = RGB Word8 Word8 Word8 deriving (Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Color -> ShowS
showsPrec :: Int -> Color -> ShowS
$cshow :: Color -> String
show :: Color -> String
$cshowList :: [Color] -> ShowS
showList :: [Color] -> ShowS
Show, ReadPrec [Color]
ReadPrec Color
Int -> ReadS Color
ReadS [Color]
(Int -> ReadS Color)
-> ReadS [Color]
-> ReadPrec Color
-> ReadPrec [Color]
-> Read Color
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Color
readsPrec :: Int -> ReadS Color
$creadList :: ReadS [Color]
readList :: ReadS [Color]
$creadPrec :: ReadPrec Color
readPrec :: ReadPrec Color
$creadListPrec :: ReadPrec [Color]
readListPrec :: ReadPrec [Color]
Read, Typeable Color
Typeable Color
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Color -> c Color)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Color)
-> (Color -> Constr)
-> (Color -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Color))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color))
-> ((forall b. Data b => b -> b) -> Color -> Color)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r)
-> (forall u. (forall d. Data d => d -> u) -> Color -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Color -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Color -> m Color)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Color -> m Color)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Color -> m Color)
-> Data Color
Color -> Constr
Color -> DataType
(forall b. Data b => b -> b) -> Color -> Color
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Color -> u
forall u. (forall d. Data d => d -> u) -> Color -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color -> m Color
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color -> c Color
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color -> c Color
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color -> c Color
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color
$ctoConstr :: Color -> Constr
toConstr :: Color -> Constr
$cdataTypeOf :: Color -> DataType
dataTypeOf :: Color -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color)
$cgmapT :: (forall b. Data b => b -> b) -> Color -> Color
gmapT :: (forall b. Data b => b -> b) -> Color -> Color
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Color -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Color -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Color -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Color -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color -> m Color
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color -> m Color
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color -> m Color
Data, Typeable)

class ToColor a where
  toColor :: a -> Maybe Color

instance ToColor String where
  toColor :: String -> Maybe Color
toColor [Char
'#',Char
r1,Char
r2,Char
g1,Char
g2,Char
b1,Char
b2] =
     case ReadS (Word8, Word8, Word8)
forall a. Read a => ReadS a
reads [Char
'(',Char
'0',Char
'x',Char
r1,Char
r2,Char
',',Char
'0',Char
'x',Char
g1,Char
g2,Char
',',Char
'0',Char
'x',Char
b1,Char
b2,Char
')'] of
           ((Word8
r,Word8
g,Word8
b),String
_) : [((Word8, Word8, Word8), String)]
_ -> Color -> Maybe Color
forall a. a -> Maybe a
Just (Color -> Maybe Color) -> Color -> Maybe Color
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Color
RGB Word8
r Word8
g Word8
b
           [((Word8, Word8, Word8), String)]
_                                         -> Maybe Color
forall a. Maybe a
Nothing
  toColor String
_        = Maybe Color
forall a. Maybe a
Nothing

instance ToColor Int where
  toColor :: Int -> Maybe Color
toColor Int
x = (Word8, Word8, Word8) -> Maybe Color
forall a. ToColor a => a -> Maybe Color
toColor (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x1 :: Word8,
                       Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x2 :: Word8,
                       Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x3 :: Word8)
    where x1 :: Int
x1 = (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
x Int
16) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF
          x2 :: Int
x2 = (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
x Int
8 ) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF
          x3 :: Int
x3 = Int
x             Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF

instance ToColor (Word8, Word8, Word8) where
  toColor :: (Word8, Word8, Word8) -> Maybe Color
toColor (Word8
r,Word8
g,Word8
b) = Color -> Maybe Color
forall a. a -> Maybe a
Just (Color -> Maybe Color) -> Color -> Maybe Color
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Color
RGB Word8
r Word8
g Word8
b

instance ToColor (Double, Double, Double) where
  toColor :: (Double, Double, Double) -> Maybe Color
toColor (Double
r,Double
g,Double
b) | Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
g Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
b Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1 Bool -> Bool -> Bool
&& Double
g Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1 Bool -> Bool -> Bool
&& Double
b Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
1 =
          Color -> Maybe Color
forall a. a -> Maybe a
Just (Color -> Maybe Color) -> Color -> Maybe Color
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Color
RGB (Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Word8) -> Double -> Word8
forall a b. (a -> b) -> a -> b
$ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
255) (Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Word8) -> Double -> Word8
forall a b. (a -> b) -> a -> b
$ Double
g Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
255) (Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Word8) -> Double -> Word8
forall a b. (a -> b) -> a -> b
$ Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
255)
  toColor (Double, Double, Double)
_ = Maybe Color
forall a. Maybe a
Nothing

class FromColor a where
  fromColor :: Color -> a

instance FromColor String where
  fromColor :: Color -> String
fromColor (RGB Word8
r Word8
g Word8
b) = String -> Word8 -> Word8 -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"#%02x%02x%02x" Word8
r Word8
g Word8
b

instance FromColor (Double, Double, Double) where
  fromColor :: Color -> (Double, Double, Double)
fromColor (RGB Word8
r Word8
g Word8
b) = (Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
r Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
255, Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
g Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
255, Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
255)

instance FromColor (Word8, Word8, Word8) where
  fromColor :: Color -> (Word8, Word8, Word8)
fromColor (RGB Word8
r Word8
g Word8
b) = (Word8
r, Word8
g, Word8
b)

data Style = Style {
    Style -> [(TokenType, TokenStyle)]
tokenStyles               :: [(TokenType, TokenStyle)]
  , Style -> Maybe Color
defaultColor              :: Maybe Color
  , Style -> Maybe Color
backgroundColor           :: Maybe Color
  , Style -> Maybe Color
lineNumberColor           :: Maybe Color
  , Style -> Maybe Color
lineNumberBackgroundColor :: Maybe Color
  } deriving (ReadPrec [Style]
ReadPrec Style
Int -> ReadS Style
ReadS [Style]
(Int -> ReadS Style)
-> ReadS [Style]
-> ReadPrec Style
-> ReadPrec [Style]
-> Read Style
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Style
readsPrec :: Int -> ReadS Style
$creadList :: ReadS [Style]
readList :: ReadS [Style]
$creadPrec :: ReadPrec Style
readPrec :: ReadPrec Style
$creadListPrec :: ReadPrec [Style]
readListPrec :: ReadPrec [Style]
Read, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> String
show :: Style -> String
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
Show, Typeable Style
Typeable Style
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Style -> c Style)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Style)
-> (Style -> Constr)
-> (Style -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Style))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Style))
-> ((forall b. Data b => b -> b) -> Style -> Style)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Style -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Style -> r)
-> (forall u. (forall d. Data d => d -> u) -> Style -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Style -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Style -> m Style)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Style -> m Style)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Style -> m Style)
-> Data Style
Style -> Constr
Style -> DataType
(forall b. Data b => b -> b) -> Style -> Style
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Style -> u
forall u. (forall d. Data d => d -> u) -> Style -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Style -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Style -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Style -> m Style
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Style -> m Style
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Style
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Style -> c Style
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Style)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Style)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Style -> c Style
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Style -> c Style
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Style
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Style
$ctoConstr :: Style -> Constr
toConstr :: Style -> Constr
$cdataTypeOf :: Style -> DataType
dataTypeOf :: Style -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Style)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Style)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Style)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Style)
$cgmapT :: (forall b. Data b => b -> b) -> Style -> Style
gmapT :: (forall b. Data b => b -> b) -> Style -> Style
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Style -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Style -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Style -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Style -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Style -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Style -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Style -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Style -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Style -> m Style
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Style -> m Style
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Style -> m Style
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Style -> m Style
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Style -> m Style
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Style -> m Style
Data, Typeable)

-- | Options for formatting source code.
data FormatOptions = FormatOptions{
         FormatOptions -> Bool
numberLines      :: Bool     -- ^ Number lines
       , FormatOptions -> Int
startNumber      :: Int      -- ^ Number of first line
       , FormatOptions -> Bool
lineAnchors      :: Bool     -- ^ Anchors on each line number
       , FormatOptions -> Bool
titleAttributes  :: Bool     -- ^ Html titles with token types
       , FormatOptions -> [String]
codeClasses      :: [String] -- ^ Additional classes for Html code tag
       , FormatOptions -> [String]
containerClasses :: [String] -- ^ Additional classes for Html container tag
                                      --   (pre or table depending on numberLines)
       } deriving (FormatOptions -> FormatOptions -> Bool
(FormatOptions -> FormatOptions -> Bool)
-> (FormatOptions -> FormatOptions -> Bool) -> Eq FormatOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FormatOptions -> FormatOptions -> Bool
== :: FormatOptions -> FormatOptions -> Bool
$c/= :: FormatOptions -> FormatOptions -> Bool
/= :: FormatOptions -> FormatOptions -> Bool
Eq, Int -> FormatOptions -> ShowS
[FormatOptions] -> ShowS
FormatOptions -> String
(Int -> FormatOptions -> ShowS)
-> (FormatOptions -> String)
-> ([FormatOptions] -> ShowS)
-> Show FormatOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FormatOptions -> ShowS
showsPrec :: Int -> FormatOptions -> ShowS
$cshow :: FormatOptions -> String
show :: FormatOptions -> String
$cshowList :: [FormatOptions] -> ShowS
showList :: [FormatOptions] -> ShowS
Show, ReadPrec [FormatOptions]
ReadPrec FormatOptions
Int -> ReadS FormatOptions
ReadS [FormatOptions]
(Int -> ReadS FormatOptions)
-> ReadS [FormatOptions]
-> ReadPrec FormatOptions
-> ReadPrec [FormatOptions]
-> Read FormatOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FormatOptions
readsPrec :: Int -> ReadS FormatOptions
$creadList :: ReadS [FormatOptions]
readList :: ReadS [FormatOptions]
$creadPrec :: ReadPrec FormatOptions
readPrec :: ReadPrec FormatOptions
$creadListPrec :: ReadPrec [FormatOptions]
readListPrec :: ReadPrec [FormatOptions]
Read)

defaultFormatOpts :: FormatOptions
defaultFormatOpts :: FormatOptions
defaultFormatOpts = FormatOptions{
                      numberLines :: Bool
numberLines = Bool
False
                    , startNumber :: Int
startNumber = Int
1
                    , lineAnchors :: Bool
lineAnchors = Bool
False
                    , titleAttributes :: Bool
titleAttributes = Bool
False
                    , codeClasses :: [String]
codeClasses = []
                    , containerClasses :: [String]
containerClasses = []
                    }