    -- | Formats Haskell source code as HTML with CSS.
    module Language.Haskell.HsColour.CSS
      ( hscolour
      , top'n'tail
      , renderToken
      , pre
      ) where

    import Language.Haskell.HsColour.Anchors
    import Language.Haskell.HsColour.Classify as Classify
    import Language.Haskell.HsColour.HTML (renderAnchors, renderComment,
                                           renderNewLinesAnchors, escape)

    -- | Formats Haskell source code as a complete HTML document with CSS.
    hscolour :: Bool   -- ^ Whether to include anchors.
             -> Int    -- ^ Starting line number (for line anchors).
             -> String -- ^ Haskell source code.
             -> String -- ^ An HTML document containing the coloured
                       --   Haskell source code.
    hscolour :: Bool -> Int -> String -> String
    hscolour Bool
    anchor Int
    n =
      String -> String
    pre
      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    anchor
            then Int -> String -> String
    renderNewLinesAnchors Int
    n
                 (String -> String)
    -> ([(TokenType, String)] -> String)
    -> [(TokenType, String)]
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Either String (TokenType, String) -> String)
    -> [Either String (TokenType, String)] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (((TokenType, String) -> String)
    -> Either String (TokenType, String) -> String
    forall a. (a -> String) -> Either String a -> String
    renderAnchors (TokenType, String) -> String
    renderToken)
                 ([Either String (TokenType, String)] -> String)
    -> ([(TokenType, String)] -> [Either String (TokenType, String)])
    -> [(TokenType, String)]
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(TokenType, String)] -> [Either String (TokenType, String)]
    insertAnchors
            else ((TokenType, String) -> String) -> [(TokenType, String)] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (TokenType, String) -> String
    renderToken)
      ([(TokenType, String)] -> String)
    -> (String -> [(TokenType, String)]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [(TokenType, String)]
    tokenise

    top'n'tail :: String -> String -> String
    top'n'tail :: String -> String -> String
    top'n'tail String
    title  = (String -> String
    cssPrefix String
    title String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    cssSuffix)

    pre :: String -> String
    pre :: String -> String
    pre = (String
    "<pre>"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "</pre>")

    renderToken :: (TokenType,String) -> String
    renderToken :: (TokenType, String) -> String
    renderToken (TokenType
    cls,String
    text) =
            String
    before String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (if TokenType
    cls TokenType -> TokenType -> Bool
    forall a. Eq a => a -> a -> Bool
    == TokenType
    Comment then String -> String
    renderComment String
    text else String -> String
    escape String
    text) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    after
        where
            before :: String
    before = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    cls2 then String
    "" else String
    "<span class='" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cls2 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'>"
            after :: String
    after  = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    cls2 then String
    "" else String
    "</span>"
            cls2 :: String
    cls2 = TokenType -> String
    cssClass TokenType
    cls

    cssClass :: TokenType -> String
    cssClass TokenType
    Keyword  = String
    "hs-keyword"
    cssClass TokenType
    Keyglyph = String
    "hs-keyglyph"
    cssClass TokenType
    Layout   = String
    "hs-layout"
    cssClass TokenType
    Comment  = String
    "hs-comment"
    cssClass TokenType
    Conid    = String
    "hs-conid"
    cssClass TokenType
    Varid    = String
    "hs-varid"
    cssClass TokenType
    Conop    = String
    "hs-conop"
    cssClass TokenType
    Varop    = String
    "hs-varop"
    cssClass TokenType
    String   = String
    "hs-str"
    cssClass TokenType
    Char     = String
    "hs-chr"
    cssClass TokenType
    Number   = String
    "hs-num"
    cssClass TokenType
    Cpp      = String
    "hs-cpp"
    cssClass TokenType
    Error    = String
    "hs-sel"
    cssClass TokenType
    Definition = String
    "hs-definition"
    cssClass TokenType
    _        = String
    ""

    cssPrefix :: String -> String
    cssPrefix String
    title = [String] -> String
    unlines
        [String
    "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
        ,String
    "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
        ,String
    "<html>"
        ,String
    "<head>"
        ,String
    "<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->"
        ,String
    "<title>"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    titleString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "</title>"
        ,String
    "<link type='text/css' rel='stylesheet' href='hscolour.css' />"
        ,String
    "</head>"
        ,String
    "<body>"
        ]

    cssSuffix :: String
    cssSuffix = [String] -> String
    unlines
        [String
    "</body>"
        ,String
    "</html>"
        ]