From 4f8ee2212ac17ca93636ca54987654c0835a1806 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 14 Aug 2022 22:50:57 -0700 Subject: [PATCH] T.P.Highlighting: Export `lookupHighlightingStyle`. [API change] Previously this lived in an unexported module T.P.App.CommandLineOptions, under the name `lookupHighlightStyle`. --- src/Text/Pandoc/App/CommandLineOptions.hs | 22 +++------------------- src/Text/Pandoc/App/OutputSettings.hs | 7 ++++--- src/Text/Pandoc/Highlighting.hs | 23 +++++++++++++++++++++++ 3 files changed, 30 insertions(+), 22 deletions(-) diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs index ce6ff4a35..27300f369 100644 --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -22,12 +22,10 @@ module Text.Pandoc.App.CommandLineOptions ( , parseOptionsFromArgs , options , engines - , lookupHighlightStyle , setVariable ) where import Control.Monad import Control.Monad.Trans -import Control.Monad.Except (throwError) import Control.Monad.State.Strict import Data.Aeson.Encode.Pretty (encodePretty', Config(..), keyOrder, defConfig, Indent(..), NumberFormat(..)) @@ -41,7 +39,7 @@ import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) import HsLua (Exception, getglobal, openlibs, peek, run, top) import Safe (tailDef) -import Skylighting (Style, Syntax (..), defaultSyntaxMap, parseTheme) +import Skylighting (Syntax (..), defaultSyntaxMap) import System.Console.GetOpt import System.Environment (getArgs, getProgName) import System.Exit (exitSuccess) @@ -54,7 +52,7 @@ import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), IpynbOutput (..), DefaultsState (..), applyDefaults, fullDefaultsPath) import Text.Pandoc.Filter (Filter (..)) -import Text.Pandoc.Highlighting (highlightingStyles) +import Text.Pandoc.Highlighting (highlightingStyles, lookupHighlightingStyle) import Text.Pandoc.Shared (ordNub, elemText, safeStrRead, defaultUserDataDir) import Text.Printf @@ -946,7 +944,7 @@ options = (ReqArg (\arg opt -> do let write = maybe B.putStr B.writeFile $ optOutputFile opt - sty <- runIOorExplode $ lookupHighlightStyle arg + sty <- runIOorExplode $ lookupHighlightingStyle arg write $ encodePretty' defConfig{confIndent = Spaces 4 ,confCompare = keyOrder @@ -1059,20 +1057,6 @@ writersNames = sort splitField :: String -> (String, String) splitField = second (tailDef "true") . break (`elemText` ":=") -lookupHighlightStyle :: PandocMonad m => String -> m Style -lookupHighlightStyle s - | takeExtension s == ".theme" = -- attempt to load KDE theme - do contents <- readFileLazy s - case parseTheme contents of - Left _ -> throwError $ PandocOptionError $ T.pack $ - "Could not read highlighting theme " ++ s - Right sty -> return sty - | otherwise = - case lookup (T.toLower $ T.pack s) highlightingStyles of - Just sty -> return sty - Nothing -> throwError $ PandocOptionError $ T.pack $ - "Unknown highlight-style " ++ s - deprecatedOption :: String -> String -> IO () deprecatedOption o msg = runIO (report $ Deprecated (T.pack o) (T.pack msg)) >>= diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs index 988f2def5..ccdb53112 100644 --- a/src/Text/Pandoc/App/OutputSettings.hs +++ b/src/Text/Pandoc/App/OutputSettings.hs @@ -37,8 +37,8 @@ import System.IO (stdout) import Text.Pandoc import Text.Pandoc.App.FormatHeuristics (formatFromFilePaths) import Text.Pandoc.App.Opt (Opt (..)) -import Text.Pandoc.App.CommandLineOptions (engines, lookupHighlightStyle, - setVariable) +import Text.Pandoc.App.CommandLineOptions (engines, setVariable) +import Text.Pandoc.Highlighting (lookupHighlightingStyle) import Text.Pandoc.Writers.Custom (writeCustom) import qualified Text.Pandoc.UTF8 as UTF8 @@ -128,7 +128,8 @@ optToOutputSettings opts = do syntaxMap <- foldM addSyntaxMap defaultSyntaxMap (optSyntaxDefinitions opts) - hlStyle <- traverse (lookupHighlightStyle . T.unpack) $ optHighlightStyle opts + hlStyle <- traverse (lookupHighlightingStyle . T.unpack) $ + optHighlightStyle opts let setVariableM k v = return . setVariable k v diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs index d8ccd1ebd..fac99cbcd 100644 --- a/src/Text/Pandoc/Highlighting.hs +++ b/src/Text/Pandoc/Highlighting.hs @@ -30,6 +30,7 @@ module Text.Pandoc.Highlighting ( highlightingStyles , breezeDark , haddock , Style + , lookupHighlightingStyle , fromListingsLanguage , toListingsLanguage ) where @@ -39,6 +40,10 @@ 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)] @@ -214,3 +219,21 @@ toListingsLanguage lang = M.lookup (T.toLower lang) langToListingsMap -- | Determine skylighting language name from listings language name. fromListingsLanguage :: T.Text -> Maybe T.Text fromListingsLanguage lang = M.lookup lang 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 s + | takeExtension s == ".theme" = -- attempt to load KDE theme + do contents <- readFileLazy s + case parseTheme contents of + Left _ -> throwError $ PandocOptionError $ T.pack $ + "Could not read highlighting theme " ++ s + Right sty -> return sty + | otherwise = + case lookup (T.toLower $ T.pack s) highlightingStyles of + Just sty -> return sty + Nothing -> throwError $ PandocOptionError $ T.pack $ + "Unknown highlight-style " ++ s +