80fde18 · typeable/pandoc

git.iko.soy/typeable/pandoc

Text.Pandoc.UTF8: change IO functions to return Text, not String.

[API change] This affects `readFile`, `getContents`, `writeFileWith`, `writeFile`, `putStrWith`, `putStr`, `putStrLnWith`, `putStrLn`. `hPutStrWith`, `hPutStr`, `hPutStrLnWith`, `hPutStrLn`, `hGetContents`. This avoids the need to uselessly create a linked list of characters when emiting output.

commit80fde18fb1d983b938476ed5b3771ed5d6158d44 authorJohn MacFarlane <jgm@berkeley.edu> dateMon 22 Feb 2021, 11:30 (6 years ago) parent607c014

11 files changed+70−68

compare with master

unifiedsplit

src/Text/Pandoc/App.hs+5−5 src/Text/Pandoc/App/CommandLineOptions.hs+20−18 src/Text/Pandoc/App/OutputSettings.hs+2−2 src/Text/Pandoc/Class/IO.hs+3−3 src/Text/Pandoc/Error.hs+1−1 src/Text/Pandoc/PDF.hs+13−12 src/Text/Pandoc/Parsing.hs+1−1 src/Text/Pandoc/UTF8.hs+20−22 test/Tests/Command.hs+1−1 test/Tests/Old.hs+3−2 test/Tests/Readers/LaTeX.hs+1−1

src/Text/Pandoc/App.hs+5−5

@@ -73,8 +73,9 @@ convertWithOpts opts = do

7373 let verbosity = optVerbosity opts

7474

7575 when (optDumpArgs opts) $

76− do UTF8.hPutStrLn stdout outputFile

77− mapM_ (UTF8.hPutStrLn stdout) (fromMaybe ["-"] $ optInputFiles opts)

76+ do UTF8.hPutStrLn stdout (T.pack outputFile)

77+ mapM_ (UTF8.hPutStrLn stdout . T.pack)

78+ (fromMaybe ["-"] $ optInputFiles opts)

7879 exitSuccess

7980

8081 let sources = case optInputFiles opts of

@@ -354,6 +355,5 @@ writeFnBinary "-" = liftIO . BL.putStr

354355writeFnBinary f = liftIO . BL.writeFile (UTF8.encodePath f)

355356

356357writerFn :: MonadIO m => IO.Newline -> FilePath -> Text -> m ()

357−-- TODO this implementation isn't maximally efficient:

358−writerFn eol "-" = liftIO . UTF8.putStrWith eol . T.unpack

359−writerFn eol f = liftIO . UTF8.writeFileWith eol f . T.unpack

358+writerFn eol "-" = liftIO . UTF8.putStrWith eol

359+writerFn eol f = liftIO . UTF8.writeFileWith eol f

src/Text/Pandoc/App/CommandLineOptions.hs+20−18

@@ -812,10 +812,10 @@ options =

812812 map (\c -> ['-',c]) shorts ++

813813 map ("--" ++) longs

814814 let allopts = unwords (concatMap optnames options)

815− UTF8.hPutStrLn stdout $ printf tpl allopts

816− (unwords readersNames)

817− (unwords writersNames)

818− (unwords $ map (T.unpack . fst) highlightingStyles)

815+ UTF8.hPutStrLn stdout $ T.pack $ printf tpl allopts

816+ (T.unpack $ T.unwords readersNames)

817+ (T.unpack $ T.unwords writersNames)

818+ (T.unpack $ T.unwords $ map fst highlightingStyles)

819819 (unwords datafiles)

820820 exitSuccess ))

821821 "" -- "Print bash completion script"

@@ -854,7 +854,7 @@ options =

854854 else if extensionEnabled x allExts

855855 then '-'

856856 else ' ') : drop 4 (show x)

857− mapM_ (UTF8.hPutStrLn stdout . showExt)

857+ mapM_ (UTF8.hPutStrLn stdout . T.pack . showExt)

858858 [ex | ex <- extList, extensionEnabled ex allExts]

859859 exitSuccess )

860860 "FORMAT")

@@ -868,14 +868,14 @@ options =

868868 , sShortname s `notElem`

869869 [T.pack "Alert", T.pack "Alert_indent"]

870870 ]

871− mapM_ (UTF8.hPutStrLn stdout) (sort langs)

871+ mapM_ (UTF8.hPutStrLn stdout . T.pack) (sort langs)

872872 exitSuccess ))

873873 ""

874874

875875 , Option "" ["list-highlight-styles"]

876876 (NoArg

877877 (\_ -> do

878− mapM_ (UTF8.hPutStrLn stdout . T.unpack . fst) highlightingStyles

878+ mapM_ (UTF8.hPutStrLn stdout . fst) highlightingStyles

879879 exitSuccess ))

880880 ""

881881

@@ -893,7 +893,7 @@ options =

893893 | T.null t -> -- e.g. for docx, odt, json:

894894 E.throwIO $ PandocCouldNotFindDataFileError $ T.pack

895895 ("templates/default." ++ arg)

896− | otherwise -> write . T.unpack $ t

896+ | otherwise -> write t

897897 Left e -> E.throwIO e

898898 exitSuccess)

899899 "FORMAT")

@@ -940,11 +940,13 @@ options =

940940 (\_ -> do

941941 prg <- getProgName

942942 defaultDatadirs <- defaultUserDataDirs

943− UTF8.hPutStrLn stdout (prg ++ " " ++ T.unpack pandocVersion ++

944− compileInfo ++

945− "\nUser data directory: " ++

946− intercalate " or " defaultDatadirs ++

947− ('\n':copyrightMessage))

943+ UTF8.hPutStrLn stdout

944+ $ T.pack

945+ $ prg ++ " " ++ T.unpack pandocVersion ++

946+ compileInfo ++

947+ "\nUser data directory: " ++

948+ intercalate " or " defaultDatadirs ++

949+ ('\n':copyrightMessage)

948950 exitSuccess ))

949951 "" -- "Print version"

950952

@@ -952,7 +954,7 @@ options =

952954 (NoArg

953955 (\_ -> do

954956 prg <- getProgName

955− UTF8.hPutStr stdout (usageMessage prg options)

957+ UTF8.hPutStr stdout (T.pack $ usageMessage prg options)

956958 exitSuccess ))

957959 "" -- "Show help"

958960 ]

@@ -1013,12 +1015,12 @@ handleUnrecognizedOption "-R" = handleUnrecognizedOption "--parse-raw"

10131015handleUnrecognizedOption x =

10141016 (("Unknown option " ++ x ++ ".") :)

10151017

1016−readersNames :: [String]

1017−readersNames = sort (map (T.unpack . fst) (readers :: [(Text, Reader PandocIO)]))

1018+readersNames :: [Text]

1019+readersNames = sort (map fst (readers :: [(Text, Reader PandocIO)]))

10181020

1019−writersNames :: [String]

1021+writersNames :: [Text]

10201022writersNames = sort

1021− ("pdf" : map (T.unpack . fst) (writers :: [(Text, Writer PandocIO)]))

1023+ ("pdf" : map fst (writers :: [(Text, Writer PandocIO)]))

10221024

10231025splitField :: String -> (String, String)

10241026splitField = second (tailDef "true") . break (`elemText` ":=")

src/Text/Pandoc/App/OutputSettings.hs+2−2

@@ -59,8 +59,8 @@ optToOutputSettings opts = do

5959 let outputFile = fromMaybe "-" (optOutputFile opts)

6060

6161 when (optDumpArgs opts) . liftIO $ do

62− UTF8.hPutStrLn stdout outputFile

63− mapM_ (UTF8.hPutStrLn stdout) (fromMaybe [] $ optInputFiles opts)

62+ UTF8.hPutStrLn stdout (T.pack outputFile)

63+ mapM_ (UTF8.hPutStrLn stdout . T.pack) (fromMaybe [] $ optInputFiles opts)

6464 exitSuccess

6565

6666 epubMetadata <- traverse readUtf8File $ optEpubMetadata opts

src/Text/Pandoc/Class/IO.hs+3−3

@@ -183,7 +183,7 @@ getModificationTime = liftIOError System.Directory.getModificationTime

183183logOutput :: (PandocMonad m, MonadIO m) => LogMessage -> m ()

184184logOutput msg = liftIO $ do

185185 UTF8.hPutStr stderr $

186− "[" ++ show (messageVerbosity msg) ++ "] "

186+ "[" <> T.pack (show (messageVerbosity msg)) <> "] "

187187 alertIndent $ T.lines $ showLogMessage msg

188188

189189-- | Prints the list of lines to @stderr@, indenting every but the first

@@ -191,10 +191,10 @@ logOutput msg = liftIO $ do

191191alertIndent :: [Text] -> IO ()

192192alertIndent [] = return ()

193193alertIndent (l:ls) = do

194− UTF8.hPutStrLn stderr $ unpack l

194+ UTF8.hPutStrLn stderr l

195195 mapM_ go ls

196196 where go l' = do UTF8.hPutStr stderr " "

197− UTF8.hPutStrLn stderr $ unpack l'

197+ UTF8.hPutStrLn stderr l'

198198

199199-- | Extract media from the mediabag into a directory.

200200extractMedia :: (PandocMonad m, MonadIO m) => FilePath -> Pandoc -> m Pandoc

src/Text/Pandoc/Error.hs+1−1

@@ -191,6 +191,6 @@ handleError (Left e) =

191191

192192err :: Int -> Text -> IO a

193193err exitCode msg = do

194− UTF8.hPutStrLn stderr (T.unpack msg)

194+ UTF8.hPutStrLn stderr msg

195195 exitWith $ ExitFailure exitCode

196196 return undefined

src/Text/Pandoc/PDF.hs+13−12

@@ -270,7 +270,7 @@ missingCharacterWarnings verbosity log' = do

270270 | isAscii c = T.singleton c

271271 | otherwise = T.pack $ c : " (U+" ++ printf "%04X" (ord c) ++ ")"

272272 let addCodePoint = T.concatMap toCodePoint

273− let warnings = [ addCodePoint (T.pack $ utf8ToString (BC.drop 19 l))

273+ let warnings = [ addCodePoint (utf8ToText (BC.drop 19 l))

274274 | l <- ls

275275 , isMissingCharacterWarning l

276276 ]

@@ -314,7 +314,7 @@ runTectonic verbosity program args' tmpDir' source = do

314314 env <- liftIO getEnvironment

315315 when (verbosity >= INFO) $ liftIO $

316316 showVerboseInfo (Just tmpDir) program programArgs env

317− (utf8ToString sourceBL)

317+ (utf8ToText sourceBL)

318318 (exit, out) <- liftIO $ E.catch

319319 (pipeProcess (Just env) program programArgs sourceBL)

320320 (handlePDFProgramNotFound program)

@@ -385,7 +385,7 @@ runTeXProgram verbosity program args numRuns tmpDir' source = do

385385 (pipeProcess (Just env'') program programArgs BL.empty)

386386 (handlePDFProgramNotFound program)

387387 when (verbosity >= INFO) $ liftIO $ do

388− UTF8.hPutStrLn stderr $ "[makePDF] Run #" ++ show runNumber

388+ UTF8.hPutStrLn stderr $ "[makePDF] Run #" <> tshow runNumber

389389 BL.hPutStr stderr out

390390 UTF8.hPutStr stderr "\n"

391391 if runNumber < numRuns

@@ -405,7 +405,7 @@ generic2pdf :: Verbosity

405405generic2pdf verbosity program args source = do

406406 env' <- getEnvironment

407407 when (verbosity >= INFO) $

408− showVerboseInfo Nothing program args env' (T.unpack source)

408+ showVerboseInfo Nothing program args env' source

409409 (exit, out) <- E.catch

410410 (pipeProcess (Just env') program args

411411 (BL.fromStrict $ UTF8.fromText source))

@@ -494,19 +494,20 @@ showVerboseInfo :: Maybe FilePath

494494 -> String

495495 -> [String]

496496 -> [(String, String)]

497− -> String

497+ -> Text

498498 -> IO ()

499499showVerboseInfo mbTmpDir program programArgs env source = do

500500 case mbTmpDir of

501501 Just tmpDir -> do

502502 UTF8.hPutStrLn stderr "[makePDF] temp dir:"

503− UTF8.hPutStrLn stderr tmpDir

503+ UTF8.hPutStrLn stderr (T.pack tmpDir)

504504 Nothing -> return ()

505505 UTF8.hPutStrLn stderr "[makePDF] Command line:"

506− UTF8.hPutStrLn stderr $ program ++ " " ++ unwords (map show programArgs)

506+ UTF8.hPutStrLn stderr $

507+ T.pack program <> " " <> T.pack (unwords (map show programArgs))

507508 UTF8.hPutStr stderr "\n"

508509 UTF8.hPutStrLn stderr "[makePDF] Environment:"

509− mapM_ (UTF8.hPutStrLn stderr . show) env

510+ mapM_ (UTF8.hPutStrLn stderr . tshow) env

510511 UTF8.hPutStr stderr "\n"

511512 UTF8.hPutStrLn stderr "[makePDF] Source:"

512513 UTF8.hPutStrLn stderr source

@@ -517,8 +518,8 @@ handlePDFProgramNotFound program e

517518 E.throwIO $ PandocPDFProgramNotFoundError $ T.pack program

518519 | otherwise = E.throwIO e

519520

520−utf8ToString :: ByteString -> String

521−utf8ToString lbs =

521+utf8ToText :: ByteString -> Text

522+utf8ToText lbs =

522523 case decodeUtf8' lbs of

523− Left _ -> BC.unpack lbs -- if decoding fails, treat as latin1

524− Right t -> TL.unpack t

524+ Left _ -> T.pack $ BC.unpack lbs -- if decoding fails, treat as latin1

525+ Right t -> TL.toStrict t

src/Text/Pandoc/Parsing.hs+1−1

@@ -1148,7 +1148,7 @@ testStringWith :: Show a

11481148 => ParserT Text ParserState Identity a

11491149 -> Text

11501150 -> IO ()

1151−testStringWith parser str = UTF8.putStrLn $ show $

1151+testStringWith parser str = UTF8.putStrLn $ tshow $

11521152 readWith parser defaultParserState str

11531153

11541154-- | Parsing options.

src/Text/Pandoc/UTF8.hs+20−22

@@ -39,67 +39,65 @@ where

3939

4040import qualified Data.ByteString.Char8 as B

4141import qualified Data.ByteString.Lazy.Char8 as BL

42+import Data.Text (Text)

4243import qualified Data.Text as T

44+import qualified Data.Text.IO as TIO

4345import qualified Data.Text.Encoding as T

4446import qualified Data.Text.Lazy as TL

4547import qualified Data.Text.Lazy.Encoding as TL

4648import Prelude hiding (getContents, putStr, putStrLn, readFile, writeFile)

4749import System.IO hiding (getContents, hGetContents, hPutStr, hPutStrLn, putStr,

4850 putStrLn, readFile, writeFile)

49−import qualified System.IO as IO

5051

51−readFile :: FilePath -> IO String

52+readFile :: FilePath -> IO Text

5253readFile f = do

5354 h <- openFile (encodePath f) ReadMode

5455 hGetContents h

5556

56−getContents :: IO String

57+getContents :: IO Text

5758getContents = hGetContents stdin

5859

59−writeFileWith :: Newline -> FilePath -> String -> IO ()

60+writeFileWith :: Newline -> FilePath -> Text -> IO ()

6061writeFileWith eol f s =

6162 withFile (encodePath f) WriteMode $ \h -> hPutStrWith eol h s

6263

63−writeFile :: FilePath -> String -> IO ()

64+writeFile :: FilePath -> Text -> IO ()

6465writeFile = writeFileWith nativeNewline

6566

66−putStrWith :: Newline -> String -> IO ()

67+putStrWith :: Newline -> Text -> IO ()

6768putStrWith eol s = hPutStrWith eol stdout s

6869

69−putStr :: String -> IO ()

70+putStr :: Text -> IO ()

7071putStr = putStrWith nativeNewline

7172

72−putStrLnWith :: Newline -> String -> IO ()

73+putStrLnWith :: Newline -> Text -> IO ()

7374putStrLnWith eol s = hPutStrLnWith eol stdout s

7475

75−putStrLn :: String -> IO ()

76+putStrLn :: Text -> IO ()

7677putStrLn = putStrLnWith nativeNewline

7778

78−hPutStrWith :: Newline -> Handle -> String -> IO ()

79+hPutStrWith :: Newline -> Handle -> Text -> IO ()

7980hPutStrWith eol h s =

8081 hSetNewlineMode h (NewlineMode eol eol) >>

81− hSetEncoding h utf8 >> IO.hPutStr h s

82+ hSetEncoding h utf8 >> TIO.hPutStr h s

8283

83−hPutStr :: Handle -> String -> IO ()

84+hPutStr :: Handle -> Text -> IO ()

8485hPutStr = hPutStrWith nativeNewline

8586

86−hPutStrLnWith :: Newline -> Handle -> String -> IO ()

87+hPutStrLnWith :: Newline -> Handle -> Text -> IO ()

8788hPutStrLnWith eol h s =

8889 hSetNewlineMode h (NewlineMode eol eol) >>

89− hSetEncoding h utf8 >> IO.hPutStrLn h s

90+ hSetEncoding h utf8 >> TIO.hPutStrLn h s

9091

91−hPutStrLn :: Handle -> String -> IO ()

92+hPutStrLn :: Handle -> Text -> IO ()

9293hPutStrLn = hPutStrLnWith nativeNewline

9394

94−hGetContents :: Handle -> IO String

95−hGetContents = fmap toString . B.hGetContents

96−-- hGetContents h = hSetEncoding h utf8_bom

97−-- >> hSetNewlineMode h universalNewlineMode

98−-- >> IO.hGetContents h

95+hGetContents :: Handle -> IO Text

96+hGetContents = fmap toText . B.hGetContents

9997

10098-- | Convert UTF8-encoded ByteString to Text, also

10199-- removing '\r' characters.

102−toText :: B.ByteString -> T.Text

100+toText :: B.ByteString -> Text

103101toText = T.decodeUtf8 . filterCRs . dropBOM

104102 where dropBOM bs =

105103 if "\xEF\xBB\xBF" `B.isPrefixOf` bs

@@ -127,7 +125,7 @@ toTextLazy = TL.decodeUtf8 . filterCRs . dropBOM

127125toStringLazy :: BL.ByteString -> String

128126toStringLazy = TL.unpack . toTextLazy

129127

130−fromText :: T.Text -> B.ByteString

128+fromText :: Text -> B.ByteString

131129fromText = T.encodeUtf8

132130

133131fromTextLazy :: TL.Text -> BL.ByteString

test/Tests/Command.hs+1−1

@@ -130,7 +130,7 @@ runCommandTest testExePath fp num code =

130130 let cmdline = "% " <> cmd

131131 let x = cmdline <> "\n" <> input <> "^D\n" <> norm

132132 let y = cmdline <> "\n" <> input <> "^D\n" <> newnorm

133− let updated = T.unpack $ T.replace (T.pack x) (T.pack y) (T.pack raw)

133+ let updated = T.replace (T.pack x) (T.pack y) raw

134134 UTF8.writeFile fp' updated

135135

136136extractCommandTest :: FilePath -> FilePath -> TestTree

test/Tests/Old.hs+3−2

@@ -22,6 +22,7 @@ import Test.Tasty (TestTree, testGroup)

2222import Test.Tasty.Golden.Advanced (goldenTest)

2323import Tests.Helpers hiding (test)

2424import qualified Text.Pandoc.UTF8 as UTF8

25+import qualified Data.Text as T

2526

2627tests :: FilePath -> [TestTree]

2728tests pandocPath =

@@ -231,7 +232,7 @@ tests pandocPath =

231232-- makes sure file is fully closed after reading

232233readFile' :: FilePath -> IO String

233234readFile' f = do s <- UTF8.readFile f

234− return $! (length s `seq` s)

235+ return $! (T.length s `seq` T.unpack s)

235236

236237lhsWriterTests :: FilePath -> String -> [TestTree]

237238lhsWriterTests pandocPath format

@@ -333,7 +334,7 @@ testWithNormalize normalizer pandocPath testname opts inp norm =

333334 $ UTF8.toStringLazy out

334335 -- filter \r so the tests will work on Windows machines

335336 else fail $ "Pandoc failed with error code " ++ show ec

336− updateGolden = UTF8.writeFile norm

337+ updateGolden = UTF8.writeFile norm . T.pack

337338 options = ["--data-dir=../data","--quiet"] ++ [inp] ++ opts

338339

339340compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String)

test/Tests/Readers/LaTeX.hs+1−1

@@ -54,7 +54,7 @@ tokUntokRt s = untokenize (tokenize "random" t) == t

5454tests :: [TestTree]

5555tests = [ testGroup "tokenization"

5656 [ testCase "tokenizer round trip on test case" $ do

57− orig <- T.pack <$> UTF8.readFile "../test/latex-reader.latex"

57+ orig <- UTF8.readFile "../test/latex-reader.latex"

5858 let new = untokenize $ tokenize "../test/latex-reader.latex"

5959 orig

6060 assertEqual "untokenize . tokenize is identity" orig new