    -- | This is a library which colourises Haskell code.
    --   It currently has six output formats:
    --
    -- * ANSI terminal codes
    --
    -- * LaTeX macros
    --
    -- * HTML 3.2 with font tags
    --
    -- * HTML 4.01 with external CSS.
    --
    -- * XHTML 1.0 with internal CSS.
    --
    -- * mIRC chat client colour codes.
    --
    module Language.Haskell.HsColour (Output(..), ColourPrefs(..),
                                      hscolour) where

    import Language.Haskell.HsColour.Colourise  (ColourPrefs(..))
    import qualified Language.Haskell.HsColour.TTY        as TTY
    import qualified Language.Haskell.HsColour.HTML       as HTML
    import qualified Language.Haskell.HsColour.CSS        as CSS
    import qualified Language.Haskell.HsColour.ACSS       as ACSS
    import qualified Language.Haskell.HsColour.InlineCSS  as ICSS
    import qualified Language.Haskell.HsColour.LaTeX      as LaTeX
    import qualified Language.Haskell.HsColour.MIRC       as MIRC
    import Data.List(mapAccumL, isPrefixOf)
    import Data.Maybe
    import Language.Haskell.HsColour.Output
    --import Debug.Trace

    -- | Colourise Haskell source code with the given output format.
    hscolour :: Output      -- ^ Output format.
             -> ColourPrefs -- ^ Colour preferences (for formats that support them).
             -> Bool        -- ^ Whether to include anchors.
             -> Bool        -- ^ Whether output document is partial or complete.
             -> String	-- ^ Title for output.
             -> Bool        -- ^ Whether input document is literate haskell or not
             -> String      -- ^ Haskell source code.
             -> String      -- ^ Coloured Haskell source code.
    hscolour :: Output
    -> ColourPrefs
    -> Bool
    -> Bool
    -> String
    -> Bool
    -> String
    -> String
    hscolour Output
    output ColourPrefs
    pref Bool
    anchor Bool
    partial String
    title Bool
    False =
            (if Bool
    partial then String -> String
    forall a. a -> a
    id else Output -> String -> String -> String
    top'n'tail Output
    output String
    title) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
            Output -> ColourPrefs -> Bool -> Int -> String -> String
    hscolour' Output
    output ColourPrefs
    pref Bool
    anchor Int
    1
    hscolour Output
    output ColourPrefs
    pref Bool
    anchor Bool
    partial String
    title Bool
    True  =
            (if Bool
    partial then String -> String
    forall a. a -> a
    id else Output -> String -> String -> String
    top'n'tail Output
    output String
    title) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
            [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Lit] -> [String]
    chunk Int
    1 ([Lit] -> [String]) -> (String -> [Lit]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Lit] -> [Lit]
    joinL ([Lit] -> [Lit]) -> (String -> [Lit]) -> String -> [Lit]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [Lit]
    classify ([String] -> [Lit]) -> (String -> [String]) -> String -> [Lit]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    inlines
      where
        chunk :: Int -> [Lit] -> [String]
    chunk Int
    _        []     = []
        chunk Int
    n (Code String
    c: [Lit]
    cs)  = Output -> ColourPrefs -> Bool -> Int -> String -> String
    hscolour' Output
    output ColourPrefs
    pref Bool
    anchor Int
    n String
    c
                                  String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : Int -> [Lit] -> [String]
    chunk (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> [String]
    lines String
    c)) [Lit]
    cs
        chunk Int
    n (Lit String
    c:  [Lit]
    cs)  = String
    c String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : Int -> [Lit] -> [String]
    chunk Int
    n [Lit]
    cs

    -- | The actual colourising worker, despatched on the chosen output format.
    hscolour' :: Output      -- ^ Output format.
              -> ColourPrefs -- ^ Colour preferences (for formats that support them)
              -> Bool        -- ^ Whether to include anchors.
              -> Int         -- ^ Starting line number (for line anchors)
              -> String      -- ^ Haskell source code.
              -> String      -- ^ Coloured Haskell source code.
    hscolour' :: Output -> ColourPrefs -> Bool -> Int -> String -> String
    hscolour' Output
    TTY       ColourPrefs
    pref Bool
    _      Int
    _ = ColourPrefs -> String -> String
    TTY.hscolour     ColourPrefs
    pref
    hscolour' (TTYg TerminalType
    tt) ColourPrefs
    pref Bool
    _      Int
    _ = TerminalType -> ColourPrefs -> String -> String
    TTY.hscolourG TerminalType
    tt ColourPrefs
    pref
    hscolour' Output
    MIRC      ColourPrefs
    pref Bool
    _      Int
    _ = ColourPrefs -> String -> String
    MIRC.hscolour    ColourPrefs
    pref
    hscolour' Output
    LaTeX     ColourPrefs
    pref Bool
    _      Int
    _ = ColourPrefs -> String -> String
    LaTeX.hscolour   ColourPrefs
    pref
    hscolour' Output
    HTML      ColourPrefs
    pref Bool
    anchor Int
    n = ColourPrefs -> Bool -> Int -> String -> String
    HTML.hscolour    ColourPrefs
    pref Bool
    anchor Int
    n
    hscolour' Output
    CSS       ColourPrefs
    _    Bool
    anchor Int
    n = Bool -> Int -> String -> String
    CSS.hscolour          Bool
    anchor Int
    n
    hscolour' Output
    ICSS      ColourPrefs
    pref Bool
    anchor Int
    n = ColourPrefs -> Bool -> Int -> String -> String
    ICSS.hscolour    ColourPrefs
    pref Bool
    anchor Int
    n
    hscolour' Output
    ACSS      ColourPrefs
    _    Bool
    anchor Int
    n = Bool -> Int -> String -> String
    ACSS.hscolour         Bool
    anchor Int
    n

    -- | Choose the right headers\/footers, depending on the output format.
    top'n'tail :: Output           -- ^ Output format
               -> String           -- ^ Title for output
               -> (String->String) -- ^ Output transformer
    top'n'tail :: Output -> String -> String -> String
    top'n'tail Output
    TTY   String
    _     = String -> String
    forall a. a -> a
    id
    top'n'tail (TTYg TerminalType
    _) String
    _  = String -> String
    forall a. a -> a
    id
    top'n'tail Output
    MIRC  String
    _     = String -> String
    forall a. a -> a
    id
    top'n'tail Output
    LaTeX String
    title = String -> String -> String
    LaTeX.top'n'tail String
    title
    top'n'tail Output
    HTML  String
    title = String -> String -> String
    HTML.top'n'tail String
    title
    top'n'tail Output
    CSS   String
    title = String -> String -> String
    CSS.top'n'tail  String
    title
    top'n'tail Output
    ICSS  String
    title = String -> String -> String
    ICSS.top'n'tail String
    title
    top'n'tail Output
    ACSS  String
    title = String -> String -> String
    CSS.top'n'tail  String
    title

    -- | Separating literate files into code\/comment chunks.
    data Lit = Code {Lit -> String
    unL :: String} | Lit {unL :: String} deriving (Int -> Lit -> String -> String
    [Lit] -> String -> String
    Lit -> String
    (Int -> Lit -> String -> String)
    -> (Lit -> String) -> ([Lit] -> String -> String) -> Show Lit
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Lit -> String -> String
    showsPrec :: Int -> Lit -> String -> String
    $cshow :: Lit -> String
    show :: Lit -> String
    $cshowList :: [Lit] -> String -> String
    showList :: [Lit] -> String -> String
    Show)

    -- Re-implementation of 'lines', for better efficiency (but decreased laziness).
    -- Also, importantly, accepts non-standard DOS and Mac line ending characters.
    -- And retains the trailing '\n' character in each resultant string.
    inlines :: String -> [String]
    inlines :: String -> [String]
    inlines String
    s = String -> (String -> String) -> [String]
    lines' String
    s String -> String
    forall a. a -> a
    id
      where
      lines' :: String -> (String -> String) -> [String]
    lines' []             String -> String
    acc = [String -> String
    acc []]
      lines' (Char
    '\^M':Char
    '\n':String
    s) String -> String
    acc = String -> String
    acc [Char
    '\n'] String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> (String -> String) -> [String]
    lines' String
    s String -> String
    forall a. a -> a
    id	-- DOS
    --lines' ('\^M':s)      acc = acc ['\n'] : lines' s id	-- MacOS
      lines' (Char
    '\n':String
    s)       String -> String
    acc = String -> String
    acc [Char
    '\n'] String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> (String -> String) -> [String]
    lines' String
    s String -> String
    forall a. a -> a
    id	-- Unix
      lines' (Char
    c:String
    s)          String -> String
    acc = String -> (String -> String) -> [String]
    lines' String
    s (String -> String
    acc (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :))

    -- | The code for classify is largely stolen from Language.Preprocessor.Unlit.
    classify ::  [String] -> [Lit]
    classify :: [String] -> [Lit]
    classify []             = []
    classify (String
    x:[String]
    xs) | String
    "\\begin{code}"String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`String
    x
                            = String -> Lit
    Lit String
    xLit -> [Lit] -> [Lit]
    forall a. a -> [a] -> [a]
    : String -> [String] -> [Lit]
    allProg String
    "code" [String]
    xs
    classify (String
    x:[String]
    xs) | String
    "\\begin{spec}"String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`String
    x
                            = String -> Lit
    Lit String
    xLit -> [Lit] -> [Lit]
    forall a. a -> [a] -> [a]
    : String -> [String] -> [Lit]
    allProg String
    "spec" [String]
    xs
    classify ((Char
    '>':String
    x):[String]
    xs)   = String -> Lit
    Code (Char
    '>'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    x) Lit -> [Lit] -> [Lit]
    forall a. a -> [a] -> [a]
    : [String] -> [Lit]
    classify [String]
    xs
    classify (String
    x:[String]
    xs)         = String -> Lit
    Lit String
    xLit -> [Lit] -> [Lit]
    forall a. a -> [a] -> [a]
    : [String] -> [Lit]
    classify [String]
    xs

    allProg :: String -> [String] -> [Lit]
    allProg String
    name  = [String] -> [Lit]
    go
      where
        end :: String
    end       = String
    "\\end{" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "}"
        go :: [String] -> [Lit]
    go []     = []  -- Should give an error message,
                        -- but I have no good position information.
        go (String
    x:[String]
    xs) | String
    end `isPrefixOf `String
    x
                  = String -> Lit
    Lit String
    xLit -> [Lit] -> [Lit]
    forall a. a -> [a] -> [a]
    : [String] -> [Lit]
    classify [String]
    xs
        go (String
    x:[String]
    xs) = String -> Lit
    Code String
    xLit -> [Lit] -> [Lit]
    forall a. a -> [a] -> [a]
    : [String] -> [Lit]
    go [String]
    xs

    -- | Join up chunks of code\/comment that are next to each other.
    joinL :: [Lit] -> [Lit]
    joinL :: [Lit] -> [Lit]
    joinL []                  = []
    joinL (Code String
    c:Code String
    c2:[Lit]
    xs) = [Lit] -> [Lit]
    joinL (String -> Lit
    Code (String
    cString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    c2)Lit -> [Lit] -> [Lit]
    forall a. a -> [a] -> [a]
    :[Lit]
    xs)
    joinL (Lit String
    c :Lit String
    c2 :[Lit]
    xs) = [Lit] -> [Lit]
    joinL (String -> Lit
    Lit  (String
    cString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    c2)Lit -> [Lit] -> [Lit]
    forall a. a -> [a] -> [a]
    :[Lit]
    xs)
    joinL (Lit
    any:[Lit]
    xs)            = Lit
    anyLit -> [Lit] -> [Lit]
    forall a. a -> [a] -> [a]
    : [Lit] -> [Lit]
    joinL [Lit]
    xs