diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016-2018, John MacFarlane. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The names of the contributors may not be used to endorse or + promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +# skylighting-format-ansi + +This package provides functions to render syntax-highlighting +as ANSI text. + diff --git a/skylighting-format-blaze-html.cabal b/skylighting-format-blaze-html.cabal new file mode 100644 --- /dev/null +++ b/skylighting-format-blaze-html.cabal @@ -0,0 +1,37 @@ +name: skylighting-format-blaze-html +version: 0.1 +synopsis: HTML formatter for skylighting syntax highlighting library +description: This module allows tokens produced by skylighting-core + to be rendered as HTML. +homepage: https://github.com/jgm/skylighting +license: BSD3 +license-file: LICENSE +author: John MacFarlane +maintainer: jgm@berkeley.edu +copyright: (C) 2016-2022 John MacFarlane +category: Text +build-type: Simple +extra-source-files: README.md + +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/jgm/skylighting.git + +library + exposed-modules: Skylighting.Format.HTML + other-extensions: CPP + build-depends: base >= 4.8 && < 5.0, + skylighting-core, + text, + containers, + blaze-html >= 0.5 + hs-source-dirs: src + ghc-prof-options: -fprof-auto-exported + default-language: Haskell2010 + ghc-options: -Wall + if impl(ghc >= 8.4) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages diff --git a/src/Skylighting/Format/HTML.hs b/src/Skylighting/Format/HTML.hs new file mode 100644 --- /dev/null +++ b/src/Skylighting/Format/HTML.hs @@ -0,0 +1,216 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoOverloadedStrings #-} +module Skylighting.Format.HTML ( + formatHtmlInline + , formatHtmlBlock + , styleToCss + ) where + +import Data.List (intersperse, sort) +import qualified Data.Map as Map +import qualified Data.Text as Text +import Skylighting.Types +import Text.Blaze.Html +import qualified Text.Blaze.Html5 as H +import qualified Text.Blaze.Html5.Attributes as A +import Data.String (fromString) +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup +#endif + +-- | Format tokens using HTML spans inside @code@ tags. For example, +-- A @KeywordTok@ is rendered as a span with class @kw@. +-- Short class names correspond to 'TokenType's as follows: +-- 'KeywordTok' = @kw@, +-- 'DataTypeTok' = @dt@, +-- 'DecValTok' = @dv@, +-- 'BaseNTok' = @bn@, +-- 'FloatTok' = @fl@, +-- 'CharTok' = @ch@, +-- 'StringTok' = @st@, +-- 'CommentTok' = @co@, +-- 'OtherTok' = @ot@, +-- 'AlertTok' = @al@, +-- 'FunctionTok' = @fu@, +-- 'RegionMarkerTok' = @re@, +-- 'ErrorTok' = @er@, +-- 'ConstantTok' = @cn@, +-- 'SpecialCharTok' = @sc@, +-- 'VerbatimStringTok' = @vs@, +-- 'SpecialStringTok' = @ss@, +-- 'ImportTok' = @im@, +-- 'DocumentationTok' = @do@, +-- 'AnnotationTok' = @an@, +-- 'CommentVarTok' = @cv@, +-- 'VariableTok' = @va@, +-- 'ControlFlowTok' = @cf@, +-- 'OperatorTok' = @op@, +-- 'BuiltInTok' = @bu@, +-- 'ExtensionTok' = @ex@, +-- 'PreprocessorTok' = @pp@, +-- 'AttributeTok' = @at@, +-- 'InformationTok' = @in@, +-- 'WarningTok' = @wa@. +-- A 'NormalTok' is not marked up at all. +formatHtmlInline :: FormatOptions -> [SourceLine] -> Html +formatHtmlInline opts = wrapCode opts + . mconcat . intersperse (toHtml "\n") + . map (mapM_ (tokenToHtml opts)) + +-- | Format tokens as an HTML @pre@ block. Each line is wrapped in an a +-- element with the class ‘source-line’. If line numbering +-- is selected, the surrounding pre is given the class ‘numberSource’, +-- and the resulting html will display line numbers thanks to the included +-- CSS. See the documentation for 'formatHtmlInline' for information about how +-- tokens are encoded. +formatHtmlBlock :: FormatOptions -> [SourceLine] -> Html +formatHtmlBlock opts ls = + H.div ! A.class_ (toValue "sourceCode") $ + H.pre ! A.class_ (toValue $ Text.unwords classes) + $ wrapCode opts + $ mconcat . intersperse (toHtml "\n") + $ zipWith (sourceLineToHtml opts) [startNum..] ls + where classes = Text.pack "sourceCode" : + [Text.pack "numberSource" | numberLines opts] ++ + [x | x <- containerClasses opts + , x /= Text.pack "sourceCode"] + startNum = LineNo $ startNumber opts + +wrapCode :: FormatOptions -> Html -> Html +wrapCode opts h = H.code ! A.class_ (toValue $ Text.unwords + $ Text.pack "sourceCode" + : codeClasses opts) + !? (startZero /= 0, A.style (toValue counterOverride)) + $ h + where counterOverride = "counter-reset: source-line " <> show startZero <> ";" + startZero = startNumber opts - 1 + +-- | Each line of source is wrapped in an (inline-block) anchor that makes +-- subsequent per-line processing (e.g. adding line numnbers) possible. +sourceLineToHtml :: FormatOptions -> LineNo -> SourceLine -> Html +sourceLineToHtml opts lno cont = + H.span ! A.id lineNum + $ do + H.a ! A.href lineRef + ! (if numberLines opts + then mempty + else customAttribute (fromString "aria-hidden") + (fromString "true")) -- see jgm/pandoc#6352 + ! (if numberLines opts + then mempty + else customAttribute (fromString "tabindex") + (fromString "-1")) + $ mempty + mapM_ (tokenToHtml opts) cont + where lineNum = toValue prefixedLineNo + lineRef = toValue ('#':prefixedLineNo) + prefixedLineNo = Text.unpack (lineIdPrefix opts) <> show (lineNo lno) + +tokenToHtml :: FormatOptions -> Token -> Html +tokenToHtml _ (NormalTok, txt) = toHtml txt +tokenToHtml opts (toktype, txt) = + if titleAttributes opts + then sp ! A.title (toValue $ show toktype) + else sp + where sp = H.span ! A.class_ (toValue $ short toktype) $ toHtml txt + +short :: TokenType -> String +short KeywordTok = "kw" +short DataTypeTok = "dt" +short DecValTok = "dv" +short BaseNTok = "bn" +short FloatTok = "fl" +short CharTok = "ch" +short StringTok = "st" +short CommentTok = "co" +short OtherTok = "ot" +short AlertTok = "al" +short FunctionTok = "fu" +short RegionMarkerTok = "re" +short ErrorTok = "er" +short ConstantTok = "cn" +short SpecialCharTok = "sc" +short VerbatimStringTok = "vs" +short SpecialStringTok = "ss" +short ImportTok = "im" +short DocumentationTok = "do" +short AnnotationTok = "an" +short CommentVarTok = "cv" +short VariableTok = "va" +short ControlFlowTok = "cf" +short OperatorTok = "op" +short BuiltInTok = "bu" +short ExtensionTok = "ex" +short PreprocessorTok = "pp" +short AttributeTok = "at" +short InformationTok = "in" +short WarningTok = "wa" +short NormalTok = "" + +-- | Returns CSS for styling highlighted code according to the given style. +styleToCss :: Style -> String +styleToCss f = unlines $ + divspec ++ numberspec ++ colorspec ++ linkspec ++ + sort (map toCss (Map.toList (tokenStyles f))) + where colorspec = pure . unwords $ [ + "div.sourceCode\n {" + , maybe "" (\c -> "color: " ++ fromColor c ++ ";") (defaultColor f) + , maybe "" (\c -> "background-color: " ++ fromColor c ++ ";") (backgroundColor f) + , "}" + ] + numberspec = [ + "pre.numberSource code" + , " { counter-reset: source-line 0; }" + , "pre.numberSource code > span" + , " { position: relative; left: -4em; counter-increment: source-line; }" + , "pre.numberSource code > span > a:first-child::before" + , " { content: counter(source-line);" + , " position: relative; left: -1em; text-align: right; vertical-align: baseline;" + , " border: none; display: inline-block;" + , " -webkit-touch-callout: none; -webkit-user-select: none;" + , " -khtml-user-select: none; -moz-user-select: none;" + , " -ms-user-select: none; user-select: none;" + , " padding: 0 4px; width: 4em;" + , maybe "" (\c -> " background-color: " ++ fromColor c ++ ";\n") + (lineNumberBackgroundColor f) ++ + maybe "" (\c -> " color: " ++ fromColor c ++ ";\n") + (lineNumberColor f) ++ + " }" + , "pre.numberSource { margin-left: 3em; " ++ + maybe "" (\c -> "border-left: 1px solid " ++ fromColor c ++ "; ") (lineNumberColor f) ++ + " padding-left: 4px; }" + ] + divspec = [ + "pre > code.sourceCode { white-space: pre; position: relative; }" -- position relative needed for relative contents + , "pre > code.sourceCode > span { display: inline-block; line-height: 1.25; }" + , "pre > code.sourceCode > span:empty { height: 1.2em; }" -- correct empty line height + , ".sourceCode { overflow: visible; }" -- needed for line numbers + , "code.sourceCode > span { color: inherit; text-decoration: inherit; }" + , "div.sourceCode { margin: 1em 0; }" -- Collapse neighbours correctly + , "pre.sourceCode { margin: 0; }" -- Collapse neighbours correctly + , "@media screen {" + , "div.sourceCode { overflow: auto; }" -- do not overflow on screen + , "}" + , "@media print {" + , "pre > code.sourceCode { white-space: pre-wrap; }" + , "pre > code.sourceCode > span { text-indent: -5em; padding-left: 5em; }" + , "}" + ] + linkspec = [ "@media screen {" + , "pre > code.sourceCode > span > a:first-child::before { text-decoration: underline; }" + , "}" + ] + +toCss :: (TokenType, TokenStyle) -> String +toCss (t,tf) = "code span" ++ (if null (short t) then "" else ('.' : short t)) ++ " { " + ++ colorspec ++ backgroundspec ++ weightspec ++ stylespec + ++ decorationspec ++ "} /* " ++ showTokenType t ++ " */" + where colorspec = maybe "" (\col -> "color: " ++ fromColor col ++ "; ") $ tokenColor tf + backgroundspec = maybe "" (\col -> "background-color: " ++ fromColor col ++ "; ") $ tokenBackground tf + weightspec = if tokenBold tf then "font-weight: bold; " else "" + stylespec = if tokenItalic tf then "font-style: italic; " else "" + decorationspec = if tokenUnderline tf then "text-decoration: underline; " else "" + showTokenType t' = case reverse (show t') of + 'k':'o':'T':xs -> reverse xs + _ -> "" +