From 2c05a6d6a4f37ee6daed41b62a7e5bc35e49f238 Mon Sep 17 00:00:00 2001 From: despresc Date: Sat, 9 Nov 2019 12:56:30 -0500 Subject: Switch App to Text, remove usage of Legacy in src --- pandoc.cabal | 1 - src/Text/Pandoc.hs | 28 +++----- src/Text/Pandoc/App.hs | 62 ++++++++--------- src/Text/Pandoc/App/CommandLineOptions.hs | 107 +++++++++++++++--------------- src/Text/Pandoc/App/FormatHeuristics.hs | 6 +- src/Text/Pandoc/App/Opt.hs | 58 ++++++++-------- src/Text/Pandoc/App/OutputSettings.hs | 65 +++++++++--------- src/Text/Pandoc/Class.hs | 2 +- src/Text/Pandoc/Legacy/Translations.hs | 17 ----- src/Text/Pandoc/Shared.hs | 17 ++++- src/Text/Pandoc/Slides.hs | 3 +- src/Text/Pandoc/Translations.hs | 2 +- src/Text/Pandoc/Writers/Custom.hs | 6 +- test/Tests/Readers/Docx.hs | 3 +- test/Tests/Readers/Odt.hs | 1 + test/Tests/Readers/Org/Inline/Smart.hs | 11 +-- test/Tests/Readers/Org/Shared.hs | 13 ++-- 17 files changed, 184 insertions(+), 218 deletions(-) delete mode 100644 src/Text/Pandoc/Legacy/Translations.hs diff --git a/pandoc.cabal b/pandoc.cabal index 863fbef6a..a46022a9d 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -553,7 +553,6 @@ library , Text.Pandoc.Legacy.Extensions , Text.Pandoc.Legacy.Shared , Text.Pandoc.Legacy.Highlighting - , Text.Pandoc.Legacy.Translations , Text.Pandoc.Legacy.Logging , Text.Pandoc.Legacy.MIME , Text.Pandoc.Legacy.Options diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index 59895a755..4a9a4fff0 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -42,17 +42,13 @@ module Text.Pandoc -- * Generics , module Text.Pandoc.Generic -- * Options - , -- module Text.Pandoc.Options TODO text: restore - module Text.Pandoc.Legacy.Options + , module Text.Pandoc.Options -- * Logging - , -- module Text.Pandoc.Logging -- TODO text: restore - module Text.Pandoc.Legacy.Logging + , module Text.Pandoc.Logging -- * Typeclass - , -- module Text.Pandoc.Class TODO text: restore - module Text.Pandoc.Legacy.Class + , module Text.Pandoc.Class -- * Error handling - , -- module Text.Pandoc.Error TODO text: restore - module Text.Pandoc.Legacy.Error + , module Text.Pandoc.Error -- * Readers: converting /to/ Pandoc format , module Text.Pandoc.Readers -- * Writers: converting /from/ Pandoc format @@ -63,17 +59,13 @@ module Text.Pandoc , pandocVersion ) where -import Text.Pandoc.Legacy.Class +import Text.Pandoc.Class import Text.Pandoc.Definition -import Text.Pandoc.Legacy.Error +import Text.Pandoc.Error import Text.Pandoc.Generic -import Text.Pandoc.Legacy.Logging -import Text.Pandoc.Legacy.Options --- import Text.Pandoc.Readers TODO text: restore -import Text.Pandoc.Legacy.Shared (pandocVersion) +import Text.Pandoc.Logging +import Text.Pandoc.Options +import Text.Pandoc.Readers +import Text.Pandoc.Shared (pandocVersion) import Text.Pandoc.Templates import Text.Pandoc.Writers - --- TODO text: remove -import Text.Pandoc.Readers hiding (getDefaultExtensions) --- diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 61c8d3e1e..2460f398d 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -46,21 +46,21 @@ import System.Exit (exitSuccess) import System.FilePath import System.IO (nativeNewline, stdout) import qualified System.IO as IO (Newline (..)) --- import Text.Pandoc -- TODO text: restore +import Text.Pandoc import Text.Pandoc.App.FormatHeuristics (formatFromFilePaths) import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), defaultOpts, IpynbOutput (..) ) import Text.Pandoc.App.CommandLineOptions (parseOptions, options) import Text.Pandoc.App.OutputSettings (OutputSettings (..), optToOutputSettings) --- import Text.Pandoc.BCP47 (Lang (..), parseBCP47) TODO text: restore -import Text.Pandoc.Legacy.Builder (setMeta) -- TODO text: remove Legacy +import Text.Pandoc.BCP47 (Lang (..), parseBCP47) +import Text.Pandoc.Builder (setMeta) import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), applyFilters) import Text.Pandoc.PDF (makePDF) import Text.Pandoc.Readers.Markdown (yamlToMeta) -import Text.Pandoc.Legacy.SelfContained (makeDataURI, makeSelfContained) -import Text.Pandoc.Legacy.Shared (eastAsianLineBreakFilter, stripEmptyParagraphs, +import Text.Pandoc.SelfContained (makeDataURI, makeSelfContained) +import Text.Pandoc.Shared (eastAsianLineBreakFilter, stripEmptyParagraphs, headerShift, isURI, tabFilter, uriPathToPath, filterIpynbOutput, - defaultUserDataDirs) + defaultUserDataDirs, tshow) import Text.Pandoc.Writers.Shared (lookupMetaString) import qualified Text.Pandoc.UTF8 as UTF8 #ifndef _WINDOWS @@ -68,12 +68,6 @@ import System.Posix.IO (stdOutput) import System.Posix.Terminal (queryTerminal) #endif --- TODO text: remove -import Text.Pandoc hiding (MetaValue(..), lookupMeta, Format(..)) -import Text.Pandoc.Legacy.Builder (lookupMeta, pattern Format) -import Text.Pandoc.Legacy.BCP47 --- - convertWithOpts :: Opt -> IO () convertWithOpts opts = do let outputFile = fromMaybe "-" (optOutputFile opts) @@ -148,23 +142,23 @@ convertWithOpts opts = do Nothing -> case formatFromFilePaths sources of Just f' -> return f' Nothing | sources == ["-"] -> return "markdown" - | any isURI sources -> return "html" + | any (isURI . T.pack) sources -> return "html" | otherwise -> do report $ CouldNotDeduceFormat - (map takeExtension sources) "markdown" + (map (T.pack . takeExtension) sources) "markdown" return "markdown" let pdfOutput = map toLower (takeExtension outputFile) == ".pdf" when (pdfOutput && readerName == "latex") $ case (optInputFiles opts) of - (inputFile:_) -> report $ UnusualConversion $ + (inputFile:_) -> report $ UnusualConversion $ T.pack $ "to convert a .tex file to PDF, you get better results by using pdflatex " <> "(or lualatex or xelatex) directly, try `pdflatex " <> inputFile <> "` instead of `pandoc " <> inputFile <> " -o " <> outputFile <> "`." _ -> return () - (reader :: Reader PandocIO, readerExts) <- getReader $ T.pack readerName -- TODO text: refactor + (reader :: Reader PandocIO, readerExts) <- getReader readerName let convertTabs = tabFilter (if optPreserveTabs opts || readerName == "t2t" || @@ -194,15 +188,15 @@ convertWithOpts opts = do when ((pdfOutput || not (isTextFormat format)) && istty && isNothing ( optOutputFile opts)) $ throwError $ PandocAppError $ - "Cannot write " ++ format ++ " output to terminal.\n" ++ - "Specify an output file using the -o option, or " ++ + "Cannot write " <> format <> " output to terminal.\n" <> + "Specify an output file using the -o option, or " <> "use '-o -' to force output to stdout." - abbrevs <- Set.fromList . filter (not . null) . lines <$> + abbrevs <- Set.fromList . filter (not . T.null) . T.lines <$> case optAbbreviations opts of - Nothing -> UTF8.toString <$> readDataFile "abbreviations" - Just f -> UTF8.toString <$> readFileStrict f + Nothing -> UTF8.toText <$> readDataFile "abbreviations" + Just f -> UTF8.toText <$> readFileStrict f metadata <- if format == "jats" && isNothing (lookupMeta "csl" (optMetadata opts)) && @@ -217,8 +211,8 @@ convertWithOpts opts = do case lookupMetaString "lang" (optMetadata opts) of "" -> setTranslations $ Lang "en" "" "US" [] - l -> case parseBCP47 (T.unpack l) of -- TODO text: refactor - Left _ -> report $ InvalidLang $ T.unpack l -- TODO text: refactor + l -> case parseBCP47 l of + Left _ -> report $ InvalidLang l Right l' -> setTranslations l' let readerOpts = def{ @@ -292,7 +286,7 @@ convertWithOpts opts = do >=> return . adjustMetadata (metadataFromFile <>) >=> return . adjustMetadata (<> metadata) >=> applyTransforms transforms - >=> applyFilters readerOpts filters' [format] + >=> applyFilters readerOpts filters' [T.unpack format] >=> maybe return extractMedia (optExtractMedia opts) ) @@ -305,7 +299,7 @@ convertWithOpts opts = do case res of Right pdf -> writeFnBinary outputFile pdf Left err' -> throwError $ PandocPDFError $ - TL.unpack (TE.decodeUtf8With TE.lenientDecode err') + TL.toStrict (TE.decodeUtf8With TE.lenientDecode err') Nothing -> do let ensureNl t @@ -315,18 +309,16 @@ convertWithOpts opts = do output <- ensureNl <$> f writerOptions doc writerFn eol outputFile =<< if optSelfContained opts && htmlFormat format - -- TODO not maximally efficient; change type - -- of makeSelfContained so it works w/ Text - then T.pack <$> makeSelfContained (T.unpack output) + then makeSelfContained output else return output type Transform = Pandoc -> Pandoc -htmlFormat :: String -> Bool +htmlFormat :: Text -> Bool htmlFormat = (`elem` ["html","html4","html5","s5","slidy", "slideous","dzslides","revealjs"]) -isTextFormat :: String -> Bool +isTextFormat :: Text -> Bool isTextFormat s = s `notElem` ["odt","docx","epub2","epub3","epub","pptx"] adjustMetadata :: (Meta -> Meta) -> Pandoc -> Pandoc @@ -342,7 +334,7 @@ readSource src = case parseURI src of Just u | uriScheme u `elem` ["http:","https:"] -> readURI src | uriScheme u == "file:" -> liftIO $ - readTextFile (uriPathToPath $ uriPath u) + readTextFile (uriPathToPath $ T.pack $ uriPath u) _ -> liftIO $ readTextFile src where readTextFile :: FilePath -> IO Text readTextFile fp = do @@ -354,12 +346,12 @@ readSource src = case parseURI src of TSE.DecodeError _ (Just w) -> do case BS.elemIndex w bs of Just offset -> E.throwIO $ - PandocUTF8DecodingError fp offset w - _ -> E.throwIO $ PandocUTF8DecodingError fp 0 w - _ -> E.throwIO $ PandocAppError (show e)) + PandocUTF8DecodingError (T.pack fp) offset w + _ -> E.throwIO $ PandocUTF8DecodingError (T.pack fp) 0 w + _ -> E.throwIO $ PandocAppError (tshow e)) readURI :: FilePath -> PandocIO Text -readURI src = UTF8.toText . fst <$> openURL src +readURI src = UTF8.toText . fst <$> openURL (T.pack src) readFile' :: MonadIO m => FilePath -> m BL.ByteString readFile' "-" = liftIO BL.getContents diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs index f3926dda5..7fde885ae 100644 --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -2,7 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE PatternSynonyms #-} -- TODO text: remove +{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.App.CommandLineOptions Copyright : Copyright (C) 2006-2019 John MacFarlane @@ -41,12 +41,12 @@ import System.Environment (getArgs, getProgName) import System.Exit (exitSuccess) import System.FilePath import System.IO (stdout) --- import Text.Pandoc TODO text: restore -import Text.Pandoc.Legacy.Builder (setMeta) -- TODO text: remove Legacy +import Text.Pandoc +import Text.Pandoc.Builder (setMeta) import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), IpynbOutput (..)) import Text.Pandoc.Filter (Filter (..)) -import Text.Pandoc.Legacy.Highlighting (highlightingStyles) -import Text.Pandoc.Legacy.Shared (ordNub, safeRead, defaultUserDataDirs) +import Text.Pandoc.Highlighting (highlightingStyles) +import Text.Pandoc.Shared (ordNub, elemText, safeStrRead, defaultUserDataDirs) import Text.Printf #ifdef EMBED_DATA_FILES @@ -66,11 +66,6 @@ import Text.DocTemplates (ToContext(toVal), Context(..)) import qualified Text.Pandoc.UTF8 as UTF8 import qualified Data.YAML as Y --- TODO text: remove -import Text.Pandoc hiding (MetaValue(..), lookupMeta) -import Text.Pandoc.Legacy.Builder (lookupMeta, MetaValue(..), pattern MetaString) --- - parseOptions :: [OptDescr (Opt -> IO Opt)] -> Opt -> IO Opt parseOptions options' defaults = do rawArgs <- map UTF8.decodeArg <$> getArgs @@ -84,7 +79,7 @@ parseOptions options' defaults = do unrecognizedOpts unless (null errors && null unknownOptionErrors) $ - E.throwIO $ PandocOptionError $ + E.throwIO $ PandocOptionError $ T.pack $ concat errors ++ unlines unknownOptionErrors ++ ("Try " ++ prg ++ " --help for more information.") @@ -98,7 +93,7 @@ latexEngines = ["pdflatex", "lualatex", "xelatex", "latexmk", "tectonic"] htmlEngines :: [String] htmlEngines = ["wkhtmltopdf", "weasyprint", "prince"] -engines :: [(String, String)] +engines :: [(Text, String)] engines = map ("html",) htmlEngines ++ map ("html5",) htmlEngines ++ map ("latex",) latexEngines ++ @@ -125,13 +120,13 @@ options = [ Option "fr" ["from","read"] (ReqArg (\arg opt -> return opt { optFrom = - Just (map toLower arg) }) + Just (T.toLower $ T.pack arg) }) "FORMAT") "" , Option "tw" ["to","write"] (ReqArg - (\arg opt -> return opt { optTo = Just arg }) + (\arg opt -> return opt { optTo = Just $ T.pack arg }) "FORMAT") "" @@ -224,7 +219,7 @@ options = , Option "" ["toc-depth"] (ReqArg (\arg opt -> - case safeRead arg of + case safeStrRead arg of Just t | t >= 1 && t <= 6 -> return opt { optTOCDepth = t } _ -> E.throwIO $ PandocOptionError @@ -240,7 +235,7 @@ options = , Option "" ["number-offset"] (ReqArg (\arg opt -> - case safeRead ('[':arg ++ "]") of + case safeStrRead ("[" <> arg <> "]") of Just ns -> return opt { optNumberOffset = ns, optNumberSections = True } _ -> E.throwIO $ PandocOptionError @@ -261,7 +256,7 @@ options = "default" -> return opt{ optTopLevelDivision = TopLevelDefault } _ -> E.throwIO $ PandocOptionError $ - "Top-level division must be " ++ + "Top-level division must be " <> "section, chapter, part, or default" ) "section|chapter|part") "" -- "Use top-level division type in LaTeX, ConTeXt, DocBook" @@ -313,7 +308,7 @@ options = , Option "" ["highlight-style"] (ReqArg (\arg opt -> - return opt{ optHighlightStyle = Just arg }) + return opt{ optHighlightStyle = Just $ T.pack arg }) "STYLE|FILE") "" -- "Style for highlighted code" @@ -334,7 +329,7 @@ options = , Option "" ["dpi"] (ReqArg (\arg opt -> - case safeRead arg of + case safeStrRead arg of Just t | t > 0 -> return opt { optDpi = t } _ -> E.throwIO $ PandocOptionError "dpi must be a number greater than 0") @@ -357,7 +352,7 @@ options = , Option "" ["columns"] (ReqArg (\arg opt -> - case safeRead arg of + case safeStrRead arg of Just t | t > 0 -> return opt { optColumns = t } _ -> E.throwIO $ PandocOptionError "columns must be a number greater than 0") @@ -372,7 +367,7 @@ options = , Option "" ["tab-stop"] (ReqArg (\arg opt -> - case safeRead arg of + case safeStrRead arg of Just t | t > 0 -> return opt { optTabStop = t } _ -> E.throwIO $ PandocOptionError "tab-stop must be a number greater than 0") @@ -385,7 +380,7 @@ options = let b = takeBaseName arg if b `elem` pdfEngines then return opt { optPdfEngine = Just arg } - else E.throwIO $ PandocOptionError $ "pdf-engine must be one of " + else E.throwIO $ PandocOptionError $ T.pack $ "pdf-engine must be one of " ++ intercalate ", " pdfEngines) "PROGRAM") "" -- "Name of program to use in generating PDF" @@ -416,7 +411,7 @@ options = (\arg opt -> do let (key, val) = splitField arg return opt{ optRequestHeaders = - (key, val) : optRequestHeaders opt }) + (T.pack key, T.pack val) : optRequestHeaders opt }) "NAME:VALUE") "" @@ -428,14 +423,15 @@ options = , Option "" ["indented-code-classes"] (ReqArg - (\arg opt -> return opt { optIndentedCodeClasses = words $ - map (\c -> if c == ',' then ' ' else c) arg }) + (\arg opt -> return opt { optIndentedCodeClasses = T.words $ + T.map (\c -> if c == ',' then ' ' else c) $ + T.pack arg }) "STRING") "" -- "Classes (whitespace- or comma-separated) to use for indented code-blocks" , Option "" ["default-image-extension"] (ReqArg - (\arg opt -> return opt { optDefaultImageExtension = arg }) + (\arg opt -> return opt { optDefaultImageExtension = T.pack arg }) "extension") "" -- "Default extension for extensionless images" @@ -456,7 +452,7 @@ options = , Option "" ["shift-heading-level-by"] (ReqArg (\arg opt -> - case safeRead arg of + case safeStrRead arg of Just t -> return opt{ optShiftHeadingLevelBy = t } _ -> E.throwIO $ PandocOptionError @@ -469,7 +465,7 @@ options = (\arg opt -> do deprecatedOption "--base-header-level" "Use --shift-heading-level-by instead." - case safeRead arg of + case safeStrRead arg of Just t | t > 0 && t < 6 -> return opt{ optShiftHeadingLevelBy = t - 1 } _ -> E.throwIO $ PandocOptionError @@ -492,7 +488,7 @@ options = "accept" -> return AcceptChanges "reject" -> return RejectChanges "all" -> return AllChanges - _ -> E.throwIO $ PandocOptionError + _ -> E.throwIO $ PandocOptionError $ T.pack ("Unknown option for track-changes: " ++ arg) return opt { optTrackChanges = action }) "accept|reject|all") @@ -515,7 +511,7 @@ options = "block" -> return EndOfBlock "section" -> return EndOfSection "document" -> return EndOfDocument - _ -> E.throwIO $ PandocOptionError + _ -> E.throwIO $ PandocOptionError $ T.pack ("Unknown option for reference-location: " ++ arg) return opt { optReferenceLocation = action }) "block|section|document") @@ -539,7 +535,7 @@ options = , Option "" ["slide-level"] (ReqArg (\arg opt -> - case safeRead arg of + case safeStrRead arg of Just t | t >= 1 && t <= 6 -> return opt { optSlideLevel = Just t } _ -> E.throwIO $ PandocOptionError @@ -565,7 +561,7 @@ options = "references" -> return ReferenceObfuscation "javascript" -> return JavascriptObfuscation "none" -> return NoObfuscation - _ -> E.throwIO $ PandocOptionError + _ -> E.throwIO $ PandocOptionError $ T.pack ("Unknown obfuscation method: " ++ arg) return opt { optEmailObfuscation = method }) "none|javascript|references") @@ -573,7 +569,7 @@ options = , Option "" ["id-prefix"] (ReqArg - (\arg opt -> return opt { optIdentifierPrefix = arg }) + (\arg opt -> return opt { optIdentifierPrefix = T.pack arg }) "STRING") "" -- "Prefix to add to automatically generated HTML identifiers" @@ -626,7 +622,7 @@ options = , Option "" ["epub-chapter-level"] (ReqArg (\arg opt -> - case safeRead arg of + case safeStrRead arg of Just t | t >= 1 && t <= 6 -> return opt { optEpubChapterLevel = t } _ -> E.throwIO $ PandocOptionError @@ -691,15 +687,15 @@ options = (OptArg (\arg opt -> do let url' = fromMaybe "https://latex.codecogs.com/png.latex?" arg - return opt { optHTMLMathMethod = WebTeX url' }) + return opt { optHTMLMathMethod = WebTeX $ T.pack url' }) "URL") "" -- "Use web service for HTML math" , Option "" ["mathjax"] (OptArg (\arg opt -> do - let url' = fromMaybe (defaultMathJaxURL ++ - "tex-mml-chtml.js") arg + let url' = maybe (defaultMathJaxURL <> + "tex-mml-chtml.js") T.pack arg return opt { optHTMLMathMethod = MathJax url'}) "URL") "" -- "Use MathJax for HTML math" @@ -709,7 +705,7 @@ options = (\arg opt -> return opt { optHTMLMathMethod = KaTeX $ - fromMaybe defaultKaTeXURL arg }) + maybe defaultKaTeXURL T.pack arg }) "URL") "" -- Use KaTeX for HTML Math @@ -769,7 +765,7 @@ options = UTF8.hPutStrLn stdout $ printf tpl allopts (unwords readersNames) (unwords writersNames) - (unwords $ map fst highlightingStyles) + (unwords $ map (T.unpack . fst) highlightingStyles) (unwords datafiles) exitSuccess )) "" -- "Print bash completion script" @@ -796,12 +792,12 @@ options = let allExts = case arg of Nothing -> extensionsFromList extList - Just fmt -> getAllExtensions fmt + Just fmt -> getAllExtensions $ T.pack fmt let defExts = case arg of Nothing -> getDefaultExtensions "markdown" - Just fmt -> getDefaultExtensions fmt + Just fmt -> getDefaultExtensions $ T.pack fmt let showExt x = (if extensionEnabled x defExts then '+' @@ -829,7 +825,7 @@ options = , Option "" ["list-highlight-styles"] (NoArg (\_ -> do - mapM_ (UTF8.hPutStrLn stdout . fst) highlightingStyles + mapM_ (UTF8.hPutStrLn stdout . T.unpack . fst) highlightingStyles exitSuccess )) "" @@ -845,7 +841,7 @@ options = case templ of Right t | T.null t -> -- e.g. for docx, odt, json: - E.throwIO $ PandocCouldNotFindDataFileError + E.throwIO $ PandocCouldNotFindDataFileError $ T.pack ("templates/default." ++ arg) | otherwise -> write . T.unpack $ t Left e -> E.throwIO e @@ -896,7 +892,7 @@ options = (\_ -> do prg <- getProgName defaultDatadirs <- defaultUserDataDirs - UTF8.hPutStrLn stdout (prg ++ " " ++ pandocVersion ++ + UTF8.hPutStrLn stdout (prg ++ " " ++ T.unpack pandocVersion ++ compileInfo ++ "\nDefault user data directory: " ++ intercalate " or " defaultDatadirs ++ ('\n':copyrightMessage)) @@ -976,7 +972,7 @@ writersNames = sort (map (T.unpack . fst) (writers :: [(Text, Writer PandocIO)]) splitField :: String -> (String, String) splitField s = - case break (`elem` ":=") s of + case break (`elemText` ":=") s of (k,_:v) -> (k,v) (k,[]) -> (k,"true") @@ -997,7 +993,7 @@ applyDefaults opt file = runIOorExplode $ do case Y.decode1 inp of Right (f :: Opt -> Opt) -> return $ f opt Left (errpos, errmsg) -> throwError $ - PandocParseError $ + PandocParseError $ T.pack $ "Error parsing " ++ fp' ++ " line " ++ show (Y.posLine errpos) ++ " column " ++ show (Y.posColumn errpos) ++ ":\n" ++ errmsg @@ -1007,18 +1003,18 @@ lookupHighlightStyle s | takeExtension s == ".theme" = -- attempt to load KDE theme do contents <- readFileLazy s case parseTheme contents of - Left _ -> throwError $ PandocOptionError $ + Left _ -> throwError $ PandocOptionError $ T.pack $ "Could not read highlighting theme " ++ s Right sty -> return sty | otherwise = - case lookup (map toLower s) highlightingStyles of + case lookup (T.toLower $ T.pack s) highlightingStyles of Just sty -> return sty - Nothing -> throwError $ PandocOptionError $ + Nothing -> throwError $ PandocOptionError $ T.pack $ "Unknown highlight-style " ++ s deprecatedOption :: String -> String -> IO () deprecatedOption o msg = - runIO (report $ Deprecated o msg) >>= + runIO (report $ Deprecated (T.pack o) (T.pack msg)) >>= \r -> case r of Right () -> return () Left e -> E.throwIO e @@ -1030,13 +1026,14 @@ setVariable key val (Context ctx) = addMeta :: String -> String -> Meta -> Meta addMeta k v meta = - case lookupMeta k meta of - Nothing -> setMeta k v' meta + case lookupMeta k' meta of + Nothing -> setMeta k' v' meta Just (MetaList xs) -> - setMeta k (MetaList (xs ++ [v'])) meta - Just x -> setMeta k (MetaList [x, v']) meta + setMeta k' (MetaList (xs ++ [v'])) meta + Just x -> setMeta k' (MetaList [x, v']) meta where v' = readMetaValue v + k' = T.pack k readMetaValue :: String -> MetaValue readMetaValue s @@ -1046,7 +1043,7 @@ readMetaValue s | s == "false" = MetaBool False | s == "False" = MetaBool False | s == "FALSE" = MetaBool False - | otherwise = MetaString s + | otherwise = MetaString $ T.pack s -- On Windows with ghc 8.6+, we need to rewrite paths -- beginning with \\ to \\?\UNC\. -- See #5127. diff --git a/src/Text/Pandoc/App/FormatHeuristics.hs b/src/Text/Pandoc/App/FormatHeuristics.hs index a02d8d15e..25e0a303e 100644 --- a/src/Text/Pandoc/App/FormatHeuristics.hs +++ b/src/Text/Pandoc/App/FormatHeuristics.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.App.FormatHeuristics Copyright : Copyright (C) 2006-2019 John MacFarlane @@ -16,10 +17,11 @@ module Text.Pandoc.App.FormatHeuristics import Prelude import Data.Char (toLower) +import Data.Text (Text) import System.FilePath (takeExtension) -- Determine default format based on file extensions. -formatFromFilePaths :: [FilePath] -> Maybe String +formatFromFilePaths :: [FilePath] -> Maybe Text formatFromFilePaths [] = Nothing formatFromFilePaths (x:xs) = case formatFromFilePath x of @@ -27,7 +29,7 @@ formatFromFilePaths (x:xs) = Nothing -> formatFromFilePaths xs -- Determine format based on file extension -formatFromFilePath :: FilePath -> Maybe String +formatFromFilePath :: FilePath -> Maybe Text formatFromFilePath x = case takeExtension (map toLower x) of ".adoc" -> Just "asciidoc" diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs index 9cd9030d2..c0489d6fa 100644 --- a/src/Text/Pandoc/App/Opt.hs +++ b/src/Text/Pandoc/App/Opt.hs @@ -27,29 +27,25 @@ import Prelude import Data.Char (isLower, toLower) import GHC.Generics hiding (Meta) import Text.Pandoc.Filter (Filter (..)) -import Text.Pandoc.Legacy.Logging (Verbosity (WARNING)) -import Text.Pandoc.Legacy.Options (TopLevelDivision (TopLevelDefault), +import Text.Pandoc.Logging (Verbosity (WARNING)) +import Text.Pandoc.Options (TopLevelDivision (TopLevelDefault), TrackChanges (AcceptChanges), WrapOption (WrapAuto), HTMLMathMethod (PlainMath), ReferenceLocation (EndOfDocument), ObfuscationMethod (NoObfuscation), CiteMethod (Citeproc)) -import Text.Pandoc.Legacy.Shared (camelCaseToHyphenated) +import Text.Pandoc.Shared (camelCaseStrToHyphenated) import Text.DocLayout (render) import Text.DocTemplates (Context(..), Val(..)) import Data.Text (Text, unpack) import qualified Data.Text as T import qualified Data.Map as M --- import Text.Pandoc.Definition (Meta(..), MetaValue(..)) -- TODO text: restore +import Text.Pandoc.Definition (Meta(..), MetaValue(..)) import Data.Aeson (defaultOptions, Options(..)) import Data.Aeson.TH (deriveJSON) import Control.Applicative ((<|>)) import Data.YAML --- TODO text: remove -import Text.Pandoc.Legacy.Definition (Meta, pattern Meta, MetaValue(..), pattern MetaMap, pattern MetaString) --- - -- | The type of line-endings to be used when writing plain-text. data LineEnding = LF | CRLF | Native deriving (Show, Generic) @@ -81,8 +77,8 @@ data Opt = Opt { optTabStop :: Int -- ^ Number of spaces per tab , optPreserveTabs :: Bool -- ^ Preserve tabs instead of converting to spaces , optStandalone :: Bool -- ^ Include header, footer - , optFrom :: Maybe String -- ^ Reader format - , optTo :: Maybe String -- ^ Writer format + , optFrom :: Maybe Text -- ^ Reader format + , optTo :: Maybe Text -- ^ Writer format , optTableOfContents :: Bool -- ^ Include table of contents , optShiftHeadingLevelBy :: Int -- ^ Shift heading level by , optTemplate :: Maybe FilePath -- ^ Custom template @@ -97,7 +93,7 @@ data Opt = Opt , optIncremental :: Bool -- ^ Use incremental lists in Slidy/Slideous/S5 , optSelfContained :: Bool -- ^ Make HTML accessible offline , optHtmlQTags :: Bool -- ^ Use tags in HTML - , optHighlightStyle :: Maybe String -- ^ Style to use for highlighted code + , optHighlightStyle :: Maybe Text -- ^ Style to use for highlighted code , optSyntaxDefinitions :: [FilePath] -- ^ xml syntax defs to load , optTopLevelDivision :: TopLevelDivision -- ^ Type of the top-level divisions , optHTMLMathMethod :: HTMLMathMethod -- ^ Method to print HTML math @@ -122,9 +118,9 @@ data Opt = Opt , optColumns :: Int -- ^ Line length in characters , optFilters :: [Filter] -- ^ Filters to apply , optEmailObfuscation :: ObfuscationMethod - , optIdentifierPrefix :: String + , optIdentifierPrefix :: Text , optStripEmptyParagraphs :: Bool -- ^ Strip empty paragraphs - , optIndentedCodeClasses :: [String] -- ^ Default classes for indented code blocks + , optIndentedCodeClasses :: [Text] -- ^ Default classes for indented code blocks , optDataDir :: Maybe FilePath , optCiteMethod :: CiteMethod -- ^ Method to output cites , optListings :: Bool -- ^ Use listings package for code blocks @@ -133,18 +129,18 @@ data Opt = Opt , optSlideLevel :: Maybe Int -- ^ Header level that creates slides , optSetextHeaders :: Bool -- ^ Use atx headers for markdown level 1-2 , optAscii :: Bool -- ^ Prefer ascii output - , optDefaultImageExtension :: String -- ^ Default image extension + , optDefaultImageExtension :: Text -- ^ Default image extension , optExtractMedia :: Maybe FilePath -- ^ Path to extract embedded media , optTrackChanges :: TrackChanges -- ^ Accept or reject MS Word track-changes. , optFileScope :: Bool -- ^ Parse input files before combining - , optTitlePrefix :: Maybe String -- ^ Prefix for title + , optTitlePrefix :: Maybe Text -- ^ Prefix for title , optCss :: [FilePath] -- ^ CSS files to link to , optIpynbOutput :: IpynbOutput -- ^ How to treat ipynb output blocks , optIncludeBeforeBody :: [FilePath] -- ^ Files to include before , optIncludeAfterBody :: [FilePath] -- ^ Files to include after body , optIncludeInHeader :: [FilePath] -- ^ Files to include in header , optResourcePath :: [FilePath] -- ^ Path to search for images etc - , optRequestHeaders :: [(String, String)] -- ^ Headers for HTTP requests + , optRequestHeaders :: [(Text, Text)] -- ^ Headers for HTTP requests , optEol :: LineEnding -- ^ Style of line-endings to use , optStripComments :: Bool -- ^ Skip HTML comments } deriving (Generic, Show) @@ -172,13 +168,13 @@ doOpt (k',v) = do "toc" -> parseYAML v >>= \x -> return (\o -> o{ optTableOfContents = x }) "from" -> - parseYAML v >>= \x -> return (\o -> o{ optFrom = unpack <$> x }) + parseYAML v >>= \x -> return (\o -> o{ optFrom = x }) "reader" -> - parseYAML v >>= \x -> return (\o -> o{ optFrom = unpack <$> x }) + parseYAML v >>= \x -> return (\o -> o{ optFrom = x }) "to" -> - parseYAML v >>= \x -> return (\o -> o{ optTo = unpack <$> x }) + parseYAML v >>= \x -> return (\o -> o{ optTo = x }) "writer" -> - parseYAML v >>= \x -> return (\o -> o{ optTo = unpack <$> x }) + parseYAML v >>= \x -> return (\o -> o{ optTo = x }) "shift-heading-level-by" -> parseYAML v >>= \x -> return (\o -> o{ optShiftHeadingLevelBy = x }) "template" -> @@ -216,7 +212,7 @@ doOpt (k',v) = do "html-q-tags" -> parseYAML v >>= \x -> return (\o -> o{ optHtmlQTags = x }) "highlight-style" -> - parseYAML v >>= \x -> return (\o -> o{ optHighlightStyle = unpack <$> x }) + parseYAML v >>= \x -> return (\o -> o{ optHighlightStyle = x }) "syntax-definition" -> (parseYAML v >>= \x -> return (\o -> o{ optSyntaxDefinitions = map unpack x })) @@ -279,12 +275,12 @@ doOpt (k',v) = do parseYAML v >>= \x -> return (\o -> o{ optEmailObfuscation = x }) "identifier-prefix" -> parseYAML v >>= \x -> - return (\o -> o{ optIdentifierPrefix = unpack x }) + return (\o -> o{ optIdentifierPrefix = x }) "strip-empty-paragraphs" -> parseYAML v >>= \x -> return (\o -> o{ optStripEmptyParagraphs = x }) "indented-code-classes" -> parseYAML v >>= \x -> - return (\o -> o{ optIndentedCodeClasses = map unpack x }) + return (\o -> o{ optIndentedCodeClasses = x }) "data-dir" -> parseYAML v >>= \x -> return (\o -> o{ optDataDir = unpack <$> x }) "cite-method" -> @@ -310,7 +306,7 @@ doOpt (k',v) = do parseYAML v >>= \x -> return (\o -> o{ optAscii = x }) "default-image-extension" -> parseYAML v >>= \x -> - return (\o -> o{ optDefaultImageExtension = unpack x }) + return (\o -> o{ optDefaultImageExtension = x }) "extract-media" -> parseYAML v >>= \x -> return (\o -> o{ optExtractMedia = unpack <$> x }) @@ -319,7 +315,7 @@ doOpt (k',v) = do "file-scope" -> parseYAML v >>= \x -> return (\o -> o{ optFileScope = x }) "title-prefix" -> - parseYAML v >>= \x -> return (\o -> o{ optTitlePrefix = unpack <$> x }) + parseYAML v >>= \x -> return (\o -> o{ optTitlePrefix = x }) "css" -> (parseYAML v >>= \x -> return (\o -> o{ optCss = map unpack x })) <|> @@ -349,9 +345,7 @@ doOpt (k',v) = do return (\o -> o{ optResourcePath = map unpack x }) "request-headers" -> parseYAML v >>= \x -> - return (\o -> o{ optRequestHeaders = - map (\(key,val) -> - (unpack key, unpack val)) x }) + return (\o -> o{ optRequestHeaders = x }) "eol" -> parseYAML v >>= \x -> return (\o -> o{ optEol = x }) "strip-comments" -> @@ -434,13 +428,13 @@ defaultOpts = Opt contextToMeta :: Context Text -> Meta contextToMeta (Context m) = - Meta . M.mapKeys unpack . M.map valToMetaVal $ m + Meta . M.map valToMetaVal $ m valToMetaVal :: Val Text -> MetaValue valToMetaVal (MapVal (Context m)) = - MetaMap . M.mapKeys unpack . M.map valToMetaVal $ m + MetaMap . M.map valToMetaVal $ m valToMetaVal (ListVal xs) = MetaList $ map valToMetaVal xs -valToMetaVal (SimpleVal d) = MetaString (unpack $ render Nothing d) +valToMetaVal (SimpleVal d) = MetaString $ render Nothing d valToMetaVal NullVal = MetaString "" -- see https://github.com/jgm/pandoc/pull/4083 @@ -451,5 +445,5 @@ $(deriveJSON defaultOptions{ fieldLabelModifier = map toLower } ''LineEnding) $(deriveJSON defaultOptions{ fieldLabelModifier = - camelCaseToHyphenated . dropWhile isLower + camelCaseStrToHyphenated . dropWhile isLower } ''Opt) diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs index 699f2fecb..d328a9b6a 100644 --- a/src/Text/Pandoc/App/OutputSettings.hs +++ b/src/Text/Pandoc/App/OutputSettings.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {- | @@ -27,7 +28,7 @@ import Control.Monad import Control.Monad.Except (catchError, throwError) import Control.Monad.Trans import Data.Char (toLower) -import Data.List (find, isPrefixOf, isSuffixOf) +import Data.List (find, isPrefixOf) import Data.Maybe (fromMaybe) import Skylighting (defaultSyntaxMap) import Skylighting.Parser (addSyntaxDefinition, parseSyntaxDefinition) @@ -42,18 +43,18 @@ import Text.Pandoc.App.CommandLineOptions (engines, lookupHighlightStyle, setVariable) import qualified Text.Pandoc.UTF8 as UTF8 +readUtf8File :: PandocMonad m => FilePath -> m T.Text +readUtf8File = fmap UTF8.toText . readFileStrict + -- | Settings specifying how document output should be produced. data OutputSettings = OutputSettings - { outputFormat :: String + { outputFormat :: T.Text , outputWriter :: Writer PandocIO - , outputWriterName :: String + , outputWriterName :: T.Text , outputWriterOptions :: WriterOptions , outputPdfProgram :: Maybe String } -readUtf8File :: PandocMonad m => FilePath -> m String -readUtf8File = fmap UTF8.toString . readFileStrict - -- | Get output settings from command line options. optToOutputSettings :: Opt -> PandocIO OutputSettings optToOutputSettings opts = do @@ -85,33 +86,33 @@ optToOutputSettings opts = do case formatFromFilePaths [outputFile] of Nothing -> do report $ CouldNotDeduceFormat - [takeExtension outputFile] "html" + [T.pack $ takeExtension outputFile] "html" return ("html", Nothing) Just f -> return (f, Nothing) - let format = if ".lua" `isSuffixOf` writerName + let format = if ".lua" `T.isSuffixOf` writerName then writerName - else map toLower $ baseWriterName writerName + else T.toLower $ baseWriterName writerName (writer :: Writer PandocIO, writerExts) <- - if ".lua" `isSuffixOf` format + if ".lua" `T.isSuffixOf` format then return (TextWriter - (\o d -> writeCustom writerName o d) + (\o d -> writeCustom (T.unpack writerName) o d) :: Writer PandocIO, mempty) - else getWriter (T.toLower $ T.pack writerName) -- TODO text: refactor + else getWriter (T.toLower writerName) let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput let addSyntaxMap existingmap f = do res <- liftIO (parseSyntaxDefinition f) case res of - Left errstr -> throwError $ PandocSyntaxMapError errstr + Left errstr -> throwError $ PandocSyntaxMapError $ T.pack errstr Right syn -> return $ addSyntaxDefinition syn existingmap syntaxMap <- foldM addSyntaxMap defaultSyntaxMap (optSyntaxDefinitions opts) - hlStyle <- maybe (return Nothing) (fmap Just . lookupHighlightStyle) + hlStyle <- maybe (return Nothing) (fmap Just . lookupHighlightStyle . T.unpack) (optHighlightStyle opts) let setVariableM k v = return . setVariable k v @@ -135,15 +136,15 @@ optToOutputSettings opts = do >>= setVariableM "outputfile" outputFile >>= - setFilesVariableM "include-before" (optIncludeBeforeBody opts) + setFilesVariableM "include-before" (T.pack <$> optIncludeBeforeBody opts) >>= - setFilesVariableM "include-after" (optIncludeAfterBody opts) + setFilesVariableM "include-after" (T.pack <$> optIncludeAfterBody opts) >>= - setFilesVariableM "header-includes" (optIncludeInHeader opts) + setFilesVariableM "header-includes" (T.pack <$> optIncludeInHeader opts) >>= setListVariableM "css" (optCss opts) >>= - maybe return (setVariableM "title-prefix") + maybe return (setVariableM "title-prefix" . T.unpack) (optTitlePrefix opts) >>= maybe return (setVariableM "epub-cover-image") @@ -164,11 +165,11 @@ optToOutputSettings opts = do templStr <- case optTemplate opts of _ | not standalone -> return Nothing - Nothing -> Just <$> getDefaultTemplate (T.pack format) + Nothing -> Just <$> getDefaultTemplate format Just tp -> do -- strip off extensions let tp' = case takeExtension tp of - "" -> tp <.> format + "" -> tp <.> T.unpack format _ -> tp Just . UTF8.toText <$> ((do surl <- stSourceURL <$> getCommonState @@ -176,7 +177,7 @@ optToOutputSettings opts = do -- unless the full URL is specified: modifyCommonState $ \st -> st{ stSourceURL = Nothing } - (bs, _) <- fetchItem tp' + (bs, _) <- fetchItem $ T.pack tp' modifyCommonState $ \st -> st{ stSourceURL = surl } return bs) @@ -194,7 +195,7 @@ optToOutputSettings opts = do Just ts -> do res <- compileTemplate templatePath ts case res of - Left e -> throwError $ PandocTemplateError e + Left e -> throwError $ PandocTemplateError $ T.pack e Right t -> return $ Just t let writerOpts = def { @@ -222,7 +223,7 @@ optToOutputSettings opts = do , writerSlideLevel = optSlideLevel opts , writerHighlightStyle = hlStyle , writerSetextHeaders = optSetextHeaders opts - , writerEpubSubdirectory = optEpubSubdirectory opts + , writerEpubSubdirectory = T.pack $ optEpubSubdirectory opts , writerEpubMetadata = epubMetadata , writerEpubFonts = optEpubFonts opts , writerEpubChapterLevel = optEpubChapterLevel opts @@ -239,12 +240,12 @@ optToOutputSettings opts = do , outputPdfProgram = maybePdfProg } -baseWriterName :: String -> String -baseWriterName = takeWhile (\c -> c /= '+' && c /= '-') +baseWriterName :: T.Text -> T.Text +baseWriterName = T.takeWhile (\c -> c /= '+' && c /= '-') -pdfWriterAndProg :: Maybe String -- ^ user-specified writer name +pdfWriterAndProg :: Maybe T.Text -- ^ user-specified writer name -> Maybe String -- ^ user-specified pdf-engine - -> IO (String, Maybe String) -- ^ IO (writerName, maybePdfEngineProg) + -> IO (T.Text, Maybe String) -- ^ IO (writerName, maybePdfEngineProg) pdfWriterAndProg mWriter mEngine = case go mWriter mEngine of Right (writ, prog) -> return (writ, Just prog) @@ -256,20 +257,20 @@ pdfWriterAndProg mWriter mEngine = go (Just writer) (Just engine) = case find (== (baseWriterName writer, takeBaseName engine)) engines of Just _ -> Right (writer, engine) - Nothing -> Left $ "pdf-engine " ++ engine ++ - " is not compatible with output format " ++ writer + Nothing -> Left $ "pdf-engine " <> T.pack engine <> + " is not compatible with output format " <> writer writerForEngine eng = case [f | (f,e) <- engines, e == eng] of fmt : _ -> Right fmt [] -> Left $ - "pdf-engine " ++ eng ++ " not known" + "pdf-engine " <> T.pack eng <> " not known" engineForWriter "pdf" = Left "pdf writer" engineForWriter w = case [e | (f,e) <- engines, f == baseWriterName w] of eng : _ -> Right eng [] -> Left $ - "cannot produce pdf output from " ++ w + "cannot produce pdf output from " <> w -isTextFormat :: String -> Bool +isTextFormat :: T.Text -> Bool isTextFormat s = s `notElem` ["odt","docx","epub2","epub3","epub","pptx","pdf"] diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index b2f24d749..2f79c412a 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -115,7 +115,7 @@ import qualified Control.Exception as E import qualified Data.Time.LocalTime as IO (getCurrentTimeZone) import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory) import Text.Pandoc.Walk (walkM, walk) -import qualified Text.Pandoc.MediaBag as MB -- TODO text: remove Legacy +import qualified Text.Pandoc.MediaBag as MB import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified System.Environment as IO (lookupEnv) diff --git a/src/Text/Pandoc/Legacy/Translations.hs b/src/Text/Pandoc/Legacy/Translations.hs deleted file mode 100644 index f75db9a67..000000000 --- a/src/Text/Pandoc/Legacy/Translations.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Text.Pandoc.Legacy.Translations ( - TP.Term(..) - , TP.Translations - , lookupTerm - , readTranslations - ) -where - -import qualified Data.Text as T -import qualified Text.Pandoc.Translations as TP -import qualified Data.Map as M - -lookupTerm :: TP.Term -> TP.Translations -> Maybe String -lookupTerm t (TP.Translations tm) = T.unpack <$> M.lookup t tm - -readTranslations :: String -> Either String TP.Translations -readTranslations = either (Left . T.unpack) Right . TP.readTranslations . T.pack diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index d44af4233..d8c093438 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -35,6 +35,8 @@ module Text.Pandoc.Shared ( tshow, backslashEscapes, escapeTextUsing, + elemText, + notElemText, stripTrailingNewlines, trim, triml, @@ -96,6 +98,7 @@ module Text.Pandoc.Shared ( defaultBlocksSeparator, -- * Safe read safeRead, + safeStrRead, -- * User data directory defaultUserDataDirs, -- * Version @@ -240,6 +243,14 @@ escapeStringUsing' escapeTable (x:xs) = where rest = escapeStringUsing' escapeTable xs -- +-- | @True@ exactly when the @Char@ appears in the @Text@. +elemText :: Char -> T.Text -> Bool +elemText c = T.any (== c) + +-- | @True@ exactly when the @Char@ does not appear in the @Text@. +notElemText :: Char -> T.Text -> Bool +notElemText c = T.all (/= c) + -- | Strip trailing newlines from string. stripTrailingNewlines :: T.Text -> T.Text stripTrailingNewlines = T.dropWhileEnd (== '\n') @@ -1026,11 +1037,13 @@ defaultBlocksSeparator = -- safeRead :: (MonadPlus m, Read a) => T.Text -> m a -safeRead s = case reads (T.unpack s) of -- TODO text: refactor +safeRead = safeStrRead . T.unpack + +safeStrRead :: (MonadPlus m, Read a) => String -> m a +safeStrRead s = case reads s of (d,x):_ | all isSpace x -> return d _ -> mzero - -- -- User data directory -- diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs index 344a6fd80..324731c11 100644 --- a/src/Text/Pandoc/Slides.hs +++ b/src/Text/Pandoc/Slides.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Slides Copyright : Copyright (C) 2012-2019 John MacFarlane @@ -13,7 +14,7 @@ show formats (dzslides, revealjs, s5, slidy, slideous, beamer). -} module Text.Pandoc.Slides ( getSlideLevel, prepSlides ) where import Prelude -import Text.Pandoc.Legacy.Definition -- TODO text: remove Legacy +import Text.Pandoc.Definition -- | Find level of header that starts slides (defined as the least header -- level that occurs before a non-header/non-hrule in the blocks). diff --git a/src/Text/Pandoc/Translations.hs b/src/Text/Pandoc/Translations.hs index dd411a062..cbee5ef8c 100644 --- a/src/Text/Pandoc/Translations.hs +++ b/src/Text/Pandoc/Translations.hs @@ -25,7 +25,7 @@ just the language part. File format is: -} module Text.Pandoc.Translations ( Term(..) - , Translations(..) -- TODO text: temporarily exposed for Legacy + , Translations , lookupTerm , readTranslations ) diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 322bf7552..733b29ac7 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -83,7 +83,7 @@ instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where Lua.push v Lua.rawset (Lua.nthFromTop 3) -data PandocLuaException = PandocLuaException String +data PandocLuaException = PandocLuaException Text deriving (Show, Typeable) instance Exception PandocLuaException @@ -100,7 +100,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do -- check for error in lua script (later we'll change the return type -- to handle this more gracefully): when (stat /= Lua.OK) $ - Lua.tostring' (-1) >>= throw . PandocLuaException . UTF8.toString + Lua.tostring' (-1) >>= throw . PandocLuaException . UTF8.toText rendered <- docToCustom opts doc context <- metaToContext opts (fmap (literal . pack) . blockListToCustom) @@ -108,7 +108,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do meta return (pack rendered, context) let (body, context) = case res of - Left (LuaException msg) -> throw (PandocLuaException $ T.unpack msg) + Left (LuaException msg) -> throw (PandocLuaException msg) Right x -> x return $ case writerTemplate opts of diff --git a/test/Tests/Readers/Docx.hs b/test/Tests/Readers/Docx.hs index 0ee3f1c55..f2e1430b4 100644 --- a/test/Tests/Readers/Docx.hs +++ b/test/Tests/Readers/Docx.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Docx Copyright : © 2017-2019 Jesse Rosenthal, John MacFarlane @@ -79,7 +80,7 @@ testForWarningsWithOptsIO opts name docxFile expected = do df <- B.readFile docxFile logs <- runIOorExplode $ setVerbosity ERROR >> readDocx opts df >> P.getLog let warns = [m | DocxParserWarning m <- logs] - return $ test id name (unlines warns, unlines expected) + return $ test id name (T.unlines warns, unlines expected) testForWarningsWithOpts :: ReaderOptions -> String -> FilePath -> [String] -> TestTree testForWarningsWithOpts opts name docxFile expected = diff --git a/test/Tests/Readers/Odt.hs b/test/Tests/Readers/Odt.hs index 9dc93c92e..cecb9a353 100644 --- a/test/Tests/Readers/Odt.hs +++ b/test/Tests/Readers/Odt.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Odt Copyright : © 2015-2019 John MacFarlane diff --git a/test/Tests/Readers/Org/Inline/Smart.hs b/test/Tests/Readers/Org/Inline/Smart.hs index ef34cbf79..7202adc97 100644 --- a/test/Tests/Readers/Org/Inline/Smart.hs +++ b/test/Tests/Readers/Org/Inline/Smart.hs @@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -- TODO text: remove {- | Module : Tests.Readers.Org.Inline.Smart Copyright : © 2014-2019 Albert Krewinkel @@ -18,16 +17,10 @@ import Prelude import Data.Text (Text) import Test.Tasty (TestTree) import Tests.Helpers ((=?>), purely, test) --- import Text.Pandoc (ReaderOptions (readerExtensions), --- Extension (Ext_smart), def, enableExtension, --- getDefaultExtensions, readOrg) TODO text: restore -import Text.Pandoc.Builder - --- TODO text: remove -import Text.Pandoc (ReaderOptions, readerExtensions, +import Text.Pandoc (ReaderOptions (readerExtensions), Extension (Ext_smart), def, enableExtension, getDefaultExtensions, readOrg) --- +import Text.Pandoc.Builder orgSmart :: Text -> Pandoc orgSmart = purely $ diff --git a/test/Tests/Readers/Org/Shared.hs b/test/Tests/Readers/Org/Shared.hs index b1b00836c..aa253aa36 100644 --- a/test/Tests/Readers/Org/Shared.hs +++ b/test/Tests/Readers/Org/Shared.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Readers.Org.Shared Copyright : © 2014-2019 Albert Krewinkel @@ -22,13 +23,9 @@ import Data.List (intersperse) import Data.Text (Text) import Tests.Helpers (ToString, purely, test) import Test.Tasty (TestTree) --- import Text.Pandoc (Pandoc, ReaderOptions (readerExtensions), --- def, getDefaultExtensions, readOrg) TODO text: restore -import Text.Pandoc.Legacy.Builder (Inlines, smallcaps, space, spanWith, str) -- TODO text: remove Legacy - --- TODO text: remove -import Text.Pandoc --- +import Text.Pandoc (Pandoc, ReaderOptions (readerExtensions), + def, getDefaultExtensions, readOrg) +import Text.Pandoc.Builder (Inlines, smallcaps, space, spanWith, str) org :: Text -> Pandoc org = purely $ readOrg def{ readerExtensions = getDefaultExtensions "org" } @@ -42,5 +39,5 @@ spcSep :: [Inlines] -> Inlines spcSep = mconcat . intersperse space -- | Create a span for the given tag. -tagSpan :: String -> Inlines +tagSpan :: Text -> Inlines tagSpan t = spanWith ("", ["tag"], [("tag-name", t)]) . smallcaps $ str t -- cgit v1.2.3