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

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

    -- | Formats Haskell source code as a complete HTML document with inline styling
    hscolour :: ColourPrefs	-- ^ Preferences for styling.
             -> 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 :: ColourPrefs -> Bool -> Int -> String -> String
    hscolour ColourPrefs
    prefs 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 (ColourPrefs -> (TokenType, String) -> String
    renderToken ColourPrefs
    prefs))
                 ([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 (ColourPrefs -> (TokenType, String) -> String
    renderToken ColourPrefs
    prefs))
      ([(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 style=\"font-family:Consolas, Monaco, Monospace;\">"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 :: ColourPrefs -> (TokenType,String) -> String
    renderToken :: ColourPrefs -> (TokenType, String) -> String
    renderToken ColourPrefs
    prefs (TokenType
    cls,String
    text) =
      [Highlight] -> String -> String
    stylise (ColourPrefs -> TokenType -> [Highlight]
    colourise ColourPrefs
    prefs TokenType
    cls) (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
      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

    stylise :: [Highlight] -> String -> String
    stylise :: [Highlight] -> String -> String
    stylise [Highlight]
    hs String
    s = String
    "<span style=\"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Highlight -> String) -> [Highlight] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Highlight -> String
    style [Highlight]
    hs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\">" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    sString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "</span>"

    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
    "</head>"
        ,String
    "<body style=\"background-color: #131313; color: #ffffff;\">"
        ]

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

    style :: Highlight -> String
    style :: Highlight -> String
    style Highlight
    Normal         = String
    ""
    style Highlight
    Bold           = String
    "font-weight: bold;"
    style Highlight
    Dim            = String
    "font-weight: lighter;"
    style Highlight
    Underscore     = String
    "text-decoration: underline;"
    style Highlight
    Blink          = String
    "text-decoration:  blink;"
    style Highlight
    ReverseVideo   = String
    ""
    style Highlight
    Concealed      = String
    "text-decoration:  line-through;"
    style (Foreground Colour
    c) = String
    "color: "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Colour -> String
    csscolour Colour
    cString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ";"
    style (Background Colour
    c) = String
    "background-color: "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Colour -> String
    csscolour Colour
    cString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ";"
    style Highlight
    Italic         = String
    "font-style: italic;"

    csscolour :: Colour -> String
    csscolour :: Colour -> String
    csscolour Colour
    Black   = String
    "#000000"
    csscolour Colour
    Red     = String
    "#ff0000"
    csscolour Colour
    Green   = String
    "#00ff00"
    csscolour Colour
    Yellow  = String
    "#ffff00"
    csscolour Colour
    Blue    = String
    "#0000ff"
    csscolour Colour
    Magenta = String
    "#ff00ff"
    csscolour Colour
    Cyan    = String
    "#00ffff"
    csscolour Colour
    White   = String
    "#ffffff"
    csscolour (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