{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Highlighting
   Copyright   : Copyright (C) 2008-2022 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
                                , formatLaTeXInline
                                , formatLaTeXBlock
                                , styleToLaTeX
                                , formatHtmlInline
                                , formatHtmlBlock
                                , styleToCss
                                , pygments
                                , espresso
                                , zenburn
                                , tango
                                , kate
                                , monochrome
                                , breezeDark
                                , haddock
                                , Style
                                , 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.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