{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Highlighting
   Copyright   : Copyright (C) 2008-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Exports functions for syntax highlighting.
-}

module Text.Pandoc.Highlighting ( highlightingStyles
                                , languages
                                , languagesByExtension
                                , highlight
                                -- * Formats
                                -- ** LaTeX
                                , formatLaTeXInline
                                , formatLaTeXBlock
                                , styleToLaTeX
                                -- ** HTML
                                , formatHtmlInline
                                , formatHtmlBlock
                                , formatHtml4Block
                                , styleToCss
                                -- ** ConTeXt
                                , formatConTeXtInline
                                , formatConTeXtBlock
                                , styleToConTeXt
                                -- * Styles
                                , pygments
                                , espresso
                                , zenburn
                                , tango
                                , kate
                                , monochrome
                                , breezeDark
                                , haddock
                                , Style
                                , lookupHighlightingStyle
                                , fromListingsLanguage
                                , toListingsLanguage
                                ) where
import Control.Monad
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Skylighting
import Text.Pandoc.Definition
import Text.Pandoc.Class (PandocMonad, readFileLazy)
import Text.Pandoc.Error (PandocError(..))
import Control.Monad.Except (throwError)
import System.FilePath (takeExtension)
import Text.Pandoc.Shared (safeRead)

highlightingStyles :: [(T.Text, Style)]
highlightingStyles :: [(Text, Style)]
highlightingStyles =
  [(Text
"pygments", Style
pygments),
   (Text
"tango", Style
tango),
   (Text
"espresso", Style
espresso),
   (Text
"zenburn", Style
zenburn),
   (Text
"kate", Style
kate),
   (Text
"monochrome", Style
monochrome),
   (Text
"breezedark", Style
breezeDark),
   (Text
"haddock", Style
haddock)]

languages :: SyntaxMap -> [T.Text]
languages :: SyntaxMap -> [Text]
languages SyntaxMap
syntaxmap = [Text -> Text
T.toLower (Syntax -> Text
sName Syntax
s) | Syntax
s <- forall k a. Map k a -> [a]
M.elems SyntaxMap
syntaxmap]

languagesByExtension :: SyntaxMap -> T.Text -> [T.Text]
languagesByExtension :: SyntaxMap -> Text -> [Text]
languagesByExtension SyntaxMap
syntaxmap Text
ext =
  [Text -> Text
T.toLower (Syntax -> Text
sName Syntax
s) | Syntax
s <- SyntaxMap -> String -> [Syntax]
syntaxesByExtension SyntaxMap
syntaxmap (Text -> String
T.unpack Text
ext)]

highlight :: SyntaxMap
          -> (FormatOptions -> [SourceLine] -> a) -- ^ Formatter
          -> Attr   -- ^ Attributes of the CodeBlock
          -> T.Text -- ^ Raw contents of the CodeBlock
          -> Either T.Text a
highlight :: forall a.
SyntaxMap
-> (FormatOptions -> [SourceLine] -> a)
-> Attr
-> Text
-> Either Text a
highlight SyntaxMap
syntaxmap FormatOptions -> [SourceLine] -> a
formatter (Text
ident, [Text]
classes, [(Text, Text)]
keyvals) Text
rawCode =
  let firstNum :: Int
firstNum = forall a. a -> Maybe a -> a
fromMaybe Int
1 (forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (forall a. a -> Maybe a -> a
fromMaybe Text
"1" forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"startFrom" [(Text, Text)]
keyvals))
      fmtOpts :: FormatOptions
fmtOpts = FormatOptions
defaultFormatOpts{
                  startNumber :: Int
startNumber = Int
firstNum,
                  lineAnchors :: Bool
lineAnchors = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
                        [Text
"line-anchors", Text
"lineAnchors"]) [Text]
classes,
                  numberLines :: Bool
numberLines = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
                        [Text
"number",Text
"numberLines", Text
"number-lines"]) [Text]
classes,
                  lineIdPrefix :: Text
lineIdPrefix = if Text -> Bool
T.null Text
ident
                                    then forall a. Monoid a => a
mempty
                                    else Text
ident forall a. Semigroup a => a -> a -> a
<> Text
"-" }
      tokenizeOpts :: TokenizerConfig
tokenizeOpts = TokenizerConfig{ syntaxMap :: SyntaxMap
syntaxMap = SyntaxMap
syntaxmap
                                    , traceOutput :: Bool
traceOutput = Bool
False }
  in  case forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (forall a b. (a -> b) -> [a] -> [b]
map (Text -> SyntaxMap -> Maybe Syntax
`lookupSyntax` SyntaxMap
syntaxmap) [Text]
classes) of
            Maybe Syntax
Nothing
              | FormatOptions -> Bool
numberLines FormatOptions
fmtOpts -> forall a b. b -> Either a b
Right
                              forall a b. (a -> b) -> a -> b
$ FormatOptions -> [SourceLine] -> a
formatter FormatOptions
fmtOpts{ codeClasses :: [Text]
codeClasses = [],
                                                   containerClasses :: [Text]
containerClasses = [Text]
classes }
                              forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Text
ln -> [(TokenType
NormalTok, Text
ln)])
                              forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
rawCode
              | Bool
otherwise  -> forall a b. a -> Either a b
Left Text
""
            Just Syntax
syntax  -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
              FormatOptions -> [SourceLine] -> a
formatter FormatOptions
fmtOpts{ codeClasses :: [Text]
codeClasses =
                                   [Text -> Text
T.toLower (Syntax -> Text
sShortname Syntax
syntax)],
                                  containerClasses :: [Text]
containerClasses = [Text]
classes } forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                TokenizerConfig -> Syntax -> Text -> Either String [SourceLine]
tokenize TokenizerConfig
tokenizeOpts Syntax
syntax Text
rawCode

-- Functions for correlating latex listings package's language names
-- with skylighting language names:

langToListingsMap :: M.Map T.Text T.Text
langToListingsMap :: Map Text Text
langToListingsMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Text)]
langsList

listingsToLangMap :: M.Map T.Text T.Text
listingsToLangMap :: Map Text Text
listingsToLangMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. (b, a) -> (a, b)
switch [(Text, Text)]
langsList
  where switch :: (b, a) -> (a, b)
switch (b
a,a
b) = (a
b,b
a)

langsList :: [(T.Text, T.Text)]
langsList :: [(Text, Text)]
langsList =
  [(Text
"abap",Text
"ABAP"),
  (Text
"acm",Text
"ACM"),
  (Text
"acmscript",Text
"ACMscript"),
  (Text
"acsl",Text
"ACSL"),
  (Text
"ada",Text
"Ada"),
  (Text
"algol",Text
"Algol"),
  (Text
"ant",Text
"Ant"),
  (Text
"assembler",Text
"Assembler"),
  (Text
"gnuassembler",Text
"Assembler"),
  (Text
"awk",Text
"Awk"),
  (Text
"bash",Text
"bash"),
  (Text
"monobasic",Text
"Basic"),
  (Text
"purebasic",Text
"Basic"),
  (Text
"c",Text
"C"),
  (Text
"cs",Text
"C"),
  (Text
"objectivec",Text
"C"),
  (Text
"cpp",Text
"C++"),
  (Text
"c++",Text
"C++"),
  (Text
"ocaml",Text
"Caml"),
  (Text
"cil",Text
"CIL"),
  (Text
"clean",Text
"Clean"),
  (Text
"cobol",Text
"Cobol"),
  (Text
"comal80",Text
"Comal80"),
  (Text
"command.com",Text
"command.com"),
  (Text
"comsol",Text
"Comsol"),
  (Text
"csh",Text
"csh"),
  (Text
"delphi",Text
"Delphi"),
  (Text
"eiffel",Text
"Eiffel"),
  (Text
"elan",Text
"Elan"),
  (Text
"elisp",Text
"elisp"),
  (Text
"erlang",Text
"erlang"),
  (Text
"euphoria",Text
"Euphoria"),
  (Text
"fortran",Text
"Fortran"),
  (Text
"gap",Text
"GAP"),
  (Text
"gcl",Text
"GCL"),
  (Text
"gnuplot",Text
"Gnuplot"),
  (Text
"go",Text
"Go"),
  (Text
"hansl",Text
"hansl"),
  (Text
"haskell",Text
"Haskell"),
  (Text
"html",Text
"HTML"),
  (Text
"idl",Text
"IDL"),
  (Text
"inform",Text
"inform"),
  (Text
"java",Text
"Java"),
  (Text
"jvmis",Text
"JVMIS"),
  (Text
"ksh",Text
"ksh"),
  (Text
"lingo",Text
"Lingo"),
  (Text
"lisp",Text
"Lisp"),
  (Text
"commonlisp",Text
"Lisp"),
  (Text
"llvm",Text
"LLVM"),
  (Text
"logo",Text
"Logo"),
  (Text
"lua",Text
"Lua"),
  (Text
"make",Text
"make"),
  (Text
"makefile",Text
"make"),
  (Text
"mathematica",Text
"Mathematica"),
  (Text
"matlab",Text
"Matlab"),
  (Text
"mercury",Text
"Mercury"),
  (Text
"metapost",Text
"MetaPost"),
  (Text
"miranda",Text
"Miranda"),
  (Text
"mizar",Text
"Mizar"),
  (Text
"ml",Text
"ML"),
  (Text
"modula2",Text
"Modula-2"),
  (Text
"mupad",Text
"MuPAD"),
  (Text
"nastran",Text
"NASTRAN"),
  (Text
"oberon2",Text
"Oberon-2"),
  (Text
"ocl",Text
"OCL"),
  (Text
"octave",Text
"Octave"),
  (Text
"oorexx",Text
"OORexx"),
  (Text
"oz",Text
"Oz"),
  (Text
"pascal",Text
"Pascal"),
  (Text
"perl",Text
"Perl"),
  (Text
"php",Text
"PHP"),
  (Text
"pli",Text
"PL/I"),
  (Text
"plasm",Text
"Plasm"),
  (Text
"postscript",Text
"PostScript"),
  (Text
"pov",Text
"POV"),
  (Text
"prolog",Text
"Prolog"),
  (Text
"promela",Text
"Promela"),
  (Text
"pstricks",Text
"PSTricks"),
  (Text
"python",Text
"Python"),
  (Text
"r",Text
"R"),
  (Text
"reduce",Text
"Reduce"),
  (Text
"rexx",Text
"Rexx"),
  (Text
"rsl",Text
"RSL"),
  (Text
"ruby",Text
"Ruby"),
  (Text
"s",Text
"S"),
  (Text
"sas",Text
"SAS"),
  (Text
"scala",Text
"Scala"),
  (Text
"scilab",Text
"Scilab"),
  (Text
"sh",Text
"sh"),
  (Text
"shelxl",Text
"SHELXL"),
  (Text
"simula",Text
"Simula"),
  (Text
"sparql",Text
"SPARQL"),
  (Text
"sql",Text
"SQL"),
  (Text
"swift",Text
"Swift"),
  (Text
"tcl",Text
"tcl"),
  (Text
"tex",Text
"TeX"),
  (Text
"latex",Text
"TeX"),
  (Text
"vbscript",Text
"VBScript"),
  (Text
"verilog",Text
"Verilog"),
  (Text
"vhdl",Text
"VHDL"),
  (Text
"vrml",Text
"VRML"),
  (Text
"xml",Text
"XML"),
  (Text
"xslt",Text
"XSLT")]

-- | Determine listings language name from skylighting language name.
toListingsLanguage :: T.Text -> Maybe T.Text
toListingsLanguage :: Text -> Maybe Text
toListingsLanguage Text
lang = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Text
T.toLower Text
lang) Map Text Text
langToListingsMap

-- | Determine skylighting language name from listings language name.
fromListingsLanguage :: T.Text -> Maybe T.Text
fromListingsLanguage :: Text -> Maybe Text
fromListingsLanguage Text
lang = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
lang Map Text Text
listingsToLangMap

-- | Lookup style from a name. If the name is a standard style,
-- load it; if it ends in ".theme", attempt to load a KDE theme
-- from the file path specified.
lookupHighlightingStyle :: PandocMonad m => String -> m Style
lookupHighlightingStyle :: forall (m :: * -> *). PandocMonad m => String -> m Style
lookupHighlightingStyle String
s
  | String -> String
takeExtension String
s forall a. Eq a => a -> a -> Bool
== String
".theme" = -- attempt to load KDE theme
    do ByteString
contents <- forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileLazy String
s
       case ByteString -> Either String Style
parseTheme ByteString
contents of
            Left String
_    -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocOptionError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
                           String
"Could not read highlighting theme " forall a. [a] -> [a] -> [a]
++ String
s
            Right Style
sty -> forall (m :: * -> *) a. Monad m => a -> m a
return Style
sty
  | Bool
otherwise =
  case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s) [(Text, Style)]
highlightingStyles of
       Just Style
sty -> forall (m :: * -> *) a. Monad m => a -> m a
return Style
sty
       Maybe Style
Nothing  -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocOptionError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$
                      String
"Unknown highlight-style " forall a. [a] -> [a] -> [a]
++ String
s