diff options
| author | John MacFarlane <[email protected]> | 2021-03-11 15:49:27 -0800 |
|---|---|---|
| committer | John MacFarlane <[email protected]> | 2021-03-13 15:05:37 -0800 |
| commit | 8be95ad8e5150d5cab66c4abdf59baaf4670c6c8 (patch) | |
| tree | 9655036efbaabda6a2a7802dc971c7fba5a987ca | |
| parent | 35b66a76718205c303f416bf0afc01c098e8a171 (diff) | |
Use custom Prelude based on relude.relude
The Prelude now longer exports partial functions, so
a large number of uses of these functions in the
code base have been rewritten.
A .ghci file has been added; this is necessary for
ghci to work properly with the custom Prelude.
Currently there are lots of compiler warnings.
We should either fix these or go to using a custom
Prelude that changes less than relude.
149 files changed, 823 insertions, 779 deletions
@@ -0,0 +1,4 @@ +:load prelude/Prelude.hs +import Prelude +:set -XImplicitPrelude +:set -XOverloadedStrings diff --git a/.hlint.yaml b/.hlint.yaml index e482b2b37..1aa7b0c37 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -17,6 +17,7 @@ - ignore: {name: "Use camelCase"} - ignore: {name: "Use fmap"} # specific for GHC 7.8 compat - ignore: {name: "Use isDigit"} +- ignore: {name: "Use unwords"} - ignore: name: "Monad law, left identity" @@ -112,3 +113,5 @@ # Define some custom infix operators # - fixity: infixr 3 ~^#^~ +# + @@ -34,7 +34,7 @@ full: stack install --flag 'pandoc:embed_data_files' --flag 'pandoc:trypandoc' --bench --no-run-benchmarks --test --test-arguments='-j4 --hide-successes' --ghc-options '-Wall -Werror -fno-warn-unused-do-bind -O0 -j4 $(GHCOPTS)' ghci: - stack ghci --flag 'pandoc:embed_data_files' + stack ghci --ghc-options=-XNoImplicitPrelude --flag 'pandoc:embed_data_files' haddock: stack haddock @@ -45,7 +45,7 @@ test: stack test --flag 'pandoc:embed_data_files' --fast --test-arguments='-j4 --hide-successes $(TESTARGS)' --ghc-options '$(GHCOPTS)' ghcid: - ghcid -c "stack repl --flag 'pandoc:embed_data_files'" + ghcid -c "stack repl --ghc-options=-XNoImplicitPrelude --flag 'pandoc:embed_data_files'" ghcid-test: ghcid -c "stack repl --ghc-options=-XNoImplicitPrelude --flag 'pandoc:embed_data_files' --ghci-options=-fobject-code pandoc:lib pandoc:test-pandoc" diff --git a/benchmark/benchmark-pandoc.hs b/benchmark/benchmark-pandoc.hs index 1315166b9..f956c426c 100644 --- a/benchmark/benchmark-pandoc.hs +++ b/benchmark/benchmark-pandoc.hs @@ -27,6 +27,7 @@ import Test.Tasty.Bench import qualified Data.ByteString.Lazy as BL import Data.Maybe (mapMaybe) import Data.List (sortOn) +import Prelude hiding (Reader) readerBench :: Pandoc -> T.Text diff --git a/pandoc.cabal b/pandoc.cabal index 347099629..9cc0dcef3 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -398,16 +398,14 @@ flag trypandoc common common-options default-language: Haskell2010 - build-depends: base >= 4.9 && < 5 + build-depends: base >= 4.10 && < 5, + relude >= 1 && < 1.1 ghc-options: -Wall -fno-warn-unused-do-bind -Wincomplete-record-updates -Wnoncanonical-monad-instances - if impl(ghc < 8.4) - hs-source-dirs: prelude - other-modules: Prelude - build-depends: base-compat >= 0.9 - other-extensions: NoImplicitPrelude + other-extensions: NoImplicitPrelude + hs-source-dirs: prelude if os(windows) cpp-options: -D_WINDOWS diff --git a/prelude/Prelude.hs b/prelude/Prelude.hs index 2d81ec1ff..9e8820345 100644 --- a/prelude/Prelude.hs +++ b/prelude/Prelude.hs @@ -1,15 +1,14 @@ {-# LANGUAGE NoImplicitPrelude #-} --- The intent is that this Prelude provide the API of --- the base 4.11 Prelude in a way that is portable for --- all base versions. - module Prelude ( - module Prelude.Compat -, Semigroup(..) + module Relude +, module Relude.Extra.Foldable1 +, lookup ) where -import Prelude.Compat -import Data.Semigroup (Semigroup(..)) -- includes (<>) +import Relude hiding (Alternative(..), optional, getOption, lookupEnv, getArgs) +import Relude.Extra.Foldable1 +-- not sure why these are left out of Relude.List.Reexport +import Data.List (lookup) diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 6b45e5418..8267e894c 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -42,7 +42,6 @@ import qualified Data.Text.Encoding.Error as TE import qualified Data.Text.Encoding.Error as TSE import Network.URI (URI (..), parseURI) import System.Directory (doesDirectoryExist) -import System.Exit (exitSuccess) import System.FilePath ( takeBaseName, takeExtension ) import System.IO (nativeNewline, stdout) import qualified System.IO as IO (Newline (..)) @@ -69,6 +68,7 @@ import qualified Text.Pandoc.UTF8 as UTF8 import System.Posix.IO (stdOutput) import System.Posix.Terminal (queryTerminal) #endif +import Prelude hiding (Reader) convertWithOpts :: Opt -> IO () convertWithOpts opts = do diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs index b4483f756..a2739e6af 100644 --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -43,7 +43,6 @@ import Safe (tailDef) import Skylighting (Style, Syntax (..), defaultSyntaxMap, parseTheme) import System.Console.GetOpt import System.Environment (getArgs, getProgName) -import System.Exit (exitSuccess) import System.FilePath import System.IO (stdout) import Text.DocTemplates (Context (..), ToContext (toVal), Val (..)) @@ -71,6 +70,8 @@ import qualified Data.Map as M import qualified Data.Text as T import qualified Text.Pandoc.UTF8 as UTF8 +import Prelude hiding (Option, Reader) + parseOptions :: [OptDescr (Opt -> IO Opt)] -> Opt -> IO Opt parseOptions options' defaults = do rawArgs <- map UTF8.decodeArg <$> getArgs @@ -88,12 +89,12 @@ parseOptionsFromArgs options' defaults prg rawArgs = do unrecognizedOpts unless (null errors && null unknownOptionErrors) $ - E.throwIO $ PandocOptionError $ T.pack $ - concat errors ++ unlines unknownOptionErrors ++ - ("Try " ++ prg ++ " --help for more information.") + E.throwIO $ PandocOptionError $ T.pack (concat errors) <> + T.unlines unknownOptionErrors <> + ("Try " <> T.pack prg <> " --help for more information.") -- thread option data structure through all supplied option actions - opts <- foldl (>>=) (return defaults) actions + opts <- foldl' (>>=) (return defaults) actions let mbArgs = case args of [] -> Nothing xs -> Just xs @@ -813,12 +814,12 @@ options = let optnames (Option shorts longs _ _) = map (\c -> ['-',c]) shorts ++ map ("--" ++) longs - let allopts = unwords (concatMap optnames options) + let allopts = intercalate " " (concatMap optnames options) UTF8.hPutStrLn stdout $ T.pack $ printf tpl allopts (T.unpack $ T.unwords readersNames) (T.unpack $ T.unwords writersNames) (T.unpack $ T.unwords $ map fst highlightingStyles) - (unwords datafiles) + (intercalate " " datafiles) exitSuccess )) "" -- "Print bash completion script" @@ -987,9 +988,9 @@ compileInfo = VERSION_skylighting ++ ",\nciteproc " ++ VERSION_citeproc ++ ", ipynb " ++ VERSION_ipynb -handleUnrecognizedOption :: String -> [String] -> [String] +handleUnrecognizedOption :: String -> [Text] -> [Text] handleUnrecognizedOption "--smart" = - (("--smart/-S has been removed. Use +smart or -smart extension instead.\n" ++ + (("--smart/-S has been removed. Use +smart or -smart extension instead.\n" <> "For example: pandoc -f markdown+smart -t markdown-smart.") :) handleUnrecognizedOption "--normalize" = ("--normalize has been removed. Normalization is now automatic." :) @@ -1014,7 +1015,7 @@ handleUnrecognizedOption "--epub-stylesheet" = ("--epub-stylesheet has been removed. Use --css instead.\n" :) handleUnrecognizedOption "-R" = handleUnrecognizedOption "--parse-raw" handleUnrecognizedOption x = - (("Unknown option " ++ x ++ ".") :) + (("Unknown option " <> T.pack x <> ".") :) readersNames :: [Text] readersNames = sort (map fst (readers :: [(Text, Reader PandocIO)])) diff --git a/src/Text/Pandoc/App/FormatHeuristics.hs b/src/Text/Pandoc/App/FormatHeuristics.hs index 65a1a7b82..424f6071a 100644 --- a/src/Text/Pandoc/App/FormatHeuristics.hs +++ b/src/Text/Pandoc/App/FormatHeuristics.hs @@ -16,7 +16,7 @@ module Text.Pandoc.App.FormatHeuristics import Data.Char (toLower) import Data.Text (Text) -import System.FilePath (takeExtension) +import System.FilePath (takeExtension, FilePath) -- Determine default format based on file extensions. formatFromFilePaths :: [FilePath] -> Maybe Text diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs index 3864ab188..1f42a6866 100644 --- a/src/Text/Pandoc/App/OutputSettings.hs +++ b/src/Text/Pandoc/App/OutputSettings.hs @@ -31,7 +31,6 @@ import Data.Maybe (fromMaybe) import Skylighting (defaultSyntaxMap) import Skylighting.Parser (addSyntaxDefinition, parseSyntaxDefinition) import System.Directory (getCurrentDirectory) -import System.Exit (exitSuccess) import System.FilePath import System.IO (stdout) import Text.Pandoc diff --git a/src/Text/Pandoc/Citeproc.hs b/src/Text/Pandoc/Citeproc.hs index af302f782..5002d0ee5 100644 --- a/src/Text/Pandoc/Citeproc.hs +++ b/src/Text/Pandoc/Citeproc.hs @@ -33,7 +33,6 @@ import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Walk (query, walk, walkM) import Control.Applicative ((<|>)) import Control.Monad.Except (catchError, throwError) -import Control.Monad.State (State, evalState, get, put, runState) import Data.Aeson (eitherDecode) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as L @@ -406,13 +405,13 @@ mvPunct moveNotes locale (q : s : x : ys) (dropTextWhile isPunctuation (B.fromList ys))) else q : x : mvPunct moveNotes locale ys -- 'x[^1],' -> 'x,[^1]' -mvPunct moveNotes locale (Cite cs ils : ys) - | not (null ils) - , isNote (last ils) +mvPunct moveNotes locale (Cite cs (i:is) : ys) + | Just True == viaNonEmpty (isNote . last) (i:is) , startWithPunct ys , moveNotes = let s = stringify ys spunct = T.takeWhile isPunctuation s + ils = i :| is in Cite cs (init ils ++ [Str spunct | not (endWithPunct False (init ils))] ++ [last ils]) : @@ -556,7 +555,7 @@ linkifyVariables ref = extractText :: Val Inlines -> Text extractText (TextVal x) = x -extractText (FancyVal x) = toText x +extractText (FancyVal x) = Citeproc.toText x extractText (NumVal n) = T.pack (show n) extractText _ = mempty diff --git a/src/Text/Pandoc/Citeproc/BibTeX.hs b/src/Text/Pandoc/Citeproc/BibTeX.hs index c0752dadc..af3d0908a 100644 --- a/src/Text/Pandoc/Citeproc/BibTeX.hs +++ b/src/Text/Pandoc/Citeproc/BibTeX.hs @@ -1203,10 +1203,10 @@ toName opts ils = do -- whole string. von is the longest sequence of whitespace -- separated words whose last word starts with lower case -- and that is not the whole string. - [fvl] -> let (caps', rest') = span isCapitalized fvl - in if null rest' && not (null caps') - then (init caps', [last caps'], []) - else (caps', rest', []) + [fvl] -> case span isCapitalized fvl of + (x:xs, []) -> + (init (x :| xs), [last (x :| xs)], []) + (caps', rest') -> (caps', rest', []) [vl,f] -> (f, vl, []) (vl:j:f:_) -> (f, vl, j ) [] -> ([], [], []) @@ -1215,10 +1215,10 @@ toName opts ils = do if bibtex then case span isCapitalized $ reverse vonlast of ([],w:ws) -> (reverse ws, [w]) - (vs, ws) -> (reverse ws, reverse vs) + (vs, ws) -> (reverse ws, reverse vs) else case break isCapitalized vonlast of - (vs@(_:_), []) -> (init vs, [last vs]) - (vs, ws) -> (vs, ws) + (v:vs, []) -> (init (v :| vs), [last (v :| vs)]) + (vs, ws) -> (vs, ws) let prefix = T.unwords $ map stringify von let family = T.unwords $ map stringify lastname let suffix = T.unwords $ map stringify jr diff --git a/src/Text/Pandoc/Citeproc/Locator.hs b/src/Text/Pandoc/Citeproc/Locator.hs index dba762c02..961becd7d 100644 --- a/src/Text/Pandoc/Citeproc/Locator.hs +++ b/src/Text/Pandoc/Citeproc/Locator.hs @@ -139,7 +139,7 @@ pBalancedBraces braces p = try $ do where except = notFollowedBy pBraces >> p -- outer and inner - surround = foldl (\a (open, close) -> sur open close except <|> a) + surround = foldl' (\a (open, close) -> sur open close except <|> a) except braces diff --git a/src/Text/Pandoc/Class/PandocIO.hs b/src/Text/Pandoc/Class/PandocIO.hs index 63cb94155..eef4a3e78 100644 --- a/src/Text/Pandoc/Class/PandocIO.hs +++ b/src/Text/Pandoc/Class/PandocIO.hs @@ -22,7 +22,7 @@ module Text.Pandoc.Class.PandocIO import Control.Monad.Except (ExceptT, MonadError, runExceptT) import Control.Monad.IO.Class (MonadIO) -import Control.Monad.State (StateT, evalStateT, lift, get, put) +import Control.Monad.State (lift) import Data.Default (Default (def)) import Text.Pandoc.Class.CommonState (CommonState (..)) import Text.Pandoc.Class.PandocMonad diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs index 86c8de79e..aa37c21db 100644 --- a/src/Text/Pandoc/Class/PandocMonad.hs +++ b/src/Text/Pandoc/Class/PandocMonad.hs @@ -612,7 +612,7 @@ checkExistence fn = do -- | Canonicalizes a file path by removing redundant @.@ and @..@. makeCanonical :: FilePath -> FilePath makeCanonical = Posix.joinPath . transformPathParts . splitDirectories - where transformPathParts = reverse . foldl go [] + where transformPathParts = reverse . foldl' go [] go as "." = as go (_:as) ".." = as go as x = x : as diff --git a/src/Text/Pandoc/Class/PandocPure.hs b/src/Text/Pandoc/Class/PandocPure.hs index 23c941839..2c1e65007 100644 --- a/src/Text/Pandoc/Class/PandocPure.hs +++ b/src/Text/Pandoc/Class/PandocPure.hs @@ -38,6 +38,7 @@ import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) import Data.Time.LocalTime (TimeZone, utc) import Data.Word (Word8) import System.Directory (doesDirectoryExist, getDirectoryContents) +import System.IO.Error (userError) import System.FilePath ((</>)) import System.FilePath.Glob (match, compile) import System.Random (StdGen, split, mkStdGen) diff --git a/src/Text/Pandoc/Error.hs b/src/Text/Pandoc/Error.hs index 8102f04cc..281b2714f 100644 --- a/src/Text/Pandoc/Error.hs +++ b/src/Text/Pandoc/Error.hs @@ -26,7 +26,7 @@ import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) import Network.HTTP.Client (HttpException) -import System.Exit (ExitCode (..), exitWith) +import System.Exit (ExitCode (..)) import System.IO (stderr) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Printf (printf) @@ -34,6 +34,7 @@ import Text.Parsec.Error import Text.Parsec.Pos hiding (Line) import Text.Pandoc.Shared (tshow) import Citeproc (CiteprocError, prettyCiteprocError) +import System.IO.Error (IOError, ioError) type Input = Text @@ -87,9 +88,13 @@ renderError e = errColumn = sourceColumn errPos ls = T.lines input <> [""] errorInFile = if length ls > errLine - 1 - then T.concat ["\n", ls !! (errLine - 1) - ,"\n", T.replicate (errColumn - 1) " " - ,"^"] + then + case ls !!? (errLine - 1) of + Nothing -> "" + Just x -> + T.concat ["\n", x, "\n", + T.replicate (errColumn - 1) " ", + "^"] else "" in "\nError at " <> tshow err' <> -- if error comes from a chunk or included file, diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs index 3b96f9e04..9419a204a 100644 --- a/src/Text/Pandoc/Extensions.hs +++ b/src/Text/Pandoc/Extensions.hs @@ -593,7 +593,7 @@ parseFormatSpec :: T.Text parseFormatSpec = parse formatSpec "" where formatSpec = do name <- formatName - (extsToEnable, extsToDisable) <- foldl (flip ($)) ([],[]) <$> + (extsToEnable, extsToDisable) <- foldl' (flip ($)) ([],[]) <$> many extMod return (T.pack name, reverse extsToEnable, reverse extsToDisable) formatName = many1 $ noneOf "-+" diff --git a/src/Text/Pandoc/Filter/Lua.hs b/src/Text/Pandoc/Filter/Lua.hs index c238e53d9..5bbf29a10 100644 --- a/src/Text/Pandoc/Filter/Lua.hs +++ b/src/Text/Pandoc/Filter/Lua.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Filter.Lua Copyright : Copyright (C) 2006-2021 John MacFarlane diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index bb1aa6351..8a103d2b8 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -53,13 +53,14 @@ import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Codec.Picture.Metadata as Metadata import qualified Codec.Picture.Metadata.Exif as Exif import Codec.Picture (decodeImageWithMetadata) +import qualified GHC.Show -- quick and dirty functions to get image sizes -- algorithms borrowed from wwwis.pl data ImageType = Png | Gif | Jpeg | Svg | Pdf | Eps | Emf deriving Show data Direction = Width | Height -instance Show Direction where +instance GHC.Show.Show Direction where show Width = "width" show Height = "height" diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index efd2188f1..438dd4351 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -43,7 +43,7 @@ data Verbosity = ERROR | WARNING | INFO deriving (Show, Read, Eq, Data, Enum, Ord, Bounded, Typeable, Generic) instance ToJSON Verbosity where - toJSON x = toJSON (show x) + toJSON x = toJSON (show x :: Text) instance FromJSON Verbosity where parseJSON (String t) = case t of @@ -108,7 +108,7 @@ data LogMessage = instance ToJSON LogMessage where toJSON x = object $ "verbosity" .= toJSON (messageVerbosity x) : - "type" .= toJSON (show $ toConstr x) : + "type" .= toJSON (show (toConstr x) :: Text) : case x of SkippedContent s pos -> ["contents" .= s, diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index bffe01a34..07e13ab0c 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -204,7 +204,7 @@ walkMeta lf (Pandoc m bs) = do walkPandoc :: LuaFilter -> Pandoc -> Lua Pandoc walkPandoc (LuaFilter fnMap) = - case foldl mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of + case foldl' mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of Just fn -> \x -> runFilterFunction fn x *> singleElement x Nothing -> return diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs index 8e12d232c..b9550ba75 100644 --- a/src/Text/Pandoc/Lua/Marshaling/AST.hs +++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs @@ -1,6 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Marshaling.AST Copyright : © 2012-2021 John MacFarlane @@ -78,12 +79,12 @@ instance Peekable Citation where <*> LuaUtil.rawField idx "hash" instance Pushable Alignment where - push = Lua.push . show + push = Lua.push . show @String instance Peekable Alignment where peek = Lua.peekRead instance Pushable CitationMode where - push = Lua.push . show + push = Lua.push . show @String instance Peekable CitationMode where peek = Lua.peekRead @@ -93,22 +94,22 @@ instance Peekable Format where peek idx = Format <$!> Lua.peek idx instance Pushable ListNumberDelim where - push = Lua.push . show + push = Lua.push . show @String instance Peekable ListNumberDelim where peek = Lua.peekRead instance Pushable ListNumberStyle where - push = Lua.push . show + push = Lua.push . show @String instance Peekable ListNumberStyle where peek = Lua.peekRead instance Pushable MathType where - push = Lua.push . show + push = Lua.push . show @String instance Peekable MathType where peek = Lua.peekRead instance Pushable QuoteType where - push = Lua.push . show + push = Lua.push . show @String instance Peekable QuoteType where peek = Lua.peekRead diff --git a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs b/src/Text/Pandoc/Lua/Marshaling/CommonState.hs index 147197c5d..7701ac35b 100644 --- a/src/Text/Pandoc/Lua/Marshaling/CommonState.hs +++ b/src/Text/Pandoc/Lua/Marshaling/CommonState.hs @@ -1,6 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Marshaling.CommonState Copyright : © 2012-2021 John MacFarlane @@ -66,7 +67,7 @@ pairsCommonState st = do (key, pushValue):_ -> 2 <$ (Lua.push key *> pushValue st) Lua.TypeString -> do key <- Lua.peek idx - case tail $ dropWhile ((/= key) . fst) commonStateFields of + case drop 1 $ dropWhile ((/= key) . fst) commonStateFields of [] -> 2 <$ (Lua.pushnil *> Lua.pushnil) (nextKey, pushValue):_ -> 2 <$ (Lua.push nextKey *> pushValue st) _ -> 2 <$ (Lua.pushnil *> Lua.pushnil) @@ -81,7 +82,7 @@ commonStateFields = , ("source_url", Lua.push . Lua.Optional . stSourceURL) , ("user_data_dir", Lua.push . Lua.Optional . stUserDataDir) , ("trace", Lua.push . stTrace) - , ("verbosity", Lua.push . show . stVerbosity) + , ("verbosity", Lua.push . show @String . stVerbosity) ] -- | Name used by Lua for the @CommonState@ type. diff --git a/src/Text/Pandoc/Lua/Marshaling/List.hs b/src/Text/Pandoc/Lua/Marshaling/List.hs index 0446302a1..fcc43b0ca 100644 --- a/src/Text/Pandoc/Lua/Marshaling/List.hs +++ b/src/Text/Pandoc/Lua/Marshaling/List.hs @@ -20,8 +20,8 @@ import Data.Data (Data) import Foreign.Lua (Peekable, Pushable) import Text.Pandoc.Walk (Walkable (..)) import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor) - import qualified Foreign.Lua as Lua +import Prelude hiding (fromList) -- | List wrapper which is marshalled as @pandoc.List@. newtype List a = List { fromList :: [a] } diff --git a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs b/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs index dd7bf2e61..01af3660b 100644 --- a/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs +++ b/src/Text/Pandoc/Lua/Marshaling/ReaderOptions.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -31,7 +32,7 @@ import qualified Text.Pandoc.Lua.Util as LuaUtil -- Reader Options -- instance Pushable Extensions where - push exts = Lua.push (show exts) + push exts = Lua.push (show @String exts) instance Pushable TrackChanges where push = Lua.push . showConstr . toConstr diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index 8d30f9a0c..c06b556ce 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Lua.Module.Pandoc Copyright : Copyright © 2017-2021 Albert Krewinkel @@ -77,7 +78,7 @@ read content formatSpecOrNil = liftPandocLua $ do "Unknown reader: " <> f Left (PandocUnsupportedExtensionError e f) -> Lua.raiseError $ "Extension " <> e <> " not supported for " <> f - Left e -> Lua.raiseError $ show e + Left e -> Lua.raiseError $ show @String e -- | Pipes input through a command. pipe :: String -- ^ path to executable diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs index 3249bcdeb..346e6eb89 100644 --- a/src/Text/Pandoc/MediaBag.hs +++ b/src/Text/Pandoc/MediaBag.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.MediaBag Copyright : Copyright (C) 2014-2015, 2017-2021 John MacFarlane @@ -29,6 +30,7 @@ import Data.Typeable (Typeable) import System.FilePath import qualified System.FilePath.Posix as Posix import Text.Pandoc.MIME (MimeType, getMimeTypeDef) +import GHC.Show -- | A container for a collection of binary resources, with names and -- mime types. Note that a 'MediaBag' is a Monoid, so 'mempty' @@ -38,7 +40,7 @@ newtype MediaBag = MediaBag (M.Map [FilePath] (MimeType, BL.ByteString)) deriving (Semigroup, Monoid, Data, Typeable) instance Show MediaBag where - show bag = "MediaBag " ++ show (mediaDirectory bag) + show bag = "MediaBag " ++ GHC.Show.show (mediaDirectory bag) -- | Delete a media item from a 'MediaBag', or do nothing if no item corresponds -- to the given path. diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs index 6f462aad5..ca49216a0 100644 --- a/src/Text/Pandoc/PDF.hs +++ b/src/Text/Pandoc/PDF.hs @@ -23,11 +23,11 @@ import qualified Data.ByteString as BS import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BC +import qualified Data.Text.Lazy.Encoding as TLE import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL -import Data.Text.Lazy.Encoding (decodeUtf8') import Text.Printf (printf) import Data.Char (ord, isAscii, isSpace) import System.Directory @@ -74,7 +74,7 @@ makePDF :: String -- ^ pdf creator (pdflatex, lualatex, xelatex, -> (WriterOptions -> Pandoc -> PandocIO Text) -- ^ writer -> WriterOptions -- ^ options -> Pandoc -- ^ document - -> PandocIO (Either ByteString ByteString) + -> PandocIO (Either BL.ByteString BL.ByteString) makePDF program pdfargs writer opts doc = case takeBaseName program of "wkhtmltopdf" -> makeWithWkhtmltopdf program pdfargs writer opts doc @@ -136,7 +136,7 @@ makeWithWkhtmltopdf :: String -- ^ wkhtmltopdf or path -> (WriterOptions -> Pandoc -> PandocIO Text) -- ^ writer -> WriterOptions -- ^ options -> Pandoc -- ^ document - -> PandocIO (Either ByteString ByteString) + -> PandocIO (Either BL.ByteString BL.ByteString) makeWithWkhtmltopdf program pdfargs writer opts doc@(Pandoc meta _) = do let mathArgs = case writerHTMLMathMethod opts of -- with MathJax, wait til all math is rendered: @@ -225,7 +225,7 @@ tectonic2pdf :: Verbosity -- ^ Verbosity level -> [String] -- ^ Arguments to the latex-engine -> FilePath -- ^ temp directory for output -> Text -- ^ tex source - -> PandocIO (Either ByteString ByteString) + -> PandocIO (Either BL.ByteString BL.ByteString) tectonic2pdf verbosity program args tmpDir source = do (exit, log', mbPdf) <- runTectonic verbosity program args tmpDir source case (exit, mbPdf) of @@ -240,7 +240,7 @@ tex2pdf :: Verbosity -- ^ Verbosity level -> [String] -- ^ Arguments to the latex-engine -> FilePath -- ^ temp directory for output -> Text -- ^ tex source - -> PandocIO (Either ByteString ByteString) + -> PandocIO (Either BL.ByteString BL.ByteString) tex2pdf verbosity program args tmpDir source = do let numruns | takeBaseName program == "latexmk" = 1 | "\\tableofcontents" `T.isInfixOf` source = 3 -- to get page numbers @@ -262,7 +262,7 @@ tex2pdf verbosity program args tmpDir source = do missingCharacterWarnings verbosity log' return $ Right pdf -missingCharacterWarnings :: Verbosity -> ByteString -> PandocIO () +missingCharacterWarnings :: Verbosity -> BL.ByteString -> PandocIO () missingCharacterWarnings verbosity log' = do let ls = BC.lines log' let isMissingCharacterWarning = BC.isPrefixOf "Missing character: " @@ -279,7 +279,7 @@ missingCharacterWarnings verbosity log' = do -- parsing output -extractMsg :: ByteString -> ByteString +extractMsg :: BL.ByteString -> BL.ByteString extractMsg log' = do let msg' = dropWhile (not . ("!" `BC.isPrefixOf`)) $ BC.lines log' let (msg'',rest) = break ("l." `BC.isPrefixOf`) msg' @@ -288,7 +288,7 @@ extractMsg log' = do then log' else BC.unlines (msg'' ++ lineno) -extractConTeXtMsg :: ByteString -> ByteString +extractConTeXtMsg :: BL.ByteString -> BL.ByteString extractConTeXtMsg log' = do let msg' = take 1 $ dropWhile (not . ("tex error" `BC.isPrefixOf`)) $ BC.lines log' @@ -299,7 +299,7 @@ extractConTeXtMsg log' = do -- running tex programs runTectonic :: Verbosity -> String -> [String] -> FilePath - -> Text -> PandocIO (ExitCode, ByteString, Maybe ByteString) + -> Text -> PandocIO (ExitCode, BL.ByteString, Maybe BL.ByteString) runTectonic verbosity program args' tmpDir' source = do let getOutDir acc (a:b:xs) = if a `elem` ["-o", "--outdir"] then (reverse acc ++ xs, Just b) @@ -328,7 +328,7 @@ runTectonic verbosity program args' tmpDir' source = do -- read a pdf that has been written to a temporary directory, and optionally read -- logs -getResultingPDF :: Maybe String -> String -> PandocIO (Maybe ByteString, Maybe ByteString) +getResultingPDF :: Maybe String -> String -> PandocIO (Maybe BL.ByteString, Maybe BL.ByteString) getResultingPDF logFile pdfFile = do pdfExists <- liftIO $ doesFileExist pdfFile pdf <- if pdfExists @@ -353,7 +353,7 @@ getResultingPDF logFile pdfFile = do -- contents of stdout, contents of produced PDF if any). Rerun -- a fixed number of times to resolve references. runTeXProgram :: Verbosity -> String -> [String] -> Int -> FilePath - -> Text -> PandocIO (ExitCode, ByteString, Maybe ByteString) + -> Text -> PandocIO (ExitCode, BL.ByteString, Maybe BL.ByteString) runTeXProgram verbosity program args numRuns tmpDir' source = do let isOutdirArg x = "-outdir=" `isPrefixOf` x || "-output-directory=" `isPrefixOf` x @@ -401,7 +401,7 @@ generic2pdf :: Verbosity -> String -> [String] -> Text - -> IO (Either ByteString ByteString) + -> IO (Either BL.ByteString BL.ByteString) generic2pdf verbosity program args source = do env' <- getEnvironment when (verbosity >= INFO) $ @@ -419,7 +419,7 @@ html2pdf :: Verbosity -- ^ Verbosity level -> String -- ^ Program (wkhtmltopdf, weasyprint, prince, or path) -> [String] -- ^ Args to program -> Text -- ^ HTML5 source - -> IO (Either ByteString ByteString) + -> IO (Either BL.ByteString BL.ByteString) html2pdf verbosity program args source = -- write HTML to temp file so we don't have to rewrite -- all links in `a`, `img`, `style`, `script`, etc. tags, @@ -458,7 +458,7 @@ context2pdf :: Verbosity -- ^ Verbosity level -> [String] -- ^ extra arguments -> FilePath -- ^ temp directory for output -> Text -- ^ ConTeXt source - -> PandocIO (Either ByteString ByteString) + -> PandocIO (Either BL.ByteString BL.ByteString) context2pdf verbosity program pdfargs tmpDir source = liftIO $ inDirectory tmpDir $ do let file = "input.tex" @@ -504,7 +504,7 @@ showVerboseInfo mbTmpDir program programArgs env source = do Nothing -> return () UTF8.hPutStrLn stderr "[makePDF] Command line:" UTF8.hPutStrLn stderr $ - T.pack program <> " " <> T.pack (unwords (map show programArgs)) + T.pack program <> " " <> T.unwords (map (UTF8.toText . show) programArgs) UTF8.hPutStr stderr "\n" UTF8.hPutStrLn stderr "[makePDF] Environment:" mapM_ (UTF8.hPutStrLn stderr . tshow) env @@ -518,8 +518,8 @@ handlePDFProgramNotFound program e E.throwIO $ PandocPDFProgramNotFoundError $ T.pack program | otherwise = E.throwIO e -utf8ToText :: ByteString -> Text +utf8ToText :: BL.ByteString -> Text utf8ToText lbs = - case decodeUtf8' lbs of + case TLE.decodeUtf8' lbs of Left _ -> T.pack $ BC.unpack lbs -- if decoding fails, treat as latin1 Right t -> TL.toStrict t diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 8d3799c3e..7f2cd1ba1 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -773,7 +773,10 @@ withRaw parser = do let raw = case inplines of [] -> "" [l] -> T.take (c2 - c1) l - ls -> T.unlines (init ls) <> T.take (c2 - 1) (last ls) + _ -> fromMaybe "" $ + viaNonEmpty (\ls -> + T.unlines (init ls) <> T.take (c2 - 1) (last ls)) + inplines return (result, raw) -- | Parses backslash, then applies character parser. @@ -990,7 +993,7 @@ widthsFromIndices :: Int -- Number of columns on terminal -> [Double] -- Fractional relative sizes of columns widthsFromIndices _ [] = [] widthsFromIndices numColumns' indices = - let numColumns = max numColumns' (if null indices then 0 else last indices) + let numColumns = max numColumns' (fromMaybe 0 $ viaNonEmpty last indices) lengths' = zipWith (-) indices (0:indices) lengths = reverse $ case reverse lengths' of @@ -1006,8 +1009,8 @@ widthsFromIndices numColumns' indices = quotient = if totLength > numColumns then fromIntegral totLength else fromIntegral numColumns - fracs = map (\l -> fromIntegral l / quotient) lengths in - tail fracs + fracs = map (\l -> fromIntegral l / quotient) lengths + in fromMaybe [] $ viaNonEmpty tail fracs --- @@ -1034,8 +1037,9 @@ gridTableWith' blocks headless = (gridTableSep '-') gridTableFooter gridTableSplitLine :: [Int] -> Text -> [Text] -gridTableSplitLine indices line = map removeFinalBar $ tail $ - splitTextByIndices (init indices) $ trimr line +gridTableSplitLine indices line = maybe [] (map removeFinalBar) $ + viaNonEmpty tail $ + splitTextByIndices (fromMaybe [] $ viaNonEmpty init indices) $ trimr line gridPart :: Stream s m Char => Char -> ParserT s st m ((Int, Int), Alignment) gridPart ch = do diff --git a/src/Text/Pandoc/Process.hs b/src/Text/Pandoc/Process.hs index b896feb7e..7f13921fd 100644 --- a/src/Text/Pandoc/Process.hs +++ b/src/Text/Pandoc/Process.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Process Copyright : Copyright (C) 2013-2021 John MacFarlane @@ -11,8 +12,7 @@ ByteString variant of 'readProcessWithExitCode'. -} module Text.Pandoc.Process (pipeProcess) where -import Control.Concurrent (MVar, forkIO, killThread, newEmptyMVar, putMVar, - takeMVar) +import Control.Concurrent (MVar, forkIO, killThread) import Control.Exception (SomeException (..)) import qualified Control.Exception as E import Control.Monad (unless) diff --git a/src/Text/Pandoc/Readers.hs b/src/Text/Pandoc/Readers.hs index ac70f7d4c..b01096d69 100644 --- a/src/Text/Pandoc/Readers.hs +++ b/src/Text/Pandoc/Readers.hs @@ -102,6 +102,7 @@ import Text.Pandoc.Readers.CslJson import Text.Pandoc.Readers.BibTeX import qualified Text.Pandoc.UTF8 as UTF8 import Text.Parsec.Error +import Prelude hiding (Reader) data Reader m = TextReader (ReaderOptions -> Text -> m Pandoc) | ByteStringReader (ReaderOptions -> BL.ByteString -> m Pandoc) diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index d38b07864..bf538e807 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -25,8 +25,8 @@ import qualified Data.Text.Lazy as TL import Control.Monad.Except (throwError) import Text.HTML.TagSoup.Entity (lookupEntity) import Text.Pandoc.Error (PandocError(..)) -import Text.Pandoc.Builder -import Text.Pandoc.Class.PandocMonad (PandocMonad, report) +import Text.Pandoc.Builder as B +import Text.Pandoc.Class as P (PandocMonad, report) import Text.Pandoc.Options import Text.Pandoc.Logging (LogMessage(..)) import Text.Pandoc.Shared (crFilter, safeRead, extractSpaces) @@ -544,7 +544,7 @@ readDocBook _ inp = do parseXMLContents (TL.fromStrict . handleInstructions $ crFilter inp) (bs, st') <- flip runStateT (def{ dbContent = tree }) $ mapM parseBlock tree - return $ Pandoc (dbMeta st') (toList . mconcat $ bs) + return $ Pandoc (dbMeta st') (B.toList . mconcat $ bs) -- We treat certain processing instructions by converting them to tags -- beginning "pi-". @@ -714,8 +714,8 @@ trimNl = T.dropAround (== '\n') -- assumes Blocks start with a Para; if not, does nothing. addToStart :: Inlines -> Blocks -> Blocks addToStart toadd bs = - case toList bs of - (Para xs : rest) -> para (toadd <> fromList xs) <> fromList rest + case B.toList bs of + (Para xs : rest) -> para (toadd <> B.fromList xs) <> B.fromList rest _ -> bs -- function that is used by both mediaobject (in parseBlock) @@ -949,9 +949,8 @@ parseBlock (Elem e) = (x >= '0' && x <= '9') || x == '.') w if n > 0 then Just n else Nothing - let numrows = case bodyrows of - [] -> 0 - xs -> maximum $ map length xs + let numrows = fromMaybe 0 $ + viaNonEmpty maximum1 $ map length bodyrows let aligns = case colspecs of [] -> replicate numrows AlignDefault cs -> map toAlignment cs diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 00de6a0cd..37a0beab9 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -71,7 +71,7 @@ import Data.Maybe (isJust, fromMaybe) import Data.Sequence (ViewL (..), viewl) import qualified Data.Sequence as Seq import qualified Data.Set as Set -import Text.Pandoc.Builder as Pandoc +import Text.Pandoc.Builder as B import Text.Pandoc.MediaBag (MediaBag) import Text.Pandoc.Options import Text.Pandoc.Readers.Docx.Combine @@ -182,7 +182,7 @@ bodyPartsToMeta' (bp : bps) f (MetaInlines ils) (MetaBlocks blks) = MetaBlocks (Para ils : blks) f m (MetaList mv) = MetaList (m : mv) f m n = MetaList [m, n] - return $ M.insertWith f metaField (MetaInlines (toList inlines)) remaining + return $ M.insertWith f metaField (MetaInlines (B.toList inlines)) remaining bodyPartsToMeta' (_ : bps) = bodyPartsToMeta' bps bodyPartsToMeta :: PandocMonad m => [BodyPart] -> DocxContext m Meta @@ -293,7 +293,7 @@ runStyleToTransform rPr' = do | Just SubScrpt <- rVertAlign rPr = subscript . go rPr{rVertAlign = Nothing} | Just "single" <- rUnderline rPr = - Pandoc.underline . go rPr{rUnderline = Nothing} + B.underline . go rPr{rUnderline = Nothing} | otherwise = id return $ go rPr' @@ -335,7 +335,7 @@ blocksToInlinesWarn cmtId blks = do unless (all paraOrPlain blks) $ lift $ P.report $ DocxParserWarning $ "Docx comment " <> cmtId <> " will not retain formatting" - return $ blocksToInlines' (toList blks) + return $ blocksToInlines' (B.toList blks) -- The majority of work in this function is done in the primed -- subfunction `partPartToInlines'`. We make this wrapper so that we @@ -493,7 +493,7 @@ singleParaToPlain blks = blks cellToBlocks :: PandocMonad m => Docx.Cell -> DocxContext m Blocks cellToBlocks (Docx.Cell bps) = do blks <- smushBlocks <$> mapM bodyPartToBlocks bps - return $ fromList $ blocksToDefinitions $ blocksToBullets $ toList blks + return $ B.fromList $ blocksToDefinitions $ blocksToBullets $ B.toList blks rowToBlocksList :: PandocMonad m => Docx.Row -> DocxContext m [Blocks] rowToBlocksList (Docx.Row cells) = do @@ -647,16 +647,11 @@ bodyPartToBlocks (Tbl cap _ look parts@(r:rs)) = do cells <- mapM rowToBlocksList rows - let width = maybe 0 maximum $ nonEmpty $ map rowLength parts - -- Data.List.NonEmpty is not available with ghc 7.10 so we roll out - -- our own, see - -- https://github.com/jgm/pandoc/pull/4361#issuecomment-365416155 - nonEmpty [] = Nothing - nonEmpty l = Just l + let width = fromMaybe 0 $ viaNonEmpty maximum1 $ map rowLength parts rowLength :: Docx.Row -> Int rowLength (Docx.Row c) = length c - let toRow = Pandoc.Row nullAttr . map simpleCell + let toRow = B.Row nullAttr . map simpleCell toHeaderRow l = [toRow l | not (null l)] -- pad cells. New Text.Pandoc.Builder will do that for us, @@ -720,7 +715,7 @@ bodyToOutput (Body bps) = do let (metabps, blkbps) = sepBodyParts bps meta <- bodyPartsToMeta metabps blks <- smushBlocks <$> mapM bodyPartToBlocks blkbps - blks' <- rewriteLinks $ blocksToDefinitions $ blocksToBullets $ toList blks + blks' <- rewriteLinks $ blocksToDefinitions $ blocksToBullets $ B.toList blks blks'' <- removeOrphanAnchors blks' return (meta, blks'') diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index bcf26c4a3..96e86f136 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -61,7 +61,7 @@ import Data.List import Data.Bifunctor import Data.Sequence ( ViewL (..), ViewR (..), viewl, viewr, spanr, spanl , (><), (|>) ) -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B data Modifier a = Modifier (a -> a) | AttrModifier (Attr -> a -> a) Attr @@ -101,7 +101,7 @@ unstackInlines ms = case ilModifierAndInnards ms of ilModifierAndInnards :: Inlines -> Maybe (Modifier Inlines, Inlines) ilModifierAndInnards ils = case viewl $ unMany ils of - x :< xs | null xs -> second fromList <$> case x of + x :< xs | null xs -> second B.fromList <$> case x of Emph lst -> Just (Modifier emph, lst) Strong lst -> Just (Modifier strong, lst) SmallCaps lst -> Just (Modifier smallcaps, lst) diff --git a/src/Text/Pandoc/Readers/Docx/Lists.hs b/src/Text/Pandoc/Readers/Docx/Lists.hs index e63f8457e..a86a608c7 100644 --- a/src/Text/Pandoc/Readers/Docx/Lists.hs +++ b/src/Text/Pandoc/Readers/Docx/Lists.hs @@ -17,7 +17,7 @@ module Text.Pandoc.Readers.Docx.Lists ( blocksToBullets , listParagraphStyles ) where -import Data.List +import Data.List (intersect, delete, (\\)) import Data.Maybe import Data.String (fromString) import qualified Data.Text as T @@ -109,12 +109,15 @@ handleListParagraphs (blk:blks) = blk : handleListParagraphs blks separateBlocks' :: Block -> [[Block]] -> [[Block]] separateBlocks' blk [[]] = [[blk]] -separateBlocks' b@(BulletList _) acc = init acc ++ [last acc ++ [b]] -separateBlocks' b@(OrderedList _ _) acc = init acc ++ [last acc ++ [b]] +separateBlocks' b@(BulletList _) acc = fromMaybe acc $ flip viaNonEmpty acc $ + \accNE -> init accNE ++ [last accNE ++ [b]] +separateBlocks' b@(OrderedList _ _) acc = fromMaybe acc $ flip viaNonEmpty acc $ + \accNE -> init accNE ++ [last accNE ++ [b]] -- The following is for the invisible bullet lists. This is how -- pandoc-generated ooxml does multiparagraph item lists. separateBlocks' b acc | fmap trim (getText b) == Just "" = - init acc ++ [last acc ++ [b]] + fromMaybe acc $ flip viaNonEmpty acc $ + \accNE -> init accNE ++ [last accNE ++ [b]] separateBlocks' b acc = acc ++ [[b]] separateBlocks :: [Block] -> [[Block]] @@ -178,9 +181,9 @@ blocksToDefinitions' ((defTerm, defItems):defs) acc defItems2 = if remainingAttr2 == ("", [], []) then blks2 else [Div remainingAttr2 blks2] - defAcc' = if null defItems - then (defTerm, [defItems2]) : defs - else (defTerm, init defItems ++ [last defItems ++ defItems2]) : defs + defAcc' = fromMaybe ((defTerm, [defItems2]) : defs) $ + flip viaNonEmpty defItems $ \items -> + (defTerm, init items ++ [last items ++ defItems2]) : defs in blocksToDefinitions' defAcc' acc blks blocksToDefinitions' [] acc (b:blks) = diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index f8ed248d7..818374398 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -60,7 +60,6 @@ import Control.Monad.State.Strict import Data.Bits ((.|.)) import qualified Data.ByteString.Lazy as B import Data.Char (chr, ord, readLitChar) -import Data.List import qualified Data.Map as M import qualified Data.Text as T import Data.Text (Text) @@ -909,7 +908,9 @@ elemToRun ns element | isElem ns "w" "r" element , Just altCont <- findChildByName ns "mc" "AlternateContent" element = do let choices = findChildrenByName ns "mc" "Choice" altCont - choiceChildren = map head $ filter (not . null) $ map elChildren choices + choiceChildren = mapMaybe (\n -> case elChildren n of + [] -> Nothing + (x:_) -> Just x) choices outputs <- mapD (childElemToRun ns) choiceChildren case outputs of r : _ -> return r diff --git a/src/Text/Pandoc/Readers/DokuWiki.hs b/src/Text/Pandoc/Readers/DokuWiki.hs index dedc1f03f..8c27a5132 100644 --- a/src/Text/Pandoc/Readers/DokuWiki.hs +++ b/src/Text/Pandoc/Readers/DokuWiki.hs @@ -24,7 +24,7 @@ import Data.Maybe (fromMaybe, catMaybes) import Data.Text (Text) import qualified Data.Text as T import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Class as P (PandocMonad (..)) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError (PandocParsecError)) import Text.Pandoc.Options @@ -388,7 +388,7 @@ block = do <|> blockElements <|> para skipMany blankline - trace (T.take 60 $ tshow $ B.toList res) + P.trace (T.take 60 $ tshow $ B.toList res) return res blockElements :: PandocMonad m => DWParser m B.Blocks @@ -466,10 +466,9 @@ blockPhp = try $ B.codeBlockWith ("", ["php"], []) table :: PandocMonad m => DWParser m B.Blocks table = do firstSeparator <- lookAhead tableCellSeparator - rows <- tableRows - let (headerRow, body) = if firstSeparator == '^' - then (head rows, tail rows) - else ([], rows) + rows@(headerRow:body) <- if firstSeparator == '^' + then tableRows + else ([]:) <$> tableRows let attrs = (AlignDefault, ColWidthDefault) <$ transpose rows let toRow = Row nullAttr . map B.simpleCell toHeaderRow l = [toRow l | not (null l)] diff --git a/src/Text/Pandoc/Readers/FB2.hs b/src/Text/Pandoc/Readers/FB2.hs index 66e390bd7..2f4e4bb64 100644 --- a/src/Text/Pandoc/Readers/FB2.hs +++ b/src/Text/Pandoc/Readers/FB2.hs @@ -35,7 +35,7 @@ import qualified Data.Text.Lazy as TL import Data.Default import Data.Maybe import Text.HTML.TagSoup.Entity (lookupEntity) -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B import Text.Pandoc.Class.PandocMonad (PandocMonad, insertMedia, report) import Text.Pandoc.Error import Text.Pandoc.Logging @@ -72,7 +72,7 @@ readFB2 _ inp = let authors = if null $ fb2Authors st then id else setMeta "author" (map text $ reverse $ fb2Authors st) - pure $ Pandoc (authors $ fb2Meta st) $ toList bs + pure $ Pandoc (authors $ fb2Meta st) $ B.toList bs -- * Utility functions @@ -285,7 +285,7 @@ parsePoemChild e = name -> report (UnexpectedXmlElement name "poem") $> mempty parseStanza :: PandocMonad m => Element -> FB2 m Blocks -parseStanza e = fromList . joinLineBlocks . toList . mconcat <$> mapM parseStanzaChild (elChildren e) +parseStanza e = B.fromList . joinLineBlocks . B.toList . mconcat <$> mapM parseStanzaChild (elChildren e) joinLineBlocks :: [Block] -> [Block] joinLineBlocks (LineBlock xs:LineBlock ys:zs) = joinLineBlocks (LineBlock (xs ++ ys) : zs) diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index b73c138ab..5d9c06390 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -43,7 +43,7 @@ import Text.HTML.TagSoup import Text.HTML.TagSoup.Match import Text.Pandoc.Builder (Blocks, Inlines, trimInlines) import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Class as P (PandocMonad (..)) import Text.Pandoc.CSS (pickStyleAttrProps) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Definition @@ -214,7 +214,7 @@ block = ((do -> eSwitch B.para block _ -> mzero _ -> mzero) <|> pPlain <|> pRawHtmlBlock) >>= \res -> - res <$ trace (T.take 60 $ tshow $ B.toList res) + res <$ P.trace (T.take 60 $ tshow $ B.toList res) namespaces :: PandocMonad m => [(Text, TagParser m Inlines)] namespaces = [(mathMLNamespace, pMath True)] @@ -360,7 +360,8 @@ pDefListItem = try $ do terms <- many1 (try $ skipMany nonItem >> pInTags "dt" inline) defs <- many1 (try $ skipMany nonItem >> pInTags "dd" block) skipMany nonItem - let term = foldl1 (\x y -> x <> B.linebreak <> y) $ map trimInlines terms + let term = fromMaybe mempty $ viaNonEmpty + (foldl1' (\x y -> x <> B.linebreak <> y)) $ map trimInlines terms return (term, map (fixPlains True) defs) fixPlains :: Bool -> Blocks -> Blocks @@ -611,7 +612,7 @@ inline = pTagText <|> do "script" | Just x <- lookup "type" attr , "math/tex" `T.isPrefixOf` x -> pScriptMath - _ | name `elem` htmlSpanLikeElements -> pSpanLike + _ | name `Set.member` htmlSpanLikeElements -> pSpanLike _ -> pRawHtmlInline TagText _ -> pTagText _ -> pRawHtmlInline diff --git a/src/Text/Pandoc/Readers/HTML/Table.hs b/src/Text/Pandoc/Readers/HTML/Table.hs index 6179ea8e7..b8091d7e9 100644 --- a/src/Text/Pandoc/Readers/HTML/Table.hs +++ b/src/Text/Pandoc/Readers/HTML/Table.hs @@ -216,7 +216,7 @@ normalize widths head' bodies foot = do let rows = headRows head' <> concatMap bodyRows bodies <> footRows foot let cellWidth (Cell _ _ _ (ColSpan cs) _) = cs let rowLength = foldr (\cell acc -> cellWidth cell + acc) 0 . rowCells - let ncols = maximum (map rowLength rows) + let ncols = fromMaybe 0 $ viaNonEmpty maximum1 (map rowLength rows) let tblType = tableType (map rowCells rows) -- fail on empty table if null rows diff --git a/src/Text/Pandoc/Readers/HTML/TagCategories.hs b/src/Text/Pandoc/Readers/HTML/TagCategories.hs index b7bd40fee..a339b2e76 100644 --- a/src/Text/Pandoc/Readers/HTML/TagCategories.hs +++ b/src/Text/Pandoc/Readers/HTML/TagCategories.hs @@ -21,17 +21,18 @@ module Text.Pandoc.Readers.HTML.TagCategories ) where -import Data.Set (Set, fromList, unions) +import Data.Set (Set) +import qualified Data.Set as Set import Data.Text (Text) eitherBlockOrInline :: Set Text -eitherBlockOrInline = fromList +eitherBlockOrInline = Set.fromList ["audio", "applet", "button", "iframe", "embed", "del", "ins", "progress", "map", "area", "noscript", "script", "object", "svg", "video", "source"] blockHtmlTags :: Set Text -blockHtmlTags = fromList +blockHtmlTags = Set.fromList ["?xml", "!DOCTYPE", "address", "article", "aside", "blockquote", "body", "canvas", "caption", "center", "col", "colgroup", "dd", "details", @@ -48,7 +49,7 @@ blockHtmlTags = fromList -- We want to allow raw docbook in markdown documents, so we -- include docbook block tags here too. blockDocBookTags :: Set Text -blockDocBookTags = fromList +blockDocBookTags = Set.fromList ["calloutlist", "bibliolist", "glosslist", "itemizedlist", "orderedlist", "segmentedlist", "simplelist", "variablelist", "caution", "important", "note", "tip", @@ -63,10 +64,10 @@ blockDocBookTags = fromList "sidebar", "title"] epubTags :: Set Text -epubTags = fromList ["case", "switch", "default"] +epubTags = Set.fromList ["case", "switch", "default"] blockTags :: Set Text -blockTags = unions [blockHtmlTags, blockDocBookTags, epubTags] +blockTags = Set.unions [blockHtmlTags, blockDocBookTags, epubTags] sectioningContent :: [Text] sectioningContent = ["article", "aside", "nav", "section"] diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index 25d69f040..a50117f28 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -88,12 +88,12 @@ docHToBlocks d' = toRow = Row nullAttr . map B.simpleCell toHeaderRow l = [toRow l | not (null l)] (header, body) = - if null headerRows - then ([], map toCells bodyRows) - else (toCells (head headerRows), - map toCells (tail headerRows ++ bodyRows)) - colspecs = replicate (maximum (map length body)) - (AlignDefault, ColWidthDefault) + case headerRows of + [] -> ([], map toCells bodyRows) + (x:xs) -> (toCells x, map toCells (xs ++ bodyRows)) + colspecs = replicate + (fromMaybe 0 $ viaNonEmpty maximum1 (map length body)) + (AlignDefault, ColWidthDefault) in B.table B.emptyCaption colspecs (TableHead nullAttr $ toHeaderRow header) diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs index 602f3b4f2..d253775d8 100644 --- a/src/Text/Pandoc/Readers/JATS.hs +++ b/src/Text/Pandoc/Readers/JATS.hs @@ -26,7 +26,7 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Text.HTML.TagSoup.Entity (lookupEntity) -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B import Text.Pandoc.Class.PandocMonad (PandocMonad) import Text.Pandoc.Options import Text.Pandoc.Shared (crFilter, safeRead, extractSpaces) @@ -57,7 +57,7 @@ readJATS _ inp = do tree <- either (throwError . PandocXMLError "") return $ parseXMLContents (TL.fromStrict $ crFilter inp) (bs, st') <- flip runStateT (def{ jatsContent = tree }) $ mapM parseBlock tree - return $ Pandoc (jatsMeta st') (toList . mconcat $ bs) + return $ Pandoc (jatsMeta st') (B.toList . mconcat $ bs) -- convenience function to get an attribute value, defaulting to "" attrValue :: Text -> Element -> Text diff --git a/src/Text/Pandoc/Readers/Jira.hs b/src/Text/Pandoc/Readers/Jira.hs index 89aecbf56..f280bc983 100644 --- a/src/Text/Pandoc/Readers/Jira.hs +++ b/src/Text/Pandoc/Readers/Jira.hs @@ -16,7 +16,7 @@ import Data.Text (Text, append, pack, singleton, unpack) import Text.HTML.TagSoup.Entity (lookupEntity) import Text.Jira.Parser (parse) import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) -import Text.Pandoc.Builder hiding (cell) +import Text.Pandoc.Builder as B hiding (cell) import Text.Pandoc.Error (PandocError (PandocParseError)) import Text.Pandoc.Options (ReaderOptions) import Text.Pandoc.Shared (stringify) @@ -128,7 +128,7 @@ jiraToPandocInlines = \case in imageWith attr (Jira.fromURL url) title mempty Jira.Link lt alias url -> jiraLinkToPandoc lt alias url Jira.Linebreak -> linebreak - Jira.Monospaced inlns -> code . stringify . toList . fromInlines $ inlns + Jira.Monospaced inlns -> code . stringify . B.toList . fromInlines $ inlns Jira.Space -> space Jira.SpecialChar c -> str (Data.Text.singleton c) Jira.Str t -> str t diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index ceac261d2..5c494bbd6 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -36,10 +36,8 @@ import qualified Data.Text as T import System.FilePath (addExtension, replaceExtension, takeExtension) import Text.Pandoc.BCP47 (renderLang) import Text.Pandoc.Builder as B -import Text.Pandoc.Class.PandocPure (PandocPure) -import Text.Pandoc.Class.PandocMonad (PandocMonad (..), getResourcePath, - readFileFromDirs, report, - setResourcePath) +import Text.Pandoc.Class as P (PandocPure, PandocMonad (..), getResourcePath, + readFileFromDirs, report, setResourcePath) import Text.Pandoc.Error (PandocError (PandocParseError, PandocParsecError)) import Text.Pandoc.Highlighting (languagesByExtension) import Text.Pandoc.ImageSize (numUnit, showFl) @@ -382,7 +380,7 @@ inlineCommands = M.unions , ("it", extractSpaces emph <$> inlines) , ("sl", extractSpaces emph <$> inlines) , ("bf", extractSpaces strong <$> inlines) - , ("tt", code . stringify . toList <$> inlines) + , ("tt", code . stringify . B.toList <$> inlines) , ("rm", inlines) , ("itshape", extractSpaces emph <$> inlines) , ("slshape", extractSpaces emph <$> inlines) @@ -451,10 +449,10 @@ ifdim = do return $ rawInline "latex" $ "\\ifdim" <> untokenize contents <> "\\fi" makeUppercase :: Inlines -> Inlines -makeUppercase = fromList . walk (alterStr T.toUpper) . toList +makeUppercase = B.fromList . walk (alterStr T.toUpper) . B.toList makeLowercase :: Inlines -> Inlines -makeLowercase = fromList . walk (alterStr T.toLower) . toList +makeLowercase = B.fromList . walk (alterStr T.toLower) . B.toList alterStr :: (Text -> Text) -> Inline -> Inline alterStr f (Str xs) = Str (f xs) @@ -476,7 +474,7 @@ hypertargetBlock :: PandocMonad m => LP m Blocks hypertargetBlock = try $ do ref <- untokenize <$> braced bs <- grouped block - case toList bs of + case B.toList bs of [Header 1 (ident,_,_) _] | ident == ref -> return bs _ -> return $ divWith (ref, [], []) bs @@ -534,7 +532,7 @@ coloredInline stylename = do spanWith ("",[],[("style",stylename <> ": " <> untokenize color)]) <$> tok ttfamily :: PandocMonad m => LP m Inlines -ttfamily = code . stringify . toList <$> tok +ttfamily = code . stringify . B.toList <$> tok processHBox :: Inlines -> Inlines processHBox = walk convert @@ -824,7 +822,7 @@ closing = do extractInlines _ = [] let sigs = case lookupMeta "author" (sMeta st) of Just (MetaList xs) -> - para $ trimInlines $ fromList $ + para $ trimInlines $ B.fromList $ intercalate [LineBreak] $ map extractInlines xs _ -> mempty return $ para (trimInlines contents) <> sigs @@ -1049,8 +1047,8 @@ fancyverbEnv name = do obeylines :: PandocMonad m => LP m Blocks obeylines = - para . fromList . removeLeadingTrailingBreaks . - walk softBreakToHard . toList <$> env "obeylines" inlines + para . B.fromList . removeLeadingTrailingBreaks . + walk softBreakToHard . B.toList <$> env "obeylines" inlines where softBreakToHard SoftBreak = LineBreak softBreakToHard x = x removeLeadingTrailingBreaks = reverse . dropWhile isLineBreak . @@ -1095,7 +1093,7 @@ letterContents = do -- add signature (author) and address (title) let addr = case lookupMeta "address" (sMeta st) of Just (MetaBlocks [Plain xs]) -> - para $ trimInlines $ fromList xs + para $ trimInlines $ B.fromList xs _ -> mempty return $ addr <> bs -- sig added by \closing @@ -1110,7 +1108,7 @@ addImageCaption = walkM go | not ("fig:" `T.isPrefixOf` tit) = do st <- getState let (alt', tit') = case sCaption st of - Just ils -> (toList ils, "fig:" <> tit) + Just ils -> (B.toList ils, "fig:" <> tit) Nothing -> (alt, tit) attr' = case sLastLabel st of Just lab -> (lab, cls, kvs) @@ -1255,7 +1253,7 @@ block = do _ -> mzero) <|> paragraph <|> grouped block - trace (T.take 60 $ tshow $ B.toList res) + P.trace (T.take 60 $ tshow $ B.toList res) return res blocks :: PandocMonad m => LP m Blocks diff --git a/src/Text/Pandoc/Readers/LaTeX/Citation.hs b/src/Text/Pandoc/Readers/LaTeX/Citation.hs index 655823dab..8e3b56220 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Citation.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Citation.hs @@ -88,15 +88,15 @@ addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks addPrefix _ _ = [] addSuffix :: [Inline] -> [Citation] -> [Citation] -addSuffix s ks@(_:_) = - let k = last ks - in init ks ++ [k {citationSuffix = citationSuffix k ++ s}] -addSuffix _ _ = [] +addSuffix s = + fromMaybe [] . viaNonEmpty + (\ks' -> let k = last ks' + in init ks' ++ [k {citationSuffix = citationSuffix k ++ s}]) simpleCiteArgs :: forall m . PandocMonad m => LP m Inlines -> LP m [Citation] simpleCiteArgs inline = try $ do - first <- optionMaybe $ toList <$> opt - second <- optionMaybe $ toList <$> opt + first <- optionMaybe $ B.toList <$> opt + second <- optionMaybe $ B.toList <$> opt keys <- try $ bgroup *> manyTill citationLabel egroup let (pre, suf) = case (first , second ) of (Just s , Nothing) -> (mempty, s ) @@ -140,8 +140,8 @@ cites inline mode multi = try $ do let paropt = parenWrapped inline cits <- if multi then do - multiprenote <- optionMaybe $ toList <$> paropt - multipostnote <- optionMaybe $ toList <$> paropt + multiprenote <- optionMaybe $ B.toList <$> paropt + multipostnote <- optionMaybe $ B.toList <$> paropt let (pre, suf) = case (multiprenote, multipostnote) of (Just s , Nothing) -> (mempty, s) (Nothing , Just t) -> (mempty, t) @@ -149,10 +149,11 @@ cites inline mode multi = try $ do _ -> (mempty, mempty) tempCits <- many1 $ simpleCiteArgs inline case tempCits of - (k:ks) -> case ks of - (_:_) -> return $ (addMprenote pre k : init ks) ++ - [addMpostnote suf (last ks)] - _ -> return [addMprenote pre (addMpostnote suf k)] + (k:ks) -> + return $ fromMaybe [addMprenote pre (addMpostnote suf k)] + $ viaNonEmpty + (\ks' -> addMprenote pre k : init ks' ++ + [addMpostnote suf (last ks')]) ks _ -> return [[]] else count 1 $ simpleCiteArgs inline let cs = concat cits @@ -183,7 +184,7 @@ handleCitationPart :: Inlines -> [Citation] handleCitationPart ils = let isCite Cite{} = True isCite _ = False - (pref, rest) = break isCite (toList ils) + (pref, rest) = break isCite (B.toList ils) in case rest of (Cite cs _:suff) -> addPrefix pref $ addSuffix suff cs _ -> [] diff --git a/src/Text/Pandoc/Readers/LaTeX/Inline.hs b/src/Text/Pandoc/Readers/LaTeX/Inline.hs index 7b8bca4af..6d14bf747 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Inline.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Inline.hs @@ -25,7 +25,7 @@ where import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B import Text.Pandoc.Shared (toRomanNumeral, safeRead) import Text.Pandoc.Readers.LaTeX.Types (Tok (..), TokType (..)) import Control.Applicative (optional, (<|>)) @@ -162,8 +162,8 @@ accentWith :: PandocMonad m => LP m Inlines -> Char -> Maybe Char -> LP m Inlines accentWith tok combiningAccent fallBack = try $ do ils <- tok - case toList ils of - (Str (T.uncons -> Just (x, xs)) : ys) -> return $ fromList $ + case B.toList ils of + (Str (T.uncons -> Just (x, xs)) : ys) -> return $ B.fromList $ -- try to normalize to the combined character: Str (Normalize.normalize Normalize.NFC (T.pack [x, combiningAccent]) <> xs) : ys diff --git a/src/Text/Pandoc/Readers/LaTeX/SIunitx.hs b/src/Text/Pandoc/Readers/LaTeX/SIunitx.hs index 1952f4e1a..991ec4d98 100644 --- a/src/Text/Pandoc/Readers/LaTeX/SIunitx.hs +++ b/src/Text/Pandoc/Readers/LaTeX/SIunitx.hs @@ -60,9 +60,9 @@ doSInumlist = do case xs of [] -> return mempty [x] -> return x - _ -> return $ - mconcat (intersperse (str "," <> space) (init xs)) <> - text ", & " <> last xs + _ -> return $ fromMaybe mempty $ viaNonEmpty + (\xsNE -> mconcat (intersperse (str "," <> space) (init xsNE)) <> + text ", & " <> last xsNE) xs parseNum :: Parser Text () Inlines parseNum = (mconcat <$> many parseNumPart) <* eof diff --git a/src/Text/Pandoc/Readers/LaTeX/Table.hs b/src/Text/Pandoc/Readers/LaTeX/Table.hs index 7833da081..10d41912e 100644 --- a/src/Text/Pandoc/Readers/LaTeX/Table.hs +++ b/src/Text/Pandoc/Readers/LaTeX/Table.hs @@ -194,8 +194,8 @@ cellAlignment = skipMany (symbol '|') *> alignment <* skipMany (symbol '|') _ -> AlignDefault plainify :: Blocks -> Blocks -plainify bs = case toList bs of - [Para ils] -> plain (fromList ils) +plainify bs = case B.toList bs of + [Para ils] -> plain (B.fromList ils) _ -> bs multirowCell :: PandocMonad m => LP m Blocks -> LP m Cell @@ -231,7 +231,7 @@ multicolumnCell blocks = controlSeq "multicolumn" >> do alignment (RowSpan rs) (ColSpan span') - (fromList bs) + (B.fromList bs) symbol '{' *> (nestedCell <|> singleCell) <* symbol '}' diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 34edbcc17..4dddd3500 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -33,7 +33,7 @@ import System.FilePath (addExtension, takeExtension) import Text.HTML.TagSoup hiding (Row) import Text.Pandoc.Builder (Blocks, Inlines) import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Class.PandocMonad (PandocMonad (..), report) +import Text.Pandoc.Class as P (PandocMonad (..), report) import Text.Pandoc.Definition as Pandoc import Text.Pandoc.Emoji (emojiToInline) import Text.Pandoc.Error @@ -357,7 +357,7 @@ referenceKey = try $ do addKvs <- option [] $ guardEnabled Ext_mmd_link_attributes >> many (try $ spnl >> keyValAttr) blanklines - let attr' = extractIdClass $ foldl (\x f -> f x) attr addKvs + let attr' = extractIdClass $ foldl' (\x f -> f x) attr addKvs target = (escapeURI $ trimr src, tit) st <- getState let oldkeys = stateKeys st @@ -476,7 +476,7 @@ block = do , para , plain ] <?> "block" - trace (T.take 60 $ tshow $ B.toList $ runF res defaultParserState) + P.trace (T.take 60 $ tshow $ B.toList $ runF res defaultParserState) return res -- @@ -613,7 +613,7 @@ attributes = try $ do spnl attrs <- many (attribute <* spnl) char '}' - return $ foldl (\x f -> f x) nullAttr attrs + return $ foldl' (\x f -> f x) nullAttr attrs attribute :: PandocMonad m => MarkdownParser m (Attr -> Attr) attribute = identifierAttr <|> classAttr <|> keyValAttr <|> specialAttr @@ -1204,10 +1204,9 @@ simpleTableHeader headless = try $ do let (lengths, lines') = unzip dashes let indices = scanl (+) (T.length initSp) lines' -- If no header, calculate alignment on basis of first row of text - rawHeads <- fmap (tail . splitTextByIndices (init indices)) $ - if headless - then lookAhead anyLine - else return rawContent + rawHeads <- splitLine indices <$> if headless + then lookAhead anyLine + else return rawContent let aligns = zipWith alignType (map (: []) rawHeads) lengths let rawHeads' = if headless then [] @@ -1217,6 +1216,10 @@ simpleTableHeader headless = try $ do mapM (parseFromString' (mconcat <$> many plain).trim) rawHeads' return (heads, aligns, indices) +splitLine :: [Int] -> Text -> [Text] +splitLine indices = + drop 1 . splitTextByIndices (fromMaybe [] $ viaNonEmpty init indices) + -- Returns an alignment type for a table, based on a list of strings -- (the rows of the column header) and a number (the length of the -- dashed line under the rows. @@ -1251,8 +1254,7 @@ rawTableLine :: PandocMonad m rawTableLine indices = do notFollowedBy' (blanklines' <|> tableFooter) line <- take1WhileP (/='\n') <* newline - return $ map trim $ tail $ - splitTextByIndices (init indices) line + return $ map trim $ splitLine indices line -- Parse a table line and return a list of lists of blocks (columns). tableLine :: PandocMonad m @@ -1322,11 +1324,9 @@ multilineTableHeader headless = try $ do [] -> [] (x:xs) -> reverse (x+1:xs) rawHeadsList <- if headless - then fmap (map (:[]) . tail . - splitTextByIndices (init indices')) $ lookAhead anyLine + then map (:[]) . splitLine indices' <$> lookAhead anyLine else return $ transpose $ map - (tail . splitTextByIndices (init indices')) - rawContent + (splitLine indices') rawContent let aligns = zipWith alignType rawHeadsList lengths let rawHeads = if headless then [] @@ -1363,8 +1363,8 @@ pipeTable = try $ do let heads' = take (length aligns) <$> heads lines' <- many pipeTableRow let lines'' = map (take (length aligns) <$>) lines' - let maxlength = maximum $ - map (\x -> T.length . stringify $ runF x def) (heads' : lines'') + let maxlength = maximum1 $ + fmap (\x -> T.length . stringify $ runF x def) (heads' :| lines'') numColumns <- getOption readerColumns let widths = if maxlength > numColumns then map (\len -> @@ -1626,9 +1626,9 @@ enclosure c = do (return (B.str cs) <>) <$> whitespace <|> case T.length cs of - 3 -> three c - 2 -> two c mempty - 1 -> one c mempty + 3 -> three' c + 2 -> two' c mempty + 1 -> one' c mempty _ -> return (return $ B.str cs) ender :: PandocMonad m => Char -> Int -> MarkdownParser m () @@ -1642,18 +1642,18 @@ ender c n = try $ do -- If one c, emit emph and then parse two. -- If two cs, emit strong and then parse one. -- Otherwise, emit ccc then the results. -three :: PandocMonad m => Char -> MarkdownParser m (F Inlines) -three c = do +three' :: PandocMonad m => Char -> MarkdownParser m (F Inlines) +three' c = do contents <- mconcat <$> many (notFollowedBy (ender c 1) >> inline) (ender c 3 >> updateLastStrPos >> return (B.strong . B.emph <$> contents)) - <|> (ender c 2 >> updateLastStrPos >> one c (B.strong <$> contents)) - <|> (ender c 1 >> updateLastStrPos >> two c (B.emph <$> contents)) + <|> (ender c 2 >> updateLastStrPos >> one' c (B.strong <$> contents)) + <|> (ender c 1 >> updateLastStrPos >> two' c (B.emph <$> contents)) <|> return (return (B.str $ T.pack [c,c,c]) <> contents) -- Parse inlines til you hit two c's, and emit strong. -- If you never do hit two cs, emit ** plus inlines parsed. -two :: PandocMonad m => Char -> F Inlines -> MarkdownParser m (F Inlines) -two c prefix' = do +two' :: PandocMonad m => Char -> F Inlines -> MarkdownParser m (F Inlines) +two' c prefix' = do contents <- mconcat <$> many (try $ notFollowedBy (ender c 2) >> inline) (ender c 2 >> updateLastStrPos >> return (B.strong <$> (prefix' <> contents))) @@ -1661,12 +1661,12 @@ two c prefix' = do -- Parse inlines til you hit a c, and emit emph. -- If you never hit a c, emit * plus inlines parsed. -one :: PandocMonad m => Char -> F Inlines -> MarkdownParser m (F Inlines) -one c prefix' = do +one' :: PandocMonad m => Char -> F Inlines -> MarkdownParser m (F Inlines) +one' c prefix' = do contents <- mconcat <$> many ( (notFollowedBy (ender c 1) >> inline) <|> try (string [c,c] >> notFollowedBy (ender c 1) >> - two c mempty) ) + two' c mempty) ) (ender c 1 >> updateLastStrPos >> return (B.emph <$> (prefix' <> contents))) <|> return (return (B.str $ T.singleton c) <> (prefix' <> contents)) diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index 9f4d5e170..d812b0a34 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -30,7 +30,7 @@ import qualified Data.Text as T import Text.HTML.TagSoup import Text.Pandoc.Builder (Blocks, Inlines, trimInlines) import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Class as P (PandocMonad (..)) import Text.Pandoc.Definition import Text.Pandoc.Logging import Text.Pandoc.Options @@ -192,7 +192,7 @@ block = do <|> blockTag <|> (B.rawBlock "mediawiki" <$> template) <|> para - trace (T.take 60 $ tshow $ B.toList res) + P.trace (T.take 60 $ tshow $ B.toList res) return res para :: PandocMonad m => MWParser m Blocks diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index b4eea9d3a..155c36844 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -31,7 +31,7 @@ import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Builder (Blocks, Inlines, underline) import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Class as P (PandocMonad (..)) import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError (PandocParsecError)) import Text.Pandoc.Logging @@ -293,7 +293,7 @@ listItemContentsUntil col pre end = p parseBlock :: PandocMonad m => MuseParser m (F Blocks) parseBlock = do res <- blockElements <|> para - trace (T.take 60 $ tshow $ B.toList $ runF res def) + P.trace (T.take 60 $ tshow $ B.toList $ runF res def) return res where para = fst <$> paraUntil (try (eof <|> void (lookAhead blockElements))) diff --git a/src/Text/Pandoc/Readers/OPML.hs b/src/Text/Pandoc/Readers/OPML.hs index 5f2ddb876..248a15709 100644 --- a/src/Text/Pandoc/Readers/OPML.hs +++ b/src/Text/Pandoc/Readers/OPML.hs @@ -18,7 +18,7 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B import Text.Pandoc.Class.PandocMonad (PandocMonad) import Text.Pandoc.Options import Text.Pandoc.Error (PandocError(..)) @@ -77,7 +77,7 @@ asMarkdown :: PandocMonad m => Text -> OPML m Blocks asMarkdown s = do opts <- gets opmlOptions Pandoc _ bs <- readMarkdown def{ readerExtensions = readerExtensions opts } s - return $ fromList bs + return $ B.fromList bs getBlocks :: PandocMonad m => Element -> OPML m Blocks getBlocks e = mconcat <$> mapM parseBlock (elContent e) diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs index 93c6b5e79..dddf512fb 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs @@ -22,7 +22,7 @@ module Text.Pandoc.Readers.Odt.Arrows.State where import Control.Arrow import qualified Control.Category as Cat import Control.Monad - +import Prelude hiding (first, second) import Text.Pandoc.Readers.Odt.Arrows.Utils import Text.Pandoc.Readers.Odt.Generic.Fallible @@ -122,7 +122,7 @@ iterateS a = ArrowState $ \(s,f) -> foldr a' (s,mzero) f iterateSL :: (Foldable f, MonadPlus m) => ArrowState s x y -> ArrowState s (f x) (m y) -iterateSL a = ArrowState $ \(s,f) -> foldl a' (s,mzero) f +iterateSL a = ArrowState $ \(s,f) -> foldl' a' (s,mzero) f where a' (s',m) x = second (mplus m.return) $ runArrowState a (s',x) diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index df90880fa..9ebeca30c 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -23,22 +23,22 @@ module Text.Pandoc.Readers.Odt.ContentReader , read_body ) where -import Control.Applicative hiding (liftA, liftA2, liftA3) -import Control.Arrow +import Prelude hiding (liftA, liftA2, liftA3, first, second) +import Control.Applicative ((<|>)) import Control.Monad ((<=<)) - +import Control.Arrow (ArrowChoice(..), (>>^), (^>>), first, second, + arr, returnA) import qualified Data.ByteString.Lazy as B import Data.Foldable (fold) import Data.List (find) import qualified Data.Map as M import qualified Data.Text as T import Data.Maybe -import Data.Semigroup (First(..), Option(..)) import Text.TeXMath (readMathML, writeTeX) import qualified Text.Pandoc.XML.Light as XML -import Text.Pandoc.Builder hiding (underline) +import Text.Pandoc.Builder as B hiding (underline) import Text.Pandoc.MediaBag (MediaBag, insertMedia) import Text.Pandoc.Shared import Text.Pandoc.Extensions (extensionsFromList, Extension(..)) @@ -244,7 +244,7 @@ getHeaderAnchor :: OdtReaderSafe Inlines Anchor getHeaderAnchor = proc title -> do state <- getExtraState -< () let exts = extensionsFromList [Ext_auto_identifiers] - let anchor = uniqueIdent exts (toList title) + let anchor = uniqueIdent exts (B.toList title) (Set.fromList $ usedAnchors state) modifyExtraState (putPrettyAnchor anchor anchor) -<< anchor @@ -306,7 +306,7 @@ withNewStyle a = proc x -> do isCodeStyle _ = False inlineCode :: Inlines -> Inlines - inlineCode = code . T.concat . map stringify . toList + inlineCode = code . T.concat . map stringify . B.toList type PropertyTriple = (ReaderState, TextProperties, Maybe StyleFamily) type InlineModifier = Inlines -> Inlines @@ -510,7 +510,7 @@ newtype FirstMatch a = FirstMatch (Option (First a)) deriving (Foldable, Monoid, Semigroup) firstMatch :: a -> FirstMatch a -firstMatch = FirstMatch . Option . Just . First +firstMatch = FirstMatch . Option . Just . First . Just -- @@ -571,7 +571,7 @@ read_text_seq = matchingElement NsText "sequence" read_spaces :: InlineMatcher read_spaces = matchingElement NsText "s" ( readAttrWithDefault NsText "c" 1 -- how many spaces? - >>^ fromList.(`replicate` Space) + >>^ B.fromList.(`replicate` Space) ) -- read_line_break :: InlineMatcher @@ -733,8 +733,7 @@ read_table = matchingElement NsTable "table" -- | Infers the number of headers from rows simpleTable' :: [[Blocks]] -> Blocks simpleTable' [] = simpleTable [] [] -simpleTable' (x : rest) = simpleTable (fmap (const defaults) x) (x : rest) - where defaults = fromList [] +simpleTable' (x : rest) = simpleTable (fmap (const mempty) x) (x : rest) -- read_table_row :: ElementMatcher [[Blocks]] @@ -784,7 +783,7 @@ read_frame_img = titleNodes <- matchChildContent' [ read_frame_title ] -< () alt <- matchChildContent [] read_plain_text -< () arr (firstMatch . uncurry4 imageWith) -< - (image_attributes w h, src', inlineListToIdentifier exts (toList titleNodes), alt) + (image_attributes w h, src', inlineListToIdentifier exts (B.toList titleNodes), alt) read_frame_title :: InlineMatcher read_frame_title = matchingElement NsSVG "title" (matchChildContent [] read_plain_text) @@ -814,7 +813,7 @@ read_frame_mathml = read_frame_text_box :: OdtReaderSafe XML.Element (FirstMatch Inlines) read_frame_text_box = proc box -> do paragraphs <- executeIn (matchChildContent' [ read_paragraph ]) -< box - arr read_img_with_caption -< toList paragraphs + arr read_img_with_caption -< B.toList paragraphs read_img_with_caption :: [Block] -> FirstMatch Inlines read_img_with_caption (Para [Image attr alt (src,title)] : _) = diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs index edefe3c70..a065e817d 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Utils.hs @@ -34,6 +34,7 @@ import qualified Data.Foldable as F (Foldable, foldr) import Data.Maybe import Data.Text (Text) import qualified Data.Text as T +import Text.Read -- | Equivalent to -- > foldr (.) id @@ -104,9 +105,6 @@ uncurry4 fun (a,b,c,d ) = fun a b c d uncurry5 fun (a,b,c,d,e ) = fun a b c d e uncurry6 fun (a,b,c,d,e,f ) = fun a b c d e f -swap :: (a,b) -> (b,a) -swap (a,b) = (b,a) - -- | A version of "Data.List.find" that uses a converter to a Maybe instance. -- The returned value is the first which the converter returns in a 'Just' -- wrapper. diff --git a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs index 0d921e23b..b384d3504 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs @@ -73,7 +73,7 @@ import Text.Pandoc.Readers.Odt.Arrows.Utils import Text.Pandoc.Readers.Odt.Generic.Namespaces import Text.Pandoc.Readers.Odt.Generic.Utils import Text.Pandoc.Readers.Odt.Generic.Fallible - +import Prelude hiding (withState, first, second) -------------------------------------------------------------------------------- -- Basis types for readability -------------------------------------------------------------------------------- @@ -101,7 +101,7 @@ data XMLConverterState nsID extraState where -- Arguably, a real Zipper would be better. But that is an -- optimization that can be made at a later time, e.g. when -- replacing Text.XML.Light. - parentElements :: [XML.Element] + parentElements :: NonEmpty XML.Element -- | A map from internal namespace IDs to the namespace prefixes -- used in XML elements , namespacePrefixes :: NameSpacePrefixes nsID @@ -126,7 +126,7 @@ createStartState :: (NameSpaceID nsID) -> XMLConverterState nsID extraState createStartState element extraState = XMLConverterState - { parentElements = [element] + { parentElements = element :| [] , namespacePrefixes = M.empty , namespaceIRIs = getInitialIRImap , moreState = extraState @@ -152,8 +152,8 @@ currentElement state = head (parentElements state) -- | Replace the current position by another, modifying the extra state -- in the process swapStack' :: XMLConverterState nsID extraState - -> [XML.Element] - -> ( XMLConverterState nsID extraState , [XML.Element] ) + -> NonEmpty XML.Element + -> ( XMLConverterState nsID extraState , NonEmpty XML.Element ) swapStack' state stack = ( state { parentElements = stack } , parentElements state @@ -163,13 +163,13 @@ swapStack' state stack pushElement :: XML.Element -> XMLConverterState nsID extraState -> XMLConverterState nsID extraState -pushElement e state = state { parentElements = e:parentElements state } +pushElement e state = state { parentElements = e :| toList (parentElements state) } -- | Pop the top element from the call stack, unless it is the last one. popElement :: XMLConverterState nsID extraState -> Maybe (XMLConverterState nsID extraState) popElement state - | _:es@(_:_) <- parentElements state = Just $ state { parentElements = es } + | _:|(e:es) <- parentElements state = Just $ state { parentElements = e:|es } | otherwise = Nothing -------------------------------------------------------------------------------- @@ -293,7 +293,7 @@ readNSattributes = fromState $ \state -> maybe (state, failEmpty ) => XMLConverterState nsID extraState -> Maybe (XMLConverterState nsID extraState) extractNSAttrs startState - = foldl (\state d -> state >>= addNS d) + = foldl' (\state d -> state >>= addNS d) (Just startState) nsAttribs where nsAttribs = mapMaybe readNSattr (XML.elAttribs element) @@ -553,7 +553,7 @@ jumpThere = withState (\state element ) -- -swapStack :: XMLConverter nsID extraState [XML.Element] [XML.Element] +swapStack :: XMLConverter nsID extraState (NonEmpty XML.Element) (NonEmpty XML.Element) swapStack = withState swapStack' -- @@ -568,7 +568,7 @@ jumpBack = tryModifyState (popElement >>> maybeToChoice) -- accessible to the converter. switchingTheStack :: XMLConverter nsID moreState a b -> XMLConverter nsID moreState (a, XML.Element) b -switchingTheStack a = second ( (:[]) ^>> swapStack ) +switchingTheStack a = second ( (:|[]) ^>> swapStack ) >>> first a >>> second swapStack >>^ fst diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs index 5e10f896c..b019aeb5a 100644 --- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs +++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs @@ -50,7 +50,8 @@ import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import qualified Data.Set as S - +import Text.Read +import qualified GHC.Show import qualified Text.Pandoc.XML.Light as XML import Text.Pandoc.Shared (safeRead, tshow) @@ -65,6 +66,8 @@ import Text.Pandoc.Readers.Odt.Generic.XMLConverter import Text.Pandoc.Readers.Odt.Base import Text.Pandoc.Readers.Odt.Namespaces +import Prelude hiding (liftA3, liftA2) + readStylesAt :: XML.Element -> Fallible Styles readStylesAt e = runConverter' readAllStyles mempty e @@ -120,7 +123,7 @@ fontPitchReader = executeInSub NsOffice "font-face-decls" ( &&& lookupDefaultingAttr NsStyle "font-pitch" )) - >>?^ ( M.fromList . foldl accumLegalPitches [] ) + >>?^ ( M.fromList . foldl' accumLegalPitches [] ) ) `ifFailedDo` returnV (Right M.empty) where accumLegalPitches ls (Nothing,_) = ls accumLegalPitches ls (Just n,p) = (n,p):ls @@ -305,7 +308,7 @@ data XslUnit = XslUnitMM | XslUnitCM | XslUnitPixel | XslUnitEM -instance Show XslUnit where +instance GHC.Show.Show XslUnit where show XslUnitMM = "mm" show XslUnitCM = "cm" show XslUnitInch = "in" diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index d1aff701e..bcae5c57b 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -542,8 +542,7 @@ include = try $ do in case (minlvl >>= safeRead :: Maybe Int) of Nothing -> blks Just lvl -> let levels = Walk.query headerLevel blks - -- CAVE: partial function in else - curMin = if null levels then 0 else minimum levels + curMin = fromMaybe 0 $ viaNonEmpty minimum1 levels in Walk.walk (shiftHeader (curMin - lvl)) blks headerLevel :: Block -> [Int] diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs index 2dcbecb1d..5469f1f4d 100644 --- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs +++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs @@ -15,7 +15,7 @@ module Text.Pandoc.Readers.Org.DocumentTree , unprunedHeadlineToBlocks ) where -import Control.Arrow ((***), first) +import Control.Arrow ((***)) import Control.Monad (guard) import Data.List (intersperse) import Data.Maybe (mapMaybe) diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 514e3b88d..06a7e37b7 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -14,7 +14,6 @@ Conversion from reStructuredText to 'Pandoc' document. -} module Text.Pandoc.Readers.RST ( readRST ) where -import Control.Arrow (second) import Control.Monad (forM_, guard, liftM, mplus, mzero, when) import Control.Monad.Except (throwError) import Control.Monad.Identity (Identity (..)) @@ -99,12 +98,13 @@ titleTransform (bs, meta) = case bs of (Header 1 _ head1:Header 2 _ head2:rest) | not (any (isHeader 1) rest || any (isHeader 2) rest) -> -- tit/sub - (promoteHeaders 2 rest, setMeta "title" (fromList head1) $ - setMeta "subtitle" (fromList head2) meta) + (promoteHeaders 2 rest, + setMeta "title" (B.fromList head1) $ + setMeta "subtitle" (B.fromList head2) meta) (Header 1 _ head1:rest) | not (any (isHeader 1) rest) -> -- title only (promoteHeaders 1 rest, - setMeta "title" (fromList head1) meta) + setMeta "title" (B.fromList head1) meta) _ -> (bs, meta) in case bs' of (DefinitionList ds : rest) -> @@ -113,7 +113,8 @@ titleTransform (bs, meta) = metaFromDefList :: [([Inline], [[Block]])] -> Meta -> Meta metaFromDefList ds meta = adjustAuthors $ foldr f meta ds - where f (k,v) = setMeta (T.toLower $ stringify k) (mconcat $ map fromList v) + where f (k,v) = setMeta (T.toLower $ stringify k) + (mconcat (map B.fromList v)) adjustAuthors (Meta metamap) = Meta $ M.adjust splitAuthors "author" $ M.adjust toPlain "date" $ M.adjust toPlain "title" @@ -501,7 +502,8 @@ includeDirective top fields body = do setInput oldInput setPosition oldPos updateState $ \s -> s{ stateContainers = - tail $ stateContainers s } + fromMaybe [] $ viaNonEmpty tail + $ stateContainers s } return bs @@ -837,7 +839,7 @@ listTableDirective top fields body = do (TableFoot nullAttr []) where takeRows [BulletList rows] = map takeCells rows takeRows _ = [] - takeCells [BulletList cells] = map B.fromList cells + takeCells [BulletList cells] = map B.fromList cells :: [Blocks] takeCells _ = [] normWidths ws = strictPos . (/ max 1 (sum ws)) <$> ws strictPos w @@ -888,7 +890,7 @@ csvTableDirective top fields rawcsv = do Right rawrows -> do let singleParaToPlain bs = case B.toList bs of - [Para ils] -> B.fromList [Plain ils] + [Para ils] -> B.plain (B.fromList ils) _ -> bs let parseCell t = singleParaToPlain <$> parseFromString' parseBlocks (t <> "\n\n") @@ -1291,8 +1293,12 @@ simpleTableRow indices = do simpleTableSplitLine :: [Int] -> Text -> [Text] simpleTableSplitLine indices line = - map trimr - $ tail $ splitTextByIndices (init indices) line + case viaNonEmpty init indices of + Nothing -> [] + Just indicesInit -> + case splitTextByIndices indicesInit line of + (_:xs) -> map trimr xs + [] -> [] simpleTableHeader :: PandocMonad m => Bool -- ^ Headerless table diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs index 484a6c923..c9fb757f1 100644 --- a/src/Text/Pandoc/Readers/TWiki.hs +++ b/src/Text/Pandoc/Readers/TWiki.hs @@ -23,7 +23,7 @@ import Data.Text (Text) import qualified Data.Text as T import Text.HTML.TagSoup import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Class as P (PandocMonad (..)) import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Parsing hiding (enclosed, nested) @@ -116,7 +116,7 @@ block = do <|> blockElements <|> para skipMany blankline - trace (T.take 60 $ tshow $ B.toList res) + P.trace (T.take 60 $ tshow $ B.toList res) return res blockElements :: PandocMonad m => TWParser m B.Blocks @@ -223,7 +223,8 @@ table :: PandocMonad m => TWParser m B.Blocks table = try $ do tableHead <- optionMaybe (unzip <$> many1Till tableParseHeader newline) rows <- many1 tableParseRow - return $ buildTable mempty rows $ fromMaybe (align rows, columns rows) tableHead + return $ buildTable mempty rows $ + fromMaybe (align rows, columns rows) tableHead where buildTable caption rows (aligns, heads) = B.table (B.simpleCaption $ B.plain caption) @@ -231,9 +232,11 @@ table = try $ do (TableHead nullAttr $ toHeaderRow heads) [TableBody nullAttr 0 [] $ map toRow rows] (TableFoot nullAttr []) - align rows = replicate (columCount rows) (AlignDefault, ColWidthDefault) - columns rows = replicate (columCount rows) mempty - columCount rows = length $ head rows + align rows = replicate (columnCount rows) (AlignDefault, ColWidthDefault) + columns rows = replicate (columnCount rows) mempty + columnCount rows = case rows of + (r:_) -> length r + _ -> 0 toRow = Row nullAttr . map B.simpleCell toHeaderRow l = [toRow l | not (null l)] diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 860da2dc3..cfd5e09d9 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -45,7 +45,7 @@ import Text.HTML.TagSoup (Tag (..), fromAttrib) import Text.HTML.TagSoup.Match import Text.Pandoc.Builder (Blocks, Inlines, trimInlines) import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Class as P (PandocMonad (..)) import Text.Pandoc.CSS import Text.Pandoc.Definition import Text.Pandoc.Options @@ -123,7 +123,7 @@ blockParsers = [ codeBlock block :: PandocMonad m => ParserT Text ParserState m Blocks block = do res <- choice blockParsers <?> "block" - trace (T.take 60 $ tshow $ B.toList res) + P.trace (T.take 60 $ tshow $ B.toList res) return res commentBlock :: PandocMonad m => ParserT Text ParserState m Blocks @@ -375,8 +375,9 @@ table = try $ do (toprow:rest) | any (fst . fst) toprow -> (toprow, rest) _ -> (mempty, rawrows) - let nbOfCols = maximum $ map length (headers:rows) - let aligns = map minimum $ transpose $ map (map (snd . fst)) (headers:rows) + let nbOfCols = maximum1 $ fmap length (headers :| rows) + let aligns = map (fromMaybe AlignDefault . viaNonEmpty minimum1) + $ transpose $ map (map (snd . fst)) (headers:rows) let toRow = Row nullAttr . map B.simpleCell toHeaderRow l = [toRow l | not (null l)] return $ B.table (B.simpleCaption $ B.plain caption) @@ -627,7 +628,7 @@ code2 = do -- | Html / CSS attributes attributes :: PandocMonad m => ParserT Text ParserState m Attr -attributes = foldl (flip ($)) ("",[],[]) <$> +attributes = foldl' (flip ($)) ("",[],[]) <$> try (do special <- option id specialAttribute attrs <- many attribute return (special : attrs)) diff --git a/src/Text/Pandoc/Readers/TikiWiki.hs b/src/Text/Pandoc/Readers/TikiWiki.hs index fb4b662c5..61d34f96f 100644 --- a/src/Text/Pandoc/Readers/TikiWiki.hs +++ b/src/Text/Pandoc/Readers/TikiWiki.hs @@ -24,8 +24,8 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Class.CommonState (CommonState (..)) -import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Class (CommonState (..), PandocMonad (..)) +import Text.Pandoc.Class as P import Text.Pandoc.Definition import Text.Pandoc.Logging (Verbosity (..)) import Text.Pandoc.Options @@ -87,7 +87,7 @@ block = do <|> para skipMany blankline when (verbosity >= INFO) $ - trace (T.pack $ printf "line %d: %s" (sourceLine pos) (take 60 $ show $ B.toList res)) + P.trace (T.pack $ printf "line %d: %s" (sourceLine pos) (take 60 $ show $ B.toList res)) return res blockElements :: PandocMonad m => TikiWikiParser m B.Blocks @@ -163,11 +163,12 @@ table = try $ do string "||" newline -- return $ B.simpleTable (headers rows) $ trace ("rows: " ++ (show rows)) rows - return $B.simpleTable (headers rows) rows + return $ B.simpleTable (headers rows) rows where -- The headers are as many empty strings as the number of columns -- in the first row - headers rows = map (B.plain . B.str) $replicate (length $ head rows) "" + headers rows@(firstRow:_) = + replicate (length firstRow) (B.plain $ B.str "") para :: PandocMonad m => TikiWikiParser m B.Blocks para = fmap (result . mconcat) ( many1Till inline endOfParaElement) @@ -232,35 +233,31 @@ mixedList = try $ do fixListNesting :: [B.Blocks] -> [B.Blocks] fixListNesting [] = [] fixListNesting [first] = [recurseOnList first] --- fixListNesting nestall | trace ("\n\nfixListNesting: " ++ (show nestall)) False = undefined --- fixListNesting nestall@(first:second:rest) = fixListNesting (first:second:rest) = - let secondBlock = head $ B.toList second in - case secondBlock of - BulletList _ -> fixListNesting $ mappend (recurseOnList first) (recurseOnList second) : rest - OrderedList _ _ -> fixListNesting $ mappend (recurseOnList first) (recurseOnList second) : rest - _ -> recurseOnList first : fixListNesting (second:rest) + case B.toList second of + (BulletList{}:_) -> fixListNesting $ + mappend (recurseOnList first) (recurseOnList second) : rest + (OrderedList{}:_) -> fixListNesting $ + mappend (recurseOnList first) (recurseOnList second) : rest + _ -> recurseOnList first : fixListNesting (second:rest) -- This function walks the Block structure for fixListNesting, -- because it's a bit complicated, what with converting to and from -- lists and so on. recurseOnList :: B.Blocks -> B.Blocks --- recurseOnList item | trace ("rOL: " ++ (show $ length $ B.toList item) ++ ", " ++ (show $ B.toList item)) False = undefined recurseOnList items - | length (B.toList items) == 1 = - let itemBlock = head $ B.toList items in - case itemBlock of - BulletList listItems -> B.bulletList $ fixListNesting $ map B.fromList listItems - OrderedList _ listItems -> B.orderedList $ fixListNesting $ map B.fromList listItems - _ -> items - + = case B.toList items of + [BulletList listItems] -> + B.bulletList $ fixListNesting $ map B.fromList listItems + [OrderedList _ listItems] -> + B.orderedList $ fixListNesting $ map B.fromList listItems + _ -> items -- The otherwise works because we constructed the blocks, and we -- know for a fact that no mappends have been run on them; each -- Blocks consists of exactly one Block. -- -- Anything that's not like that has already been processed by -- fixListNesting; don't bother to process it again. - | otherwise = items -- Turn the list if list items into a tree by breaking off the first diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 08083b177..6a8525c2f 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -58,7 +58,8 @@ getT2TMeta = do curMtime <- case inps of [] -> formatTime defaultTimeLocale "%T" <$> P.getZonedTime _ -> catchError - (maximum <$> mapM getModTime inps) + (fromMaybe mempty . viaNonEmpty maximum1 + <$> mapM getModTime inps) (const (return "")) return $ T2TMeta (T.pack curDate) (T.pack curMtime) (intercalate ", " inps) outp @@ -261,9 +262,11 @@ table = try $ do rows <- many1 (many commentLine *> tableRow) let columns = transpose rows let ncolumns = length columns - let aligns = map (foldr1 findAlign . map fst) columns + let aligns = map (fromMaybe AlignDefault . + viaNonEmpty (foldl1' findAlign) . map fst) + columns let rows' = map (map snd) rows - let size = maximum (map length rows') + let size = fromMaybe 0 $ viaNonEmpty maximum1 (map length rows') let rowsPadded = map (pad size) rows' let headerPadded = if null tableHeader then mempty else pad size tableHeader let toRow = Row nullAttr . map B.simpleCell @@ -445,9 +448,9 @@ titleLink = try $ do tokens <- sepBy1 (manyChar $ noneOf " ]") space guard (length tokens >= 2) char ']' - let link' = last tokens + let link' = fromMaybe mempty $ viaNonEmpty last tokens guard $ not $ T.null link' - let tit = T.unwords (init tokens) + let tit = maybe mempty T.unwords (viaNonEmpty init tokens) return $ B.link link' "" (B.text tit) -- Link with image diff --git a/src/Text/Pandoc/Readers/Vimwiki.hs b/src/Text/Pandoc/Readers/Vimwiki.hs index 74dac5ea7..8f5a2e250 100644 --- a/src/Text/Pandoc/Readers/Vimwiki.hs +++ b/src/Text/Pandoc/Readers/Vimwiki.hs @@ -54,17 +54,9 @@ import Data.List (isInfixOf) import Data.Maybe import Data.Text (Text) import qualified Data.Text as T -import Text.Pandoc.Builder (Blocks, Inlines, fromList, toList, trimInlines) -import qualified Text.Pandoc.Builder as B (blockQuote, bulletList, code, - codeBlockWith, definitionList, - displayMath, divWith, emph, - headerWith, horizontalRule, image, - imageWith, link, math, orderedList, - para, plain, setMeta, simpleTable, - softbreak, space, spanWith, str, - strikeout, strong, subscript, - superscript) -import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) +import Text.Pandoc.Builder (Blocks, Inlines, trimInlines) +import qualified Text.Pandoc.Builder as B +import Text.Pandoc.Class as P (PandocMonad(..)) import Text.Pandoc.Definition (Attr, Block (BulletList, OrderedList), Inline (Space), ListNumberDelim (..), ListNumberStyle (..), Pandoc (..), @@ -110,7 +102,7 @@ parseVimwiki = do eof st <- getState let meta = stateMeta st - return $ Pandoc meta (toList bs) + return $ Pandoc meta (B.toList bs) -- block parser @@ -129,7 +121,7 @@ block = do , definitionList , para ] - trace (T.take 60 $ tshow $ toList res) + P.trace (T.take 60 $ tshow $ toList res) return res blockML :: PandocMonad m => VwParser m Blocks @@ -244,13 +236,13 @@ syntax _ = [] nameValue :: Text -> Maybe (Text, Text) nameValue s = - let t = splitTextBy (== '=') s in - if length t /= 2 - then Nothing - else let (a, b) = (head t, last t) in - if (T.length b < 2) || ((T.head b, T.last b) /= ('"', '"')) - then Nothing - else Just (a, stripFirstAndLast b) + case splitTextBy (== '=') s of + [a,b] + | T.length b >= 2 + , T.head b == '"' + , T.last b == '"' + -> Just (a, stripFirstAndLast b) + _ -> Nothing displayMath :: PandocMonad m => VwParser m Blocks @@ -286,8 +278,8 @@ mathTagLaTeX s = case s of mixedList :: PandocMonad m => VwParser m Blocks mixedList = try $ do - (bl, _) <- mixedList' (-1) - return $ head bl + (b:_, _) <- mixedList' (-1) + return b mixedList' :: PandocMonad m => Int -> VwParser m ([Blocks], Int) mixedList' prevInd = do @@ -358,9 +350,9 @@ makeListMarkerSpan x = combineList :: Blocks -> [Blocks] -> [Blocks] combineList x [y] = case toList y of - [BulletList z] -> [fromList $ toList x + [BulletList z] -> [B.fromList $ B.toList x ++ [BulletList z]] - [OrderedList attr z] -> [fromList $ toList x + [OrderedList attr z] -> [B.fromList $ B.toList x ++ [OrderedList attr z]] _ -> x:[y] combineList x xs = x:xs @@ -401,8 +393,8 @@ table1 = try $ do -- headerless table table2 :: PandocMonad m => VwParser m ([Blocks], [[Blocks]]) table2 = try $ do - trs <- many1 tableRow - return (replicate (length $ head trs) mempty, trs) + trs@(firstRow:_) <- many1 tableRow + return (replicate (length firstRow) mempty, trs) tableHeaderSeparator :: PandocMonad m => VwParser m () tableHeaderSeparator = try $ do @@ -502,8 +494,8 @@ bareURL = try $ do strong :: PandocMonad m => VwParser m Inlines strong = try $ do s <- lookAhead $ between (char '*') (char '*') (many1 $ noneOf "*") - guard $ (head s `notElem` spaceChars) - && (last s `notElem` spaceChars) + guard $ Just True == viaNonEmpty (\s' -> + (head s' `notElem` spaceChars) && (last s' `notElem` spaceChars)) s char '*' contents <- mconcat <$>manyTill inline' (char '*' >> notFollowedBy alphaNum) @@ -516,8 +508,8 @@ makeId i = T.concat (stringify <$> toList i) emph :: PandocMonad m => VwParser m Inlines emph = try $ do s <- lookAhead $ between (char '_') (char '_') (many1 $ noneOf "_") - guard $ (head s `notElem` spaceChars) - && (last s `notElem` spaceChars) + guard $ Just True == viaNonEmpty (\s' -> + (head s' `notElem` spaceChars) && (last s' `notElem` spaceChars)) s char '_' contents <- mconcat <$>manyTill inline' (char '_' >> notFollowedBy alphaNum) @@ -618,8 +610,8 @@ tag = try $ do char ':' s <- manyTillChar (noneOf spaceChars) (try (char ':' >> lookAhead space)) guard $ not $ "::" `T.isInfixOf` (":" <> s <> ":") - let ss = splitTextBy (==':') s - return $ mconcat $ makeTagSpan' (head ss):(makeTagSpan <$> tail ss) + let (ssHead:ssTail) = splitTextBy (==':') s + return $ mconcat $ makeTagSpan' ssHead : (makeTagSpan <$> ssTail) todoMark :: PandocMonad m => VwParser m Inlines todoMark = try $ do diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs index c9e20cad0..2e8abd8ba 100644 --- a/src/Text/Pandoc/SelfContained.hs +++ b/src/Text/Pandoc/SelfContained.hs @@ -33,7 +33,7 @@ import Text.Pandoc.Error import Text.Pandoc.Logging import Text.Pandoc.MIME (MimeType) import Text.Pandoc.Shared (isURI, renderTags', trim) -import Text.Pandoc.UTF8 (toString, toText, fromText) +import qualified Text.Pandoc.UTF8 as UTF8 import Text.Parsec (ParsecT, runParserT) import qualified Text.Parsec as P @@ -43,8 +43,9 @@ isOk c = isAscii c && isAlphaNum c makeDataURI :: (MimeType, ByteString) -> T.Text makeDataURI (mime, raw) = if textual - then "data:" <> mime' <> "," <> T.pack (escapeURIString isOk (toString raw)) - else "data:" <> mime' <> ";base64," <> toText (encode raw) + then "data:" <> mime' <> "," <> + T.pack (escapeURIString isOk (UTF8.toString raw)) + else "data:" <> mime' <> ";base64," <> UTF8.toText (encode raw) where textual = "text/" `T.isPrefixOf` mime mime' = if textual && T.any (== ';') mime then mime <> ";charset=utf-8" @@ -92,7 +93,7 @@ convertTags (t@(TagOpen "script" as):TagClose "script":ts) = not ("</script" `B.isInfixOf` bs) -> return $ TagOpen "script" [("type", typeAttr)|not (T.null typeAttr)] - : TagText (toText bs) + : TagText (UTF8.toText bs) : TagClose "script" : rest | otherwise -> @@ -119,7 +120,7 @@ convertTags (t@(TagOpen "link" as):ts) = dropWhile (==TagClose "link") ts return $ TagOpen "style" [("type", "text/css")] -- see #5725 - : TagText (toText bs) + : TagText (UTF8.toText bs) : TagClose "style" : rest | otherwise -> do @@ -181,14 +182,15 @@ pCSSUrl d = P.try $ do Left b -> return b Right (mt,b) -> do let enc = makeDataURI (mt, b) - return $ fromText $ "url(" <> enc <> ")" + return $ UTF8.fromText $ "url(" <> enc <> ")" pQuoted :: PandocMonad m => ParsecT ByteString () m (T.Text, ByteString) pQuoted = P.try $ do quote <- P.oneOf "\"'" url <- T.pack <$> P.manyTill P.anyChar (P.char quote) - let fallback = fromText $ T.singleton quote <> trim url <> T.singleton quote + let fallback = UTF8.fromText $ + T.singleton quote <> trim url <> T.singleton quote return (url, fallback) pUrl :: PandocMonad m @@ -200,8 +202,9 @@ pUrl = P.try $ do url <- T.pack <$> P.manyTill P.anyChar (maybe (P.lookAhead (P.char ')')) P.char quote) P.spaces P.char ')' - let fallback = fromText ("url(" <> maybe "" T.singleton quote <> trim url <> - maybe "" T.singleton quote <> ")") + let fallback = UTF8.fromText + ("url(" <> maybe "" T.singleton quote <> trim url <> + maybe "" T.singleton quote <> ")") return (url, fallback) handleCSSUrl :: PandocMonad m @@ -215,7 +218,8 @@ handleCSSUrl d (url, fallback) = u -> do let url' = if isURI (T.pack u) then T.pack u else T.pack (d </> u) res <- lift $ getData "" url' case res of - Left uri -> return $ Left (fromText $ "url(" <> uri <> ")") + Left uri -> return $ + Left (UTF8.fromText $ "url(" <> uri <> ")") Right (mt', raw) -> do -- note that the downloaded CSS may -- itself contain url(...). diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index d11ad13f5..88728c3ad 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -164,13 +164,6 @@ splitTextByIndices ns = splitTextByRelIndices (zipWith (-) ns (0:ns)) let (first, rest) = T.splitAt x t in first : splitTextByRelIndices xs rest -ordNub :: (Ord a) => [a] -> [a] -ordNub l = go Set.empty l - where - go _ [] = [] - go s (x:xs) = if x `Set.member` s then go s xs - else x : go (Set.insert x s) xs - findM :: forall m t a. (Monad m, Foldable t) => (a -> m Bool) -> t a -> m (Maybe a) findM p = foldr go (pure Nothing) where @@ -183,26 +176,9 @@ findM p = foldr go (pure Nothing) -- Text processing -- -class ToString a where - toString :: a -> String - -instance ToString String where - toString = id - -instance ToString T.Text where - toString = T.unpack - -class ToText a where - toText :: a -> T.Text - -instance ToText String where - toText = T.pack - -instance ToText T.Text where - toText = id - +{-# DEPRECATED tshow "Use show instead" #-} tshow :: Show a => a -> T.Text -tshow = T.pack . show +tshow = show -- | Returns an association list of backslash escapes for the -- designated characters. @@ -449,16 +425,17 @@ capitalize = walk go -- blocks besides possibly at the end), turn any @Plain@s into @Para@s (#5285). compactify :: [Blocks] -- ^ List of list items (each a list of blocks) -> [Blocks] -compactify [] = [] -compactify items = - let (others, final) = (init items, last items) - in case reverse (B.toList final) of - (Para a:xs) - | null [Para x | Para x <- xs ++ concatMap B.toList others] - -> others ++ [B.fromList (reverse (Plain a : xs))] - _ | null [Para x | Para x <- concatMap B.toList items] - -> items - _ -> map (fmap plainToPara) items +compactify items' = + fromMaybe [] $ viaNonEmpty + (\items -> + let (others, final) = (init items, last items) + in case reverse (B.toList final) of + (Para a:xs) + | null [Para x | Para x <- xs ++ concatMap B.toList others] + -> others ++ [B.fromList (reverse (Plain a : xs))] + _ | null [Para x | Para x <- concatMap B.toList items'] + -> items' + _ -> map (fmap plainToPara) items') items' plainToPara :: Block -> Block plainToPara (Plain ils) = Para ils @@ -546,7 +523,8 @@ makeSections numbering mbBaseLevel bs = if level' > 0 then case length lastnum' of x | "unnumbered" `elem` classes -> [] - | x >= level' -> init lastnum' ++ [last lastnum' + 1] + | x >= level' -> take (x - 1) lastnum' ++ + ((+ 1) <$> drop (x - 1) lastnum') | otherwise -> lastnum ++ replicate (level' - length lastnum - 1) 0 ++ [1] else [] @@ -840,7 +818,7 @@ mapLeft = Bifunctor.first -- > collapseFilePath "parent/foo/.." == "parent" -- > collapseFilePath "/parent/foo/../../bar" == "/bar" collapseFilePath :: FilePath -> FilePath -collapseFilePath = Posix.joinPath . reverse . foldl go [] . splitDirectories +collapseFilePath = Posix.joinPath . reverse . foldl' go [] . splitDirectories where go rs "." = rs go r@(p:rs) ".." = case p of diff --git a/src/Text/Pandoc/UTF8.hs b/src/Text/Pandoc/UTF8.hs index 4d5921faf..d6d776183 100644 --- a/src/Text/Pandoc/UTF8.hs +++ b/src/Text/Pandoc/UTF8.hs @@ -45,7 +45,8 @@ import qualified Data.Text.IO as TIO import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -import Prelude hiding (getContents, putStr, putStrLn, readFile, writeFile) +import Prelude hiding (getContents, putStr, putStrLn, readFile, writeFile, + toText, toTextLazy, toString, fromString) import System.IO hiding (getContents, hGetContents, hPutStr, hPutStrLn, putStr, putStrLn, readFile, writeFile) diff --git a/src/Text/Pandoc/UUID.hs b/src/Text/Pandoc/UUID.hs index 12579be90..aa36fcab9 100644 --- a/src/Text/Pandoc/UUID.hs +++ b/src/Text/Pandoc/UUID.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.UUID Copyright : Copyright (C) 2010-2021 John MacFarlane @@ -18,11 +19,12 @@ import Data.Word import System.Random (RandomGen, randoms) import Text.Printf (printf) import Text.Pandoc.Class.PandocMonad +import qualified GHC.Show data UUID = UUID Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 -instance Show UUID where +instance GHC.Show.Show UUID where show (UUID a b c d e f g h i j k l m n o p) = "urn:uuid:" ++ printf "%02x" a ++ diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index b4ef7c8b9..12a5ba6dc 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -274,7 +274,7 @@ blockToAsciiDoc opts block@(Table _ blkCapt specs thead tbody tfoot) = do let colwidth = if writerWrapText opts == WrapAuto then writerColumns opts else 100000 - let maxwidth = maximum $ map offset (head':rows') + let maxwidth = maximum1 $ fmap offset (head' :| rows') let body = if maxwidth > colwidth then vsep rows' else vcat rows' let border = separator <> text "===" return $ diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 4d44842e2..a0c7326ae 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -228,8 +228,9 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do Period -> "stopper=." OneParen -> "stopper=)" TwoParens -> "left=(,stopper=)" - let width = maximum $ map T.length $ take (length contents) - (orderedListMarkers (start, style', delim)) + let width = fromMaybe 0 $ viaNonEmpty maximum1 + $ map T.length $ take (length contents) + (orderedListMarkers (start, style', delim)) let width' = (toEnum width + 1) / 2 let width'' = if width' > (1.5 :: Double) then "width=" <> tshow width' <> "em" @@ -239,7 +240,8 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do then "" else "[" <> T.intercalate "," specs2Items <> "]" let style'' = '[': (case style' of - DefaultStyle -> orderedListStyles !! level + DefaultStyle -> fromMaybe 'n' $ + orderedListStyles !!? level Decimal -> 'n' Example -> 'n' LowerRoman -> 'r' @@ -280,20 +282,20 @@ tableToConTeXt Xtb heads rows = (if isEmpty heads then empty else "\\startxtablehead[head]" $$ heads $$ "\\stopxtablehead") $$ - (if null rows - then empty - else "\\startxtablebody[body]" $$ vcat (init rows) $$ "\\stopxtablebody" $$ - "\\startxtablefoot[foot]" $$ last rows $$ "\\stopxtablefoot") $$ + fromMaybe empty + (flip viaNonEmpty rows $ \rs -> + "\\startxtablebody[body]" $$ vcat (init rs) $$ "\\stopxtablebody" $$ + "\\startxtablefoot[foot]" $$ last rs $$ "\\stopxtablefoot") $$ "\\stopxtable" tableToConTeXt Ntb heads rows = return $ "\\startTABLE" $$ (if isEmpty heads then empty else "\\startTABLEhead" $$ heads $$ "\\stopTABLEhead") $$ - (if null rows - then empty - else "\\startTABLEbody" $$ vcat (init rows) $$ "\\stopTABLEbody" $$ - "\\startTABLEfoot" $$ last rows $$ "\\stopTABLEfoot") $$ + fromMaybe empty + (flip viaNonEmpty rows $ \rs -> + "\\startTABLEbody" $$ vcat (init rs) $$ "\\stopTABLEbody" $$ + "\\startTABLEfoot" $$ last rs $$ "\\stopTABLEfoot") $$ "\\stopTABLE" tableRowToConTeXt :: PandocMonad m => Tabl -> [Alignment] -> [Double] -> [[Block]] -> WM m (Doc Text) @@ -456,9 +458,9 @@ inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do dims = if null dimList then empty else brackets $ mconcat (intersperse "," dimList) - clas = if null cls - then empty - else brackets $ literal $ toLabel $ head cls + clas = case cls of + [] -> empty + (x:_) -> brackets $ literal $ toLabel x -- Use / for path separators on Windows; see #4918 fixPathSeparators = T.map $ \c -> case c of '\\' -> '/' diff --git a/src/Text/Pandoc/Writers/CslJson.hs b/src/Text/Pandoc/Writers/CslJson.hs index a10def95e..4f1c73349 100644 --- a/src/Text/Pandoc/Writers/CslJson.hs +++ b/src/Text/Pandoc/Writers/CslJson.hs @@ -24,7 +24,6 @@ import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Error import Text.Pandoc.Class import Control.Monad.Except (throwError) -import Data.ByteString.Lazy (toStrict) import Data.ByteString (ByteString) import Text.Pandoc.Definition import Text.Pandoc.Builder as B diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 58c4bb5be..78a327cb1 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Writers.Custom Copyright : Copyright (C) 2012-2021 John MacFarlane @@ -63,7 +64,7 @@ instance Pushable (Stringify Citation) where addField "citationId" $ citationId cit addField "citationPrefix" . Stringify $ citationPrefix cit addField "citationSuffix" . Stringify $ citationSuffix cit - addField "citationMode" $ show (citationMode cit) + addField "citationMode" $ show @String (citationMode cit) addField "citationNoteNum" $ citationNoteNum cit addField "citationHash" $ citationHash cit @@ -142,7 +143,7 @@ blockToCustom (BlockQuote blocks) = blockToCustom (Table _ blkCapt specs thead tbody tfoot) = let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot - aligns' = map show aligns + aligns' = map (show @String) aligns capt' = Stringify capt headers' = map Stringify headers rows' = map (map Stringify) rows @@ -152,7 +153,8 @@ blockToCustom (BulletList items) = Lua.callFunc "BulletList" (map Stringify items) blockToCustom (OrderedList (num,sty,delim) items) = - Lua.callFunc "OrderedList" (map Stringify items) num (show sty) (show delim) + Lua.callFunc "OrderedList" (map Stringify items) + num (show @String sty) (show @String delim) blockToCustom (DefinitionList items) = Lua.callFunc "DefinitionList" diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index a6776608d..256426767 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -81,7 +81,8 @@ authorToDocbook opts name' = do (firstname, lastname) = case lengthname of 0 -> ("","") 1 -> ("", name) - n -> (T.unwords (take (n-1) namewords), last namewords) + n -> (T.unwords (take (n-1) namewords), + fromMaybe mempty (viaNonEmpty last namewords)) in inTagsSimple "firstname" (literal $ escapeStringForXML firstname) $$ inTagsSimple "surname" (literal $ escapeStringForXML lastname) @@ -253,10 +254,9 @@ blockToDocbook opts (BlockQuote blocks) = blockToDocbook _ (CodeBlock (_,classes,_) str) = return $ literal ("<programlisting" <> lang <> ">") <> cr <> flush (literal (escapeStringForXML str) <> cr <> literal "</programlisting>") - where lang = if null langs - then "" - else " language=\"" <> escapeStringForXML (head langs) <> - "\"" + where lang = case langs of + [] -> "" + (l:_) -> " language=\"" <> escapeStringForXML l <> "\"" isLang l = T.toLower l `elem` map T.toLower languages langsFrom s = if isLang s then [s] diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index 7df47c912..525391f74 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -172,7 +172,8 @@ blockToDokuWiki opts (Table _ blkCapt specs thead tbody tfoot) = do then return [] else zipWithM (tableItemToDokuWiki opts) aligns headers rows' <- mapM (zipWithM (tableItemToDokuWiki opts) aligns) rows - let widths = map (maximum . map T.length) $ transpose (headers':rows') + let widths = map (fromMaybe 0 . viaNonEmpty maximum1 . map T.length) $ + transpose (headers' : rows') let padTo (width, al) s = case width - T.length s of x | x > 0 -> diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 3f10cb437..37aeb504d 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -35,7 +35,7 @@ import qualified Data.Text.Lazy as TL import Network.HTTP (urlEncode) import System.FilePath (takeExtension, takeFileName, makeRelative) import Text.HTML.TagSoup (Tag (TagOpen), fromAttrib, parseTags) -import Text.Pandoc.Builder (fromList, setMeta) +import Text.Pandoc.Builder as B import Text.Pandoc.Class.PandocMonad (PandocMonad, report) import qualified Text.Pandoc.Class.PandocPure as P import qualified Text.Pandoc.Class.PandocMonad as P @@ -644,8 +644,8 @@ pandocToEPUB version opts doc = do (Div (_,"section":_,kvs) (Header _ _ xs : _) : _) -> -- remove notes or we get doubled footnotes - (Pandoc (setMeta "title" - (walk removeNote $ fromList xs) nullMeta) bs, + (Pandoc (B.setMeta "title" + (walk removeNote $ B.fromList xs) nullMeta) bs, case lookup "epub:type" kvs of Nothing -> "bodymatter" Just x @@ -903,8 +903,8 @@ pandocToEPUB version opts doc = do ,("body-type", toVal' "frontmatter") ]) <> cssvars False <> vars } - (Pandoc (setMeta "title" - (walk removeNote $ fromList $ docTitle' meta) nullMeta) + (Pandoc (B.setMeta "title" + (walk removeNote $ B.fromList $ docTitle' meta) nullMeta) (navBlocks ++ landmarks)) navEntry <- mkEntry "nav.xhtml" navData diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 3b5d04427..04d676307 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -42,6 +42,7 @@ import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers, makeSections, tshow, stringify) import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable) import Data.Generics (everywhere, mkT) +import qualified GHC.Show -- | Data to be written at the end of the document: -- (foot)notes, URLs, references, images. @@ -61,7 +62,7 @@ newFB = FbRenderState { footnotes = [], imagesToFetch = [] , writerOptions = def } data ImageMode = NormalImage | InlineImage deriving (Eq) -instance Show ImageMode where +instance GHC.Show.Show ImageMode where show NormalImage = "imageType" show InlineImage = "inlineImageType" @@ -143,8 +144,11 @@ author ss = [fname, lname] -> [ el "first-name" fname , el "last-name" lname ] (fname:rest) -> [ el "first-name" fname - , el "middle-name" (T.concat . init $ rest) - , el "last-name" (last rest) ] + , el "middle-name" + (maybe mempty T.concat + (viaNonEmpty init rest)) + , el "last-name" + (fromMaybe mempty (viaNonEmpty last rest)) ] [] -> [] in list $ el "author" (names ++ email) diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 2f33cd467..7ec3001f4 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -375,12 +375,12 @@ prefixedId opts s = "" -> mempty _ -> A.id $ toValue $ writerIdentifierPrefix opts <> s -toList :: PandocMonad m - => (Html -> Html) - -> WriterOptions - -> [Html] - -> StateT WriterState m Html -toList listop opts items = do +toList' :: PandocMonad m + => (Html -> Html) + -> WriterOptions + -> [Html] + -> StateT WriterState m Html +toList' listop opts items = do slideVariant <- gets stSlideVariant return $ if writerIncremental opts @@ -391,15 +391,15 @@ toList listop opts items = do unordList :: PandocMonad m => WriterOptions -> [Html] -> StateT WriterState m Html -unordList opts = toList H.ul opts . toListItems opts +unordList opts = toList' H.ul opts . toListItems opts ordList :: PandocMonad m => WriterOptions -> [Html] -> StateT WriterState m Html -ordList opts = toList H.ol opts . toListItems opts +ordList opts = toList' H.ol opts . toListItems opts defList :: PandocMonad m => WriterOptions -> [Html] -> StateT WriterState m Html -defList opts items = toList H.dl opts (items ++ [nl opts]) +defList opts items = toList' H.dl opts (items ++ [nl opts]) isTaskListItem :: [Block] -> Bool isTaskListItem (Plain (Str "☐":Space:_):_) = True @@ -544,7 +544,7 @@ tagWithAttributes opts html5 selfClosing tagname attr = addAttrs :: PandocMonad m => WriterOptions -> Attr -> Html -> StateT WriterState m Html -addAttrs opts attr h = foldl (!) h <$> attrsToHtml opts attr +addAttrs opts attr h = foldl' (!) h <$> attrsToHtml opts attr toAttrs :: PandocMonad m => [(Text, Text)] -> StateT WriterState m [Attribute] @@ -926,7 +926,7 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do numstyle'] else []) l <- ordList opts contents - return $ foldl (!) l attribs + return $ foldl' (!) l attribs blockToHtml opts (DefinitionList lst) = do contents <- mapM (\(term, defs) -> do term' <- liftM H.dt $ inlineListToHtml opts term @@ -1075,7 +1075,8 @@ colSpecListToHtml opts colspecs = do let hasDefaultWidth (_, ColWidthDefault) = True hasDefaultWidth _ = False - let percent w = show (truncate (100*w) :: Integer) <> "%" + let percent :: Double -> Text + percent w = show (truncate (100*w) :: Integer) <> "%" let col :: ColWidth -> Html col cw = do @@ -1238,7 +1239,7 @@ inlineToHtml opts inline = do in case spanLikeTag of Just tag -> do h <- inlineListToHtml opts ils - addAttrs opts (id',tail classes',kvs') $ tag h + addAttrs opts (id',drop 1 classes',kvs') $ tag h Nothing -> do h <- inlineListToHtml opts ils addAttrs opts (id',classes',kvs') (H.span h) @@ -1407,7 +1408,7 @@ inlineToHtml opts inline = do Just "audio" -> mediaTag H5.audio "Audio" Just _ -> (H5.embed, []) _ -> imageTag - return $ foldl (!) tag $ attributes ++ specAttrs + return $ foldl' (!) tag $ attributes ++ specAttrs -- note: null title included, as in Markdown.pl (Note contents) -> do notes <- gets stNotes @@ -1455,10 +1456,9 @@ blockListToNote opts ref blocks = do let kvs = [("role","doc-backlink") | html5] let backlink = [Link ("",["footnote-back"],kvs) [Str "↩"] ("#" <> "fnref" <> ref,"")] - let blocks' = if null blocks - then [] - else let lastBlock = last blocks - otherBlocks = init blocks + let blocks' = fromMaybe [] $ flip viaNonEmpty blocks $ \bs -> + let lastBlock = last bs + otherBlocks = init bs in case lastBlock of Para [Image _ _ (_,tit)] | "fig:" `T.isPrefixOf` tit diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index c254fbc58..284628de9 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -342,9 +342,9 @@ blockToICML opts style (Table _ blkCapt specs thead tbody tfoot) = then "0" else "1" nrRows = length rows - nrCols = if null rows - then 0 - else length $ head rows + nrCols = case rows of + [] -> 0 + (r:_) -> length r rowsToICML [] _ = return empty rowsToICML (col:rest) rowNr = liftM2 ($$) (colsToICML col aligns rowNr (0::Int)) $ rowsToICML rest (rowNr+1) @@ -416,14 +416,15 @@ listItemToICML opts style isFirst attribs item = then firstListItemName:style else style stl' = makeNumbStart attribs ++ stl - in if length item > 1 - then do - let insertTab (Para lst) = blockToICML opts (subListParName:style) $ Para $ Str "\t":lst + in case item of + (x:xs@(_:_)) -> do + let insertTab (Para lst) = blockToICML opts (subListParName:style) + $ Para $ Str "\t":lst insertTab block = blockToICML opts style block - f <- blockToICML opts stl' $ head item - r <- mapM insertTab $ tail item + f <- blockToICML opts stl' x + r <- mapM insertTab xs return $ intersperseBrs (f : r) - else blocksToICML opts stl' item + _ -> blocksToICML opts stl' item definitionListItemToICML :: PandocMonad m => WriterOptions -> Style -> ([Inline],[[Block]]) -> WS m (Doc Text) definitionListItemToICML opts style (term,defs) = do @@ -470,9 +471,9 @@ inlineToICML _ _ _ il@(RawInline f str) inlineToICML opts style ident (Link _ lst (url, title)) = do content <- inlinesToICML opts (linkName:style) ident lst state $ \st -> - let link_id = if null $ links st - then 1::Int - else 1 + fst (head $ links st) + let link_id = case links st of + [] -> 1 :: Int + (l:_) -> 1 + fst l newst = st{ links = (link_id, url):links st } cont = inTags True "HyperlinkTextSource" [("Self","htss-"<>tshow link_id), ("Name",title), ("Hidden","false")] content @@ -531,11 +532,11 @@ parStyle opts style ident lst = attrs' = if firstListItemName `elem` style then let ats = attrs : [("NumberingContinue", "false")] begins = filter (Text.isPrefixOf beginsWithName) style - in if null begins - then ats - else let i = fromMaybe "" $ Text.stripPrefix beginsWithName - $ head begins - in ("NumberingStartAt", i) : ats + in case begins of + [] -> ats + (b:_) -> let i = fromMaybe "" $ + Text.stripPrefix beginsWithName b + in ("NumberingStartAt", i) : ats else [attrs] in do content <- inlinesToICML opts [] ident lst diff --git a/src/Text/Pandoc/Writers/Ipynb.hs b/src/Text/Pandoc/Writers/Ipynb.hs index 2613851c5..76e2e2e09 100644 --- a/src/Text/Pandoc/Writers/Ipynb.hs +++ b/src/Text/Pandoc/Writers/Ipynb.hs @@ -14,9 +14,9 @@ Ipynb (Jupyter notebook JSON format) writer for pandoc. -} module Text.Pandoc.Writers.Ipynb ( writeIpynb ) where -import Control.Monad.State import qualified Data.Map as M import Data.Maybe (catMaybes, fromMaybe) +import Control.Monad (foldM) import Text.Pandoc.Options import Text.Pandoc.Definition import Data.Ipynb as Ipynb diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index a9369db7a..b2095329e 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -20,8 +20,6 @@ module Text.Pandoc.Writers.JATS , writeJatsPublishing , writeJatsArticleAuthoring ) where -import Control.Monad.Reader -import Control.Monad.State import Data.Generics (everywhere, mkT) import Data.List (partition) import qualified Data.Map as M @@ -50,6 +48,7 @@ import Text.Pandoc.XML import Text.TeXMath import qualified Text.Pandoc.Writers.AnnotatedTable as Ann import qualified Text.XML.Light as Xml +import Control.Monad (msum) -- | Convert a @'Pandoc'@ document to JATS (Archiving and Interchange -- Tag Set.) diff --git a/src/Text/Pandoc/Writers/JATS/Types.hs b/src/Text/Pandoc/Writers/JATS/Types.hs index 6fdddc0b5..33f6be930 100644 --- a/src/Text/Pandoc/Writers/JATS/Types.hs +++ b/src/Text/Pandoc/Writers/JATS/Types.hs @@ -18,9 +18,6 @@ module Text.Pandoc.Writers.JATS.Types where import Citeproc.Types (Reference) -import Control.Monad.Reader (ReaderT) -import Control.Monad.State (StateT) -import Data.Text (Text) import Text.DocLayout (Doc) import Text.Pandoc.Builder (Block, Inline, Inlines) import Text.Pandoc.Options (WriterOptions) diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 180aaa44d..4e2266fa6 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -107,11 +107,12 @@ pandocToLaTeX options (Pandoc meta blocks) = do Nothing -> return () Just "false" -> return () Just _ -> modify $ \s -> s{stCsquotes = True} - let (blocks'', lastHeader) = if writerCiteMethod options == Citeproc then - (blocks', []) - else case reverse blocks' of - Header 1 _ il : _ -> (init blocks', il) - _ -> (blocks', []) + let (blocks'', lastHeader) = + if writerCiteMethod options == Citeproc + then (blocks', []) + else case viaNonEmpty (\bs -> (last bs, init bs)) blocks' of + Just (Header 1 _ il, bsInit) -> (bsInit, il) + _ -> (blocks', []) blocks''' <- if beamer then toSlides blocks'' else return $ makeSections False Nothing blocks'' @@ -851,12 +852,12 @@ inlineToLaTeX (Quoted qt lst) = do DoubleQuote -> "\\enquote" <> braces contents SingleQuote -> "\\enquote*" <> braces contents else do - let s1 = if not (null lst) && isQuoted (head lst) - then "\\," - else empty - let s2 = if not (null lst) && isQuoted (last lst) - then "\\," - else empty + let s1 = case lst of + (x:_) | isQuoted x -> "\\," + _ -> empty + let s2 = case viaNonEmpty last lst of + Just x | isQuoted x -> "\\," + _ -> empty let inner = s1 <> contents <> s2 return $ case qt of DoubleQuote -> diff --git a/src/Text/Pandoc/Writers/LaTeX/Citation.hs b/src/Text/Pandoc/Writers/LaTeX/Citation.hs index f48a43d7a..3844f9b17 100644 --- a/src/Text/Pandoc/Writers/LaTeX/Citation.hs +++ b/src/Text/Pandoc/Writers/LaTeX/Citation.hs @@ -43,16 +43,19 @@ citationsToNatbib inlineListToLaTeX [one] NormalCitation -> "citep" citationsToNatbib inlineListToLaTeX cits - | noPrefix (tail cits) && noSuffix (init cits) && ismode NormalCitation cits - = citeCommand inlineListToLaTeX "citep" p s ks + | Just citsTail <- viaNonEmpty tail cits + , Just citsInit <- viaNonEmpty init cits + , Just citsHead <- viaNonEmpty head cits + , Just citsLast <- viaNonEmpty last cits + , noPrefix citsTail + , noSuffix citsInit + , ismode NormalCitation cits + = citeCommand inlineListToLaTeX "citep" + (citationPrefix citsHead) (citationSuffix citsLast) ks where noPrefix = all (null . citationPrefix) noSuffix = all (null . citationSuffix) ismode m = all ((==) m . citationMode) - p = citationPrefix $ - head cits - s = citationSuffix $ - last cits ks = T.intercalate ", " $ map citationId cits citationsToNatbib inlineListToLaTeX (c:cs) diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index edb70f53e..e81545380 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -175,8 +175,7 @@ blockToMan opts (BulletList items) = do return (vcat contents) blockToMan opts (OrderedList attribs items) = do let markers = take (length items) $ orderedListMarkers attribs - let indent = 1 + - maximum (map T.length markers) + let indent = 1 + fromMaybe 0 (viaNonEmpty maximum1 (map T.length markers)) contents <- mapM (\(num, item) -> orderedListItemToMan opts num indent item) $ zip markers items return (vcat contents) diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 533bcc071..05d22f754 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -23,7 +23,7 @@ module Text.Pandoc.Writers.Markdown ( import Control.Monad.Reader import Control.Monad.State.Strict import Data.Default -import Data.List (intersperse, sortOn, transpose) +import Data.List (intersperse, sortOn, transpose, zipWith3) import qualified Data.Map as M import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Set as Set @@ -497,7 +497,10 @@ blockToMarkdown' opts (CodeBlock attribs str) = do , T.pack [c,c,c] `T.isPrefixOf` ln , T.all (== c) ln] of [] -> T.replicate 3 $ T.singleton c - xs -> T.replicate (maximum xs + 1) $ T.singleton c + xs -> T.replicate + (fromMaybe 0 + (viaNonEmpty maximum1 xs) + 1) + (T.singleton c) backticks = endline '`' tildes = endline '~' attrs = if isEnabled Ext_fenced_code_attributes opts @@ -517,8 +520,8 @@ blockToMarkdown' opts (BlockQuote blocks) = do return $ prefixed leader contents <> blankline blockToMarkdown' opts t@(Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot - let numcols = maximum (length aligns : length widths : - map length (headers:rows)) + let numcols = maximum1 + (length aligns :| length widths : map length (headers:rows)) caption' <- inlineListToMarkdown opts caption let caption'' | null caption = blankline @@ -619,7 +622,8 @@ pipeTable headless aligns rawHeaders rawRows = do blockFor AlignCenter x y = cblock (x + 2) (sp <> y <> sp) <> lblock 0 empty blockFor AlignRight x y = rblock (x + 2) (y <> sp) <> lblock 0 empty blockFor _ x y = lblock (x + 2) (sp <> y) <> lblock 0 empty - let widths = map (max 3 . maximum . map offset) $ transpose (rawHeaders : rawRows) + let widths = map (max 3 . fromMaybe 0 . viaNonEmpty maximum1 . map offset) + $ transpose (rawHeaders : rawRows) let torow cs = nowrap $ literal "|" <> hcat (intersperse (literal "|") $ zipWith3 blockFor aligns widths (map chomp cs)) @@ -653,11 +657,11 @@ pandocTable opts multiline headless aligns widths rawHeaders rawRows = do -- Number of characters per column necessary to output every cell -- without requiring a line break. -- The @+2@ is needed for specifying the alignment. - let numChars = (+ 2) . maximum . map offset + let numChars = (+ 2) . fromMaybe 0 . viaNonEmpty maximum1 . map offset -- Number of characters per column necessary to output every cell -- without requiring a line break *inside a word*. -- The @+2@ is needed for specifying the alignment. - let minNumChars = (+ 2) . maximum . map minOffset + let minNumChars = (+ 2) . fromMaybe 0 . viaNonEmpty maximum1 . map minOffset let columns = transpose (rawHeaders : rawRows) -- minimal column width without wrapping a single word let relWidth w col = diff --git a/src/Text/Pandoc/Writers/Markdown/Inline.hs b/src/Text/Pandoc/Writers/Markdown/Inline.hs index 19157701e..5592340f5 100644 --- a/src/Text/Pandoc/Writers/Markdown/Inline.hs +++ b/src/Text/Pandoc/Writers/Markdown/Inline.hs @@ -383,9 +383,7 @@ inlineToMarkdown opts (Quoted DoubleQuote lst) = do else "“" <> contents <> "”" inlineToMarkdown opts (Code attr str) = do let tickGroups = filter (T.any (== '`')) $ T.group str - let longest = if null tickGroups - then 0 - else maximum $ map T.length tickGroups + let longest = fromMaybe 0 $ viaNonEmpty maximum1 $ map T.length tickGroups let marker = T.replicate (longest + 1) "`" let spacer = if longest == 0 then "" else " " let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr @@ -440,7 +438,8 @@ inlineToMarkdown opts il@(RawInline f str) = do let tickGroups = filter (T.any (== '`')) $ T.group str let numticks = if null tickGroups then 1 - else 1 + maximum (map T.length tickGroups) + else maybe 1 (1 +) $ + viaNonEmpty maximum1 (map T.length tickGroups) variant <- asks envVariant let Format fmt = f let rawAttribInline = return $ diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 5029be69f..f4203e097 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -245,7 +245,10 @@ definitionListItemToMediaWiki (label, items) = do else do marker <- asks listLevel return $ T.pack marker <> " " <> labelText <> "\n" <> - T.intercalate "\n" (map (\d -> T.pack (init marker) <> ": " <> d) contents) + T.intercalate "\n" + (map (\d -> + maybe mempty T.pack (viaNonEmpty init marker) <> + ": " <> d) contents) -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. isSimpleList :: Block -> Bool diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index 48395c420..791189469 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -274,8 +274,7 @@ blockToMs opts (BulletList items) = do return (vcat contents) blockToMs opts (OrderedList attribs items) = do let markers = take (length items) $ orderedListMarkers attribs - let indent = 2 + - maximum (map T.length markers) + let indent = 2 + fromMaybe 0 (viaNonEmpty maximum1 (map T.length markers)) contents <- mapM (\(num, item) -> orderedListItemToMs opts num indent item) $ zip markers items setFirstPara diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index bf3265107..242769f73 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -158,7 +158,8 @@ simpleTable caption headers rows = do caption' <- inlineListToMuse caption headers' <- mapM blockListToMuse headers rows' <- mapM (mapM blockListToMuse) rows - let widthsInChars = maximum . map offset <$> transpose (headers' : rows') + let widthsInChars = fromMaybe 0 . viaNonEmpty maximum1 . map offset + <$> transpose (headers' : rows') let hpipeBlocks sep blocks = hcat $ intersperse sep' blocks where sep' = lblock (T.length sep) $ literal sep let makeRow sep = hpipeBlocks sep . zipWith lblock widthsInChars @@ -238,8 +239,8 @@ blockToMuse (DefinitionList items) = do label' <- local (\env -> env { envOneLine = True, envAfterSpace = True }) $ inlineListToMuse' label let ind = offset' label' -- using Text.DocLayout.offset results in round trip failures hang ind (nowrap label') . vcat <$> mapM descriptionToMuse defs - where offset' d = maximum (0: map T.length - (T.lines $ render Nothing d)) + where offset' d = maximum1 + (0 :| map T.length (T.lines $ render Nothing d)) descriptionToMuse :: PandocMonad m => [Block] -> Muse m (Doc Text) @@ -269,7 +270,8 @@ blockToMuse (Table _ blkCapt specs thead tbody tfoot) = (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot blocksToDoc opts blocks = local (\env -> env { envOptions = opts }) $ blockListToMuse blocks - numcols = maximum (length aligns : length widths : map length (headers:rows)) + numcols = maximum1 + (length aligns :| length widths : map length (headers:rows)) isSimple = onlySimpleTableCells (headers : rows) && all (== 0) widths blockToMuse (Div _ bs) = flatBlockListToMuse bs blockToMuse Null = return empty @@ -711,7 +713,11 @@ inlineToMuse (Span (anchor,names,kvs) inlines) = do then mempty else literal ("#" <> anchor) <> space modify $ \st -> st { stUseTags = False } - return $ anchorDoc <> (if null inlines && not (T.null anchor) - then mempty - else (if null names then (if hasDir then contents' else "<class>" <> contents' <> "</class>") - else "<class name=\"" <> literal (head names) <> "\">" <> contents' <> "</class>")) + return $ anchorDoc <> + (if null inlines && not (T.null anchor) + then mempty + else case names of + [] | hasDir -> contents' + | otherwise -> "<class>" <> contents' <> "</class>" + (n:_) -> "<class name=\"" <> literal n <> + "\">" <> contents' <> "</class>") diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index 9c2ce805d..493e0a1b9 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -18,6 +18,7 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad) import Text.Pandoc.Definition import Text.Pandoc.Options (WrapOption (..), WriterOptions (..)) import Text.DocLayout +import Text.Show hiding (show) prettyList :: [Doc Text] -> Doc Text prettyList ds = diff --git a/src/Text/Pandoc/Writers/OOXML.hs b/src/Text/Pandoc/Writers/OOXML.hs index 0533d6c12..792ce05fa 100644 --- a/src/Text/Pandoc/Writers/OOXML.hs +++ b/src/Text/Pandoc/Writers/OOXML.hs @@ -50,9 +50,6 @@ nodename s = QName{ qName = name, qURI = Nothing, qPrefix = prefix } Nothing -> (xs, Nothing) Just (_,zs) -> (zs, Just xs) -toLazy :: B.ByteString -> BL.ByteString -toLazy = BL.fromChunks . (:[]) - renderXml :: Element -> BL.ByteString renderXml elt = BL.fromStrict (UTF8.fromText (showTopElement elt)) diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index cf42f2228..b9d8de756 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -15,7 +15,7 @@ Conversion of 'Pandoc' documents to OpenDocument XML. -} module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where import Control.Arrow ((***), (>>>)) -import Control.Monad.State.Strict hiding (when) +import Control.Monad.State.Strict import Data.Char (chr) import Data.Foldable (find) import Data.List (sortOn, sortBy, foldl') @@ -97,9 +97,6 @@ defaultWriterState = , stIdentTypes = [] } -when :: Bool -> Doc Text -> Doc Text -when p a = if p then a else empty - addTableStyle :: PandocMonad m => Doc Text -> OD m () addTableStyle i = modify $ \s -> s { stTableStyles = i : stTableStyles s } @@ -226,7 +223,9 @@ handleSpaces s = case T.uncons s of _ -> rm s where genTag = T.span (==' ') >>> tag . T.length *** rm >>> uncurry (<>) - tag n = when (n /= 0) $ selfClosingTag "text:s" [("text:c", tshow n)] + tag n = if n /= 0 + then selfClosingTag "text:s" [("text:c", tshow n)] + else mempty rm t = case T.uncons t of Just ( ' ',xs) -> char ' ' <> genTag xs Just ('\t',xs) -> selfClosingTag "text:tab" [] <> genTag xs @@ -309,9 +308,11 @@ orderedItemToOpenDocument o n bs = vcat <$> mapM go bs go b = blockToOpenDocument o b newLevel a l = do nn <- length <$> gets stParaStyles - ls <- head <$> gets stListStyles - modify $ \s -> s { stListStyles = orderedListLevelStyle a ls : - drop 1 (stListStyles s) } + listStyles <- gets stListStyles + case listStyles of + [] -> return () + (lst:rest) -> modify $ \s -> s { stListStyles = + orderedListLevelStyle a lst : rest } inTagsIndented "text:list" <$> orderedListToOpenDocument o nn l isTightList :: [[Block]] -> Bool @@ -720,7 +721,8 @@ bulletListStyle l = do [ ("text:level" , tshow (i + 1)) , ("text:style-name" , "Bullet_20_Symbols" ) , ("style:num-suffix", "." ) - , ("text:bullet-char", T.singleton (bulletList !! i)) + , ("text:bullet-char", maybe mempty T.singleton + (bulletList !!? i)) ] (listLevelStyle (1 + i)) bulletList = map chr $ cycle [8226,9702,9642] listElStyle = map doStyles [0..9] diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 29d58a161..345f1cfd0 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -163,7 +163,7 @@ blockToOrg (Table _ blkCapt specs thead tbody tfoot) = do else "#+caption: " <> caption'' headers' <- mapM blockListToOrg headers rawRows <- mapM (mapM blockListToOrg) rows - let numChars = maximum . map offset + let numChars = fromMaybe 0 . viaNonEmpty maximum1 . map offset -- FIXME: width is not being used. let widthsInChars = map numChars $ transpose (headers' : rawRows) @@ -198,7 +198,8 @@ blockToOrg (OrderedList (start, _, delim) items) = do x -> x let markers = take (length items) $ orderedListMarkers (start, Decimal, delim') - let maxMarkerLength = maximum $ map T.length markers + let maxMarkerLength = + fromMaybe 0 $ viaNonEmpty maximum1 $ map T.length markers let markers' = map (\m -> let s = maxMarkerLength - T.length m in m <> T.replicate s " ") markers contents <- zipWithM orderedListItemToOrg markers' items diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index 5caeb0753..a9fb4e46a 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -17,9 +17,8 @@ module Text.Pandoc.Writers.Powerpoint.Output ( presentationToArchive ) where import Control.Monad.Except (throwError, catchError) -import Control.Monad.Reader -import Control.Monad.State import Codec.Archive.Zip +import Control.Monad (foldM) import Data.List (intercalate, stripPrefix, nub, union, isPrefixOf, intersperse) import Data.Default import Data.Text (Text) @@ -477,11 +476,12 @@ registerLink link = do let maxLinkId = case M.lookup curSlideId linkReg of Just mp -> case M.keys mp of [] -> if hasSpeakerNotes then 2 else 1 - ks -> maximum ks + ks -> fromMaybe 0 $ viaNonEmpty maximum1 ks Nothing -> if hasSpeakerNotes then 2 else 1 maxMediaId = case M.lookup curSlideId mediaReg of Just [] -> if hasSpeakerNotes then 2 else 1 - Just mInfos -> maximum $ map mInfoLocalId mInfos + Just mInfos -> fromMaybe 0 $ viaNonEmpty maximum1 + $ map mInfoLocalId mInfos Nothing -> if hasSpeakerNotes then 2 else 1 maxId = max maxLinkId maxMediaId slideLinks = case M.lookup curSlideId linkReg of @@ -500,17 +500,18 @@ registerMedia fp caption = do let maxLinkId = case M.lookup curSlideId linkReg of Just mp -> case M.keys mp of [] -> if hasSpeakerNotes then 2 else 1 - ks -> maximum ks + ks -> fromMaybe 0 $ viaNonEmpty maximum1 ks Nothing -> if hasSpeakerNotes then 2 else 1 maxMediaId = case M.lookup curSlideId mediaReg of Just [] -> if hasSpeakerNotes then 2 else 1 - Just mInfos -> maximum $ map mInfoLocalId mInfos + Just mInfos -> fromMaybe 0 $ viaNonEmpty maximum1 + $ map mInfoLocalId mInfos Nothing -> if hasSpeakerNotes then 2 else 1 maxLocalId = max maxLinkId maxMediaId maxGlobalId = case M.elems globalIds of [] -> 0 - ids -> maximum ids + ids -> fromMaybe 0 $ viaNonEmpty maximum1 ids (imgBytes, mbMt) <- P.fetchItem $ T.pack fp let imgExt = (mbMt >>= extensionFromMimeType >>= (\x -> return $ "." <> x)) @@ -1431,7 +1432,7 @@ presentationToRels pres@(Presentation _ slides) = do [] -> 0 -- doesn't matter in this case, since -- there will be nothing to map the -- function over - l -> minimum l + l -> fromMaybe 0 $ viaNonEmpty minimum1 l modifyRelNum :: Int -> Int modifyRelNum 1 = 1 diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index affec38aa..a5d2dfac1 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -42,8 +42,7 @@ module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation ) where -import Control.Monad.Reader -import Control.Monad.State +import Control.Monad.State (liftM) import Data.List (intercalate) import Data.Default import Text.Pandoc.Definition @@ -363,9 +362,7 @@ inlineToParElems (Note blks) = do then return [] else do notes <- gets stNoteIds - let maxNoteId = case M.keys notes of - [] -> 0 - lst -> maximum lst + let maxNoteId = fromMaybe 0 $ viaNonEmpty maximum1 $ M.keys notes curNoteId = maxNoteId + 1 modify $ \st -> st { stNoteIds = M.insert curNoteId blks notes } local (\env -> env{envRunProps = (envRunProps env){rLink = Just $ InternalTarget endNotesSlideId}}) $ diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index d01e13db4..ae1913a60 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -266,7 +266,7 @@ blockToRST (Header level (name,classes,_) inlines) = do isTopLevel <- gets stTopLevel if isTopLevel then do - let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1) + let headerChar = fromMaybe ' ' $ "=-~^'" !!? (level - 1) let border = literal $ T.replicate (offset contents) $ T.singleton headerChar let anchor | T.null name || name == autoId = empty | otherwise = ".. _" <> literal name <> ":" $$ blankline @@ -335,7 +335,8 @@ blockToRST (OrderedList (start, style', delim) items) = do then replicate (length items) "#." else take (length items) $ orderedListMarkers (start, style', delim) - let maxMarkerLength = maximum $ map T.length markers + let maxMarkerLength = + fromMaybe 0 $ viaNonEmpty maximum1 $ map T.length markers let markers' = map (\m -> let s = maxMarkerLength - T.length m in m <> T.replicate s " ") markers contents <- zipWithM orderedListItemToRST markers' items @@ -509,7 +510,7 @@ flatten outer | null contents = [outer] | otherwise = combineAll contents where contents = dropInlineParent outer - combineAll = foldl combine [] + combineAll = foldl' combine [] combine :: [Inline] -> Inline -> [Inline] combine f i = @@ -539,9 +540,12 @@ flatten outer appendToLast :: [Inline] -> [Inline] -> [Inline] appendToLast [] toAppend = [setInlineChildren outer toAppend] appendToLast flattened toAppend - | isOuter lastFlat = init flattened <> [appendTo lastFlat toAppend] + | Just lastFlat <- mblastFlat + , isOuter lastFlat = + fromMaybe [] (viaNonEmpty init flattened) + <> [appendTo lastFlat toAppend] | otherwise = flattened <> [setInlineChildren outer toAppend] - where lastFlat = last flattened + where mblastFlat = viaNonEmpty last flattened appendTo o i = mapNested (<> i) o isOuter i = emptyParent i == emptyParent outer emptyParent i = setInlineChildren i [] @@ -761,8 +765,7 @@ simpleTable opts blocksToDoc headers rows = do then return [] else fixEmpties <$> mapM (blocksToDoc opts) headers rowDocs <- mapM (fmap fixEmpties . mapM (blocksToDoc opts)) rows - let numChars [] = 0 - numChars xs = maximum . map offset $ xs + let numChars = fromMaybe 0 . viaNonEmpty maximum1 . map offset let colWidths = map numChars $ transpose (headerDocs : rowDocs) let toRow = mconcat . intersperse (lblock 1 " ") . zipWith lblock colWidths let hline = nowrap $ hsep (map (\n -> literal (T.replicate n "=")) colWidths) diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index cf27011c2..6df1ffb25 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -272,8 +272,9 @@ tableRowToRTF header indent aligns sizes' cols = do else sizes' columns <- T.concat <$> zipWithM (tableItemToRTF indent) aligns cols - let rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips)) - (0 :: Integer) sizes + let rightEdges = + fromMaybe [] $ viaNonEmpty tail $ scanl + (\sofar new -> sofar + floor (new * totalTwips)) (0 :: Integer) sizes let cellDefs = map (\edge -> (if header then "\\clbrdrb\\brdrs" else "") <> "\\cellx" <> tshow edge) diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index fc3f8ff3a..68e8fcd47 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -224,8 +224,8 @@ gridTable :: (Monad m, HasChars a) -> m (Doc a) gridTable opts blocksToDoc headless aligns widths headers rows = do -- the number of columns will be used in case of even widths - let numcols = maximum (length aligns : length widths : - map length (headers:rows)) + let numcols = fromMaybe 0 $ viaNonEmpty maximum1 + (length aligns : length widths : map length (headers:rows)) let officialWidthsInChars widths' = map ( (\x -> if x < 1 then 1 else x) . (\x -> x - 3) . floor . @@ -253,8 +253,7 @@ gridTable opts blocksToDoc headless aligns widths headers rows = do let handleFullWidths widths' = do rawHeaders' <- mapM (blocksToDoc opts) headers rawRows' <- mapM (mapM (blocksToDoc opts)) rows - let numChars [] = 0 - numChars xs = maximum . map offset $ xs + let numChars = fromMaybe 0 . viaNonEmpty maximum1 . map offset let minWidthsInChars = map numChars $ transpose (rawHeaders' : rawRows') let widthsInChars' = zipWith max diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index b926c48a1..7d9f9d1f9 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -149,9 +149,9 @@ blockToTEI opts (BlockQuote blocks) = blockToTEI _ (CodeBlock (_,classes,_) str) = return $ literal ("<ab type='codeblock " <> lang <> "'>") <> cr <> flush (literal (escapeStringForXML str) <> cr <> text "</ab>") - where lang = if null langs - then "" - else escapeStringForXML (head langs) + where lang = case langs of + [] -> "" + (l:_) -> escapeStringForXML l isLang l = T.toLower l `elem` map T.toLower languages langsFrom s = if isLang s then [s] diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 53da70f84..9c1b44fb7 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -271,7 +271,7 @@ tableAnyRowToTexinfo :: PandocMonad m -> [[Block]] -> TI m (Doc Text) tableAnyRowToTexinfo itemtype aligns cols = - (literal itemtype $$) . foldl (\row item -> row $$ + (literal itemtype $$) . foldl' (\row item -> row $$ (if isEmpty row then empty else text " @tab ") <> item) empty <$> zipWithM alignedBlock aligns cols alignedBlock :: PandocMonad m diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 03d030477..eb5ebdee3 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -218,7 +218,8 @@ blockToTextile opts x@(BulletList items) = do modify $ \s -> s { stListLevel = stListLevel s <> "*" } level <- gets $ length . stListLevel contents <- mapM (listItemToTextile opts) items - modify $ \s -> s { stListLevel = init (stListLevel s) } + modify $ \s -> s { stListLevel = + fromMaybe [] $ viaNonEmpty init (stListLevel s) } return $ vcat contents <> (if level > 1 then "" else "\n") blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do @@ -236,7 +237,8 @@ blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do else Nothing } level <- gets $ length . stListLevel contents <- mapM (listItemToTextile opts) items - modify $ \s -> s { stListLevel = init (stListLevel s), + modify $ \s -> s { stListLevel = + fromMaybe [] $ viaNonEmpty init (stListLevel s), stStartNum = Nothing } return $ vcat contents <> (if level > 1 then "" else "\n") diff --git a/src/Text/Pandoc/Writers/XWiki.hs b/src/Text/Pandoc/Writers/XWiki.hs index c35235650..a49989bb3 100644 --- a/src/Text/Pandoc/Writers/XWiki.hs +++ b/src/Text/Pandoc/Writers/XWiki.hs @@ -36,7 +36,7 @@ module Text.Pandoc.Writers.XWiki ( writeXWiki ) where import Control.Monad.Reader (ReaderT, asks, local, runReaderT) import qualified Data.Set as Set import qualified Data.Text as Text -import Data.Text (Text, intercalate, replace, split) +import Data.Text (Text, replace, split) import Text.Pandoc.Class.PandocMonad (PandocMonad, report) import Text.Pandoc.Definition import Text.Pandoc.Logging @@ -59,7 +59,7 @@ writeXWiki _ (Pandoc _ blocks) = -- | Concatenates strings with line breaks between them. vcat :: [Text] -> Text -vcat = intercalate "\n" +vcat = Text.intercalate "\n" -- If an id is provided, we can generate an anchor using the id macro -- https://extensions.xwiki.org/xwiki/bin/view/Extension/Id%20Macro @@ -139,7 +139,7 @@ tableCellXWiki :: PandocMonad m => Bool -> [Block] -> XWikiReader m Text tableCellXWiki isHeader cell = do contents <- blockListToXWiki cell let isMultiline = (length . split (== '\n')) contents > 1 - let contents' = intercalate contents $ if isMultiline then ["(((", ")))"] else [mempty, mempty] + let contents' = Text.intercalate contents $ if isMultiline then ["(((", ")))"] else [mempty, mempty] let cellBorder = if isHeader then "|=" else "|" return $ cellBorder <> contents' @@ -260,7 +260,7 @@ definitionListItemToMediaWiki (label, items) = do contents <- mapM blockListToXWiki items marker <- asks listLevel return $ marker <> " " <> labelText <> "\n" <> - intercalate "\n" (map (\d -> Text.init marker <> ": " <> d) contents) + Text.intercalate "\n" (map (\d -> Text.init marker <> ": " <> d) contents) -- Escape the escape character, as well as formatting pairs escapeXWikiString :: Text -> Text diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 9e45f0417..c5f9c6762 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -140,10 +140,12 @@ blockToZimWiki opts (Table _ blkCapt specs thead tbody tfoot) = do c <- inlineListToZimWiki opts capt return $ "" <> c <> "\n" headers' <- if all null headers - then zipWithM (tableItemToZimWiki opts) aligns (head rows) + then fromMaybe (return []) $ viaNonEmpty + (zipWithM (tableItemToZimWiki opts) aligns . head) rows else mapM (inlineListToZimWiki opts . removeFormatting)headers -- emphasis, links etc. are not allowed in table headers rows' <- mapM (zipWithM (tableItemToZimWiki opts) aligns) rows - let widths = map (maximum . map T.length) $ transpose (headers':rows') + let widths = map (fromMaybe 0 . viaNonEmpty maximum1 . map T.length) + $ transpose (headers':rows') let padTo (width, al) s = case width - T.length s of x | x > 0 -> diff --git a/stack.yaml b/stack.yaml index ea494552e..d31c6c28f 100644 --- a/stack.yaml +++ b/stack.yaml @@ -9,6 +9,7 @@ extra-deps: - hslua-module-path-0.1.0 - jira-wiki-markup-1.3.4 - citeproc-0.3.0.9 +- relude-1.0.0.0 #- citeproc: # git: https://github.com/jgm/citeproc.git # commit: feb3b7580c6738eec3b23921f7c1739cfba611aa diff --git a/test/Tests/Command.hs b/test/Tests/Command.hs index 59b04eac1..e3d9b636a 100644 --- a/test/Tests/Command.hs +++ b/test/Tests/Command.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TupleSections #-} +{-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Command Copyright : © 2006-2021 John MacFarlane @@ -35,8 +36,8 @@ import qualified Text.Pandoc.UTF8 as UTF8 -- | Run a test with and return output. execTest :: String -- ^ Path to test executable -> String -- ^ Shell command - -> String -- ^ Input text - -> IO (ExitCode, String) -- ^ Exit code and actual output + -> Text -- ^ Input text + -> IO (ExitCode, Text) -- ^ Exit code and actual output execTest testExePath cmd inp = do mldpath <- Env.lookupEnv "LD_LIBRARY_PATH" mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH" @@ -48,9 +49,9 @@ execTest testExePath cmd inp = do maybe [] ((:[]) . ("LD_LIBRARY_PATH",)) mldpath ++ maybe [] ((:[]) . ("DYLD_LIBRARY_PATH",)) mdyldpath let pr = (shell (pandocToEmulate True cmd)){ env = Just env' } - (ec, out', err') <- readCreateProcessWithExitCode pr inp + (ec, out', err') <- readCreateProcessWithExitCode pr (T.unpack inp) -- filter \r so the tests will work on Windows machines - let out = filter (/= '\r') $ err' ++ out' + let out = T.pack $ filter (/= '\r') $ err' ++ out' case ec of ExitFailure _ -> hPutStr stderr err' ExitSuccess -> return () @@ -68,8 +69,8 @@ pandocToEmulate _ [] = [] runTest :: String -- ^ Path to test executable -> String -- ^ Title of test -> String -- ^ Shell command - -> String -- ^ Input text - -> String -- ^ Expected output + -> Text -- ^ Input text + -> Text -- ^ Expected output -> TestTree runTest testExePath testname cmd inp norm = testCase testname $ do (ec, out) <- execTest testExePath cmd inp @@ -96,22 +97,23 @@ isCodeBlock :: Block -> Bool isCodeBlock (CodeBlock _ _) = True isCodeBlock _ = False -extractCode :: Block -> String -extractCode (CodeBlock _ code) = T.unpack code +extractCode :: Block -> Text +extractCode (CodeBlock _ code) = code extractCode _ = "" dropPercent :: String -> String dropPercent ('%':xs) = dropWhile (== ' ') xs dropPercent xs = xs -runCommandTest :: FilePath -> FilePath -> Int -> String -> TestTree +runCommandTest :: FilePath -> FilePath -> Int -> Text -> TestTree runCommandTest testExePath fp num code = goldenTest testname getExpected getActual compareValues updateGolden where testname = "#" <> show num codelines = lines code - (continuations, r1) = span ("\\" `isSuffixOf`) codelines - cmd = dropPercent (unwords (map init continuations ++ take 1 r1)) + (continuations, r1) = span ("\\" `T.isSuffixOf`) codelines + cmd = dropPercent $ T.unpack $ T.unwords $ + map (T.dropEnd 1) continuations ++ take 1 r1 r2 = drop 1 r1 (inplines, r3) = break (=="^D") r2 normlines = takeWhile (/=".") (drop 1 r3) @@ -123,14 +125,16 @@ runCommandTest testExePath fp num code = | actual == expected = return Nothing | otherwise = return $ Just $ "--- test/command/" ++ fp ++ "\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) - (getDiff (lines actual) (lines expected)) + (getDiff + (lines actual) + (lines expected)) updateGolden newnorm = do let fp' = "command" </> fp raw <- UTF8.readFile fp' - let cmdline = "% " <> cmd + let cmdline = "% " <> T.pack cmd let x = cmdline <> "\n" <> input <> "^D\n" <> norm let y = cmdline <> "\n" <> input <> "^D\n" <> newnorm - let updated = T.replace (T.pack x) (T.pack y) raw + let updated = T.replace x y raw UTF8.writeFile fp' updated extractCommandTest :: FilePath -> FilePath -> TestTree diff --git a/test/Tests/Helpers.hs b/test/Tests/Helpers.hs index 64c2785ed..c8957a050 100644 --- a/test/Tests/Helpers.hs +++ b/test/Tests/Helpers.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Helpers Copyright : © 2006-2021 John MacFarlane @@ -17,73 +18,77 @@ module Tests.Helpers ( test , (=?>) , purely , ToString(..) + , ToText(..) , ToPandoc(..) ) where import Data.Algorithm.Diff import qualified Data.Map as M -import Data.Text (Text, unpack) +import qualified Data.Text as T import System.Exit import Test.Tasty import Test.Tasty.HUnit -import Text.Pandoc.Builder (Blocks, Inlines, doc, plain) +import Text.Pandoc.Builder (Blocks, Inlines, doc, plain, nullMeta) import Text.Pandoc.Class import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared (trimr) import Text.Pandoc.Writers.Native (writeNative) import Text.Printf +import qualified GHC.Show +import Prelude hiding (First) -test :: (ToString a, ToString b, ToString c, HasCallStack) +test :: (ToText a, ToText b, ToText c, HasCallStack) => (a -> b) -- ^ function to test -> String -- ^ name of test case -> (a, c) -- ^ (input, expected value) -> TestTree test fn name (input, expected) = - testCase name' $ assertBool msg (actual' == expected') - where msg = nl ++ dashes "input" ++ nl ++ input' ++ nl ++ - dashes "result" ++ nl ++ - unlines (map vividize diff) ++ + testCase name' $ assertBool (T.unpack msg) (actual' == expected') + where msg = nl <> dashes "input" <> nl <> input' <> nl <> + dashes "result" <> nl <> + T.unlines (map vividize diff) <> dashes "" nl = "\n" name' = if length name > 54 - then take 52 name ++ "..." -- avoid wide output + then Prelude.take 52 name ++ "..." -- avoid wide output else name - input' = toString input - actual' = lines $ toString $ fn input - expected' = lines $ toString expected + input' = toText input + actual' = T.lines $ toText $ fn input + expected' = T.lines $ toText expected diff = getDiff expected' actual' - dashes "" = replicate 72 '-' - dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---" + dashes "" = T.replicate 72 "-" + dashes x = T.replicate (72 - T.length x - 5) "-" <> + " " <> x <> " ---" data TestResult = TestPassed | TestError ExitCode - | TestFailed String FilePath [Diff String] + | TestFailed String FilePath [Diff Text] deriving (Eq) instance Show TestResult where show TestPassed = "PASSED" - show (TestError ec) = "ERROR " ++ show ec - show (TestFailed cmd file d) = '\n' : dash ++ - "\n--- " ++ file ++ - "\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) d ++ - dash + show (TestError ec) = "ERROR " <> show ec + show (TestFailed cmd file d) = "\n" <> dash <> + "\n--- " <> file <> + "\n+++ " <> cmd <> "\n" <> + showDiff (1,1) d <> dash where dash = replicate 72 '-' -showDiff :: (Int,Int) -> [Diff String] -> String +showDiff :: ToString a => (Int,Int) -> [Diff a] -> String showDiff _ [] = "" showDiff (l,r) (First ln : ds) = - printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds + printf "+%4d " l <> toString ln <> "\n" <> showDiff (l+1,r) ds showDiff (l,r) (Second ln : ds) = - printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds + printf "-%4d " r <> toString ln <> "\n" <> showDiff (l,r+1) ds showDiff (l,r) (Both _ _ : ds) = showDiff (l+1,r+1) ds -vividize :: Diff String -> String -vividize (Both s _) = " " ++ s -vividize (First s) = "- " ++ s -vividize (Second s) = "+ " ++ s +vividize :: Diff Text -> Text +vividize (Both s _) = " " <> s +vividize (First s) = "- " <> s +vividize (Second s) = "+ " <> s purely :: (b -> PandocPure a) -> b -> a purely f = either (error . show) id . runPure . f @@ -92,28 +97,28 @@ infix 5 =?> (=?>) :: a -> b -> (a,b) x =?> y = (x, y) -class ToString a where - toString :: a -> String - instance ToString Pandoc where - toString d = unpack $ - purely (writeNative def{ writerTemplate = s }) $ toPandoc d - where s = case d of - (Pandoc (Meta m) _) - | M.null m -> Nothing - | otherwise -> Just mempty -- need this to get meta output + toString = T.unpack . toText instance ToString Blocks where - toString = unpack . purely (writeNative def) . toPandoc + toString = T.unpack . toText instance ToString Inlines where - toString = unpack . trimr . purely (writeNative def) . toPandoc + toString = T.unpack . toText + +instance ToText Pandoc where + toText d@(Pandoc (Meta m) _) + | M.null m + = purely (writeNative def) $ toPandoc d + toText d@(Pandoc m _) + = purely (writeNative def{ writerTemplate = Just mempty }) $ toPandoc d + -- need this to get meta output -instance ToString String where - toString = id +instance ToText Blocks where + toText = purely (writeNative def) . toPandoc -instance ToString Text where - toString = unpack +instance ToText Inlines where + toText = T.stripEnd . purely (writeNative def) . toPandoc class ToPandoc a where toPandoc :: a -> Pandoc diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index 31c011900..35be57da7 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -230,7 +230,7 @@ roundtripEqual x = (x ==) <$> roundtripped Lua.push x size <- Lua.gettop when (size - oldSize /= 1) $ - error ("not exactly one additional element on the stack: " ++ show size) + error ("not exactly one additional element on the stack: " <> show size) Lua.peek (-1) runLuaTest :: Lua.Lua a -> IO a diff --git a/test/Tests/Old.hs b/test/Tests/Old.hs index 160086be2..fefe36795 100644 --- a/test/Tests/Old.hs +++ b/test/Tests/Old.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TupleSections #-} +{-# LANGUAGE OverloadedStrings #-} {- | Module : Tests.Old Copyright : © 2006-2021 John MacFarlane @@ -229,10 +230,6 @@ tests pandocPath = lhsReaderTest' = lhsReaderTest pandocPath extWriterTests' = extendedWriterTests pandocPath --- makes sure file is fully closed after reading -readFile' :: FilePath -> IO String -readFile' f = do s <- UTF8.readFile f - return $! (T.length s `seq` T.unpack s) lhsWriterTests :: FilePath -> String -> [TestTree] lhsWriterTests pandocPath format @@ -289,13 +286,9 @@ fb2WriterTest pandocPath title opts inputfile normfile = testWithNormalize (ignoreBinary . formatXML) pandocPath title (["-t", "fb2"]++opts) inputfile normfile where - formatXML xml = splitTags $ zip xml (drop 1 xml) - splitTags [] = [] - splitTags [end] = [fst end, snd end] - splitTags (('>','<'):rest) = ">\n" ++ splitTags rest - splitTags ((c,_):rest) = c : splitTags rest + formatXML = T.replace "><" ">\n<" ignoreBinary = unlines . filter (not . startsWith "<binary ") . lines - startsWith tag str = all (uncurry (==)) $ zip tag str + startsWith tag str = tag `T.isPrefixOf` str -- | Run a test without normalize function, return True if test passed. test :: FilePath -- ^ Path of pandoc executable @@ -307,7 +300,7 @@ test :: FilePath -- ^ Path of pandoc executable test = testWithNormalize id -- | Run a test with normalize function, return True if test passed. -testWithNormalize :: (String -> String) -- ^ Normalize function for output +testWithNormalize :: (Text -> Text) -- ^ Normalize function for output -> FilePath -- ^ Path to pandoc executable -> String -- ^ Title of test -> [String] -- ^ Options to pass to pandoc @@ -317,7 +310,7 @@ testWithNormalize :: (String -> String) -- ^ Normalize function for output testWithNormalize normalizer pandocPath testname opts inp norm = goldenTest testname getExpected getActual (compareValues norm options) updateGolden - where getExpected = normalizer <$> readFile' norm + where getExpected = normalizer <$> UTF8.readFile norm getActual = do mldpath <- Env.lookupEnv "LD_LIBRARY_PATH" mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH" @@ -330,23 +323,23 @@ testWithNormalize normalizer pandocPath testname opts inp norm = (ec, out) <- pipeProcess (Just env) pandocPath ("--emulate":options) mempty if ec == ExitSuccess - then return $ filter (/='\r') . normalizer + then return $ normalizer $ T.pack $ filter (/='\r') $ UTF8.toStringLazy out -- filter \r so the tests will work on Windows machines else fail $ "Pandoc failed with error code " ++ show ec - updateGolden = UTF8.writeFile norm . T.pack + updateGolden = UTF8.writeFile norm options = ["--data-dir=../data","--quiet"] ++ [inp] ++ opts -compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String) +compareValues :: FilePath -> [String] -> Text -> Text -> IO (Maybe String) compareValues norm options expected actual = do testExePath <- getExecutablePath - let cmd = testExePath ++ " --emulate " ++ unwords options + let cmd = testExePath ++ " --emulate " ++ intercalate " " options let dash = replicate 72 '-' let diff = getDiff (lines actual) (lines expected) if expected == actual then return Nothing else return $ Just $ - '\n' : dash ++ - "\n--- " ++ norm ++ - "\n+++ " ++ cmd ++ "\n" ++ - showDiff (1,1) diff ++ dash + "\n" <> dash <> + "\n--- " <> norm <> + "\n<>+ " <> cmd <> "\n" <> + showDiff (1,1) diff <> dash diff --git a/test/Tests/Readers/Creole.hs b/test/Tests/Readers/Creole.hs index 3320b78e8..582df693b 100644 --- a/test/Tests/Readers/Creole.hs +++ b/test/Tests/Readers/Creole.hs @@ -25,7 +25,7 @@ creole :: Text -> Pandoc creole = purely $ readCreole def{ readerStandalone = True } infix 4 =: -(=:) :: ToString c +(=:) :: ToText c => String -> (Text, c) -> TestTree (=:) = test creole diff --git a/test/Tests/Readers/Docx.hs b/test/Tests/Readers/Docx.hs index 263e04173..59bac0213 100644 --- a/test/Tests/Readers/Docx.hs +++ b/test/Tests/Readers/Docx.hs @@ -40,8 +40,8 @@ noNorm = NoNormPandoc defopts :: ReaderOptions defopts = def{ readerExtensions = getDefaultExtensions "docx" } -instance ToString NoNormPandoc where - toString d = T.unpack $ purely (writeNative def{ writerTemplate = s }) $ toPandoc d +instance ToText NoNormPandoc where + toText d = purely (writeNative def{ writerTemplate = s }) $ toPandoc d where s = case d of NoNormPandoc (Pandoc (Meta m) _) | M.null m -> Nothing @@ -73,14 +73,14 @@ testCompareWithOpts opts name docxFile nativeFile = testCompare :: String -> FilePath -> FilePath -> TestTree testCompare = testCompareWithOpts defopts -testForWarningsWithOptsIO :: ReaderOptions -> String -> FilePath -> [String] -> IO TestTree +testForWarningsWithOptsIO :: ReaderOptions -> String -> FilePath -> [Text] -> IO TestTree 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 (T.unlines warns, unlines expected) + return $ test id name (T.unlines warns, T.unlines expected) -testForWarningsWithOpts :: ReaderOptions -> String -> FilePath -> [String] -> TestTree +testForWarningsWithOpts :: ReaderOptions -> String -> FilePath -> [Text] -> TestTree testForWarningsWithOpts opts name docxFile expected = unsafePerformIO $ testForWarningsWithOptsIO opts name docxFile expected @@ -96,10 +96,10 @@ compareMediaPathIO mediaPath mediaBag docxPath = do docxMedia <- getMedia docxPath mediaPath let mbBS = case lookupMedia mediaPath mediaBag of Just (_, bs) -> bs - Nothing -> error ("couldn't find " ++ + Nothing -> error $ T.pack ("couldn't find " ++ mediaPath ++ " in media bag") - docxBS = fromMaybe (error ("couldn't find " ++ + docxBS = fromMaybe (error $ T.pack ("couldn't find " ++ mediaPath ++ " in media bag")) docxMedia return $ mbBS == docxBS diff --git a/test/Tests/Readers/DokuWiki.hs b/test/Tests/Readers/DokuWiki.hs index 84ba86d46..fa344b910 100644 --- a/test/Tests/Readers/DokuWiki.hs +++ b/test/Tests/Readers/DokuWiki.hs @@ -19,13 +19,13 @@ import Test.Tasty import Tests.Helpers import Text.Pandoc import Text.Pandoc.Arbitrary () -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B dokuwiki :: Text -> Pandoc dokuwiki = purely $ readDokuWiki def{ readerStandalone = True } infix 4 =: -(=:) :: ToString c +(=:) :: ToText c => String -> (Text, c) -> TestTree (=:) = test dokuwiki diff --git a/test/Tests/Readers/FB2.hs b/test/Tests/Readers/FB2.hs index 42054a235..ac7db9be1 100644 --- a/test/Tests/Readers/FB2.hs +++ b/test/Tests/Readers/FB2.hs @@ -16,7 +16,7 @@ import Tests.Helpers import Test.Tasty.Golden (goldenVsString) import qualified Data.ByteString as BS import Text.Pandoc -import Text.Pandoc.UTF8 (toText, fromStringLazy) +import Text.Pandoc.UTF8 as UTF8 import Data.Text (Text, unpack) import System.FilePath (replaceExtension) @@ -25,7 +25,7 @@ fb2ToNative = purely (writeNative def{ writerTemplate = Just mempty }) . purely fb2Test :: TestName -> FilePath -> TestTree fb2Test name path = goldenVsString name native - (fromStringLazy . filter (/='\r') . unpack . fb2ToNative . toText + (UTF8.fromStringLazy . filter (/='\r') . unpack . fb2ToNative . UTF8.toText <$> BS.readFile path) where native = replaceExtension path ".native" diff --git a/test/Tests/Readers/HTML.hs b/test/Tests/Readers/HTML.hs index f23af2cb1..6a8a10cef 100644 --- a/test/Tests/Readers/HTML.hs +++ b/test/Tests/Readers/HTML.hs @@ -21,7 +21,7 @@ import Tests.Helpers import Text.Pandoc import Text.Pandoc.Shared (isHeaderBlock) import Text.Pandoc.Arbitrary () -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B import Text.Pandoc.Walk (walk) html :: Text -> Pandoc @@ -47,7 +47,7 @@ removeRawInlines x = x roundTrip :: Blocks -> Bool roundTrip b = d'' == d''' where d = walk removeRawInlines $ - walk makeRoundTrip $ Pandoc nullMeta $ toList b + walk makeRoundTrip $ Pandoc nullMeta $ B.toList b d' = rewrite d d'' = rewrite d' d''' = rewrite d'' diff --git a/test/Tests/Readers/Jira.hs b/test/Tests/Readers/Jira.hs index cb7dde4ea..2881a83e5 100644 --- a/test/Tests/Readers/Jira.hs +++ b/test/Tests/Readers/Jira.hs @@ -25,7 +25,7 @@ jira :: Text -> Pandoc jira = purely $ readJira def infix 4 =: -(=:) :: ToString c +(=:) :: ToText c => String -> (Text, c) -> TestTree (=:) = test jira diff --git a/test/Tests/Readers/LaTeX.hs b/test/Tests/Readers/LaTeX.hs index 4bda15140..a631e55af 100644 --- a/test/Tests/Readers/LaTeX.hs +++ b/test/Tests/Readers/LaTeX.hs @@ -18,14 +18,14 @@ import Test.Tasty import Tests.Helpers import Text.Pandoc import Text.Pandoc.Arbitrary () -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B latex :: Text -> Pandoc latex = purely $ readLaTeX def{ readerExtensions = getDefaultExtensions "latex" } infix 4 =: -(=:) :: ToString c +(=:) :: ToText c => String -> (Text, c) -> TestTree (=:) = test latex @@ -338,10 +338,10 @@ natbibCitations = testGroup "natbib" =?> para (cite [baseCitation] (rt "\\citet{item1}")) , "suffix" =: "\\citet[p.~30]{item1}" =?> para - (cite [baseCitation{ citationSuffix = toList $ text "p.\160\&30" }] (rt "\\citet[p.~30]{item1}")) + (cite [baseCitation{ citationSuffix = B.toList $ text "p.\160\&30" }] (rt "\\citet[p.~30]{item1}")) , "suffix long" =: "\\citet[p.~30, with suffix]{item1}" =?> para (cite [baseCitation{ citationSuffix = - toList $ text "p.\160\&30, with suffix" }] (rt "\\citet[p.~30, with suffix]{item1}")) + B.toList $ text "p.\160\&30, with suffix" }] (rt "\\citet[p.~30, with suffix]{item1}")) , "multiple" =: "\\citeauthor{item1} \\citetext{\\citeyear{item1}; \\citeyear[p.~30]{item2}; \\citealp[see also][]{item3}}" =?> para (cite [baseCitation{ citationMode = AuthorInText } ,baseCitation{ citationMode = SuppressAuthor @@ -365,7 +365,7 @@ natbibCitations = testGroup "natbib" , citationSuffix = [Str "pp.\160\&33,",Space,Str "35\8211\&37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] (rt "\\citep[pp.~33, 35--37, and nowhere else]{item1}")) , "suffix only" =: "\\citep[and nowhere else]{item1}" =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationSuffix = toList $ text "and nowhere else" }] (rt "\\citep[and nowhere else]{item1}")) + , citationSuffix = B.toList $ text "and nowhere else" }] (rt "\\citep[and nowhere else]{item1}")) , "no author" =: "\\citeyearpar{item1}, and now Doe with a locator \\citeyearpar[p.~44]{item2}" =?> para (cite [baseCitation{ citationMode = SuppressAuthor }] (rt "\\citeyearpar{item1}") <> text ", and now Doe with a locator " <> @@ -385,10 +385,10 @@ biblatexCitations = testGroup "biblatex" =?> para (cite [baseCitation] (rt "\\textcite{item1}")) , "suffix" =: "\\textcite[p.~30]{item1}" =?> para - (cite [baseCitation{ citationSuffix = toList $ text "p.\160\&30" }] (rt "\\textcite[p.~30]{item1}")) + (cite [baseCitation{ citationSuffix = B.toList $ text "p.\160\&30" }] (rt "\\textcite[p.~30]{item1}")) , "suffix long" =: "\\textcite[p.~30, with suffix]{item1}" =?> para (cite [baseCitation{ citationSuffix = - toList $ text "p.\160\&30, with suffix" }] (rt "\\textcite[p.~30, with suffix]{item1}")) + B.toList $ text "p.\160\&30, with suffix" }] (rt "\\textcite[p.~30, with suffix]{item1}")) , "multiple" =: "\\textcites{item1}[p.~30]{item2}[see also][]{item3}" =?> para (cite [baseCitation{ citationMode = AuthorInText } ,baseCitation{ citationMode = NormalCitation @@ -412,7 +412,7 @@ biblatexCitations = testGroup "biblatex" , citationSuffix = [Str "pp.\160\&33,",Space,Str "35\8211\&37,",Space,Str "and",Space,Str "nowhere",Space, Str "else"] }] (rt "\\autocite[pp.~33, 35--37, and nowhere else]{item1}")) , "suffix only" =: "\\autocite[and nowhere else]{item1}" =?> para (cite [baseCitation{ citationMode = NormalCitation - , citationSuffix = toList $ text "and nowhere else" }] (rt "\\autocite[and nowhere else]{item1}")) + , citationSuffix = B.toList $ text "and nowhere else" }] (rt "\\autocite[and nowhere else]{item1}")) , "no author" =: "\\autocite*{item1}, and now Doe with a locator \\autocite*[p.~44]{item2}" =?> para (cite [baseCitation{ citationMode = SuppressAuthor }] (rt "\\autocite*{item1}") <> text ", and now Doe with a locator " <> diff --git a/test/Tests/Readers/Man.hs b/test/Tests/Readers/Man.hs index d36151d58..ff1f14a29 100644 --- a/test/Tests/Readers/Man.hs +++ b/test/Tests/Readers/Man.hs @@ -18,14 +18,14 @@ import Test.Tasty import Tests.Helpers import Text.Pandoc import Text.Pandoc.Arbitrary () -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B import Text.Pandoc.Readers.Man man :: Text -> Pandoc man = purely $ readMan def infix 4 =: -(=:) :: ToString c +(=:) :: ToText c => String -> (Text, c) -> TestTree (=:) = test man diff --git a/test/Tests/Readers/Markdown.hs b/test/Tests/Readers/Markdown.hs index 0930deae6..8e6700639 100644 --- a/test/Tests/Readers/Markdown.hs +++ b/test/Tests/Readers/Markdown.hs @@ -19,6 +19,7 @@ import Tests.Helpers import Text.Pandoc import Text.Pandoc.Arbitrary () import Text.Pandoc.Builder +import qualified Relude.Unsafe as Unsafe markdown :: Text -> Pandoc markdown = purely $ readMarkdown def { readerExtensions = @@ -37,7 +38,7 @@ markdownGH = purely $ readMarkdown def { readerExtensions = githubMarkdownExtensions } infix 4 =: -(=:) :: ToString c +(=:) :: ToText c => String -> (Text, c) -> TestTree (=:) = test markdown @@ -205,15 +206,15 @@ tests = [ testGroup "inline code" ] <> [ "lists with newlines and indent in backticks" =: T.intercalate ("\n" <> T.replicate 4 " ") (zipWith (\i (_, lt, _) -> lt <> i) lis lsts) - =?> let (_, _, f) = head lsts - in f [plain $ code $ T.intercalate (T.replicate 5 " ") $ head lis' : zipWith (\i (_, lt, _) -> lt <> i) (tail lis') (tail lsts)] + =?> let (_, _, f) = Unsafe.head lsts + in f [plain $ code $ T.intercalate (T.replicate 5 " ") $ Unsafe.head lis' : zipWith (\i (_, lt, _) -> lt <> i) (Unsafe.tail lis') (Unsafe.tail lsts)] | lsts <- [ [i, j, k] | i <- lists, j <- lists, k <- lists] ] <> [ "lists with blank lines and indent in backticks" =: T.intercalate ("\n\n" <> T.replicate 4 " ") (zipWith (\i (_, lt, _) -> lt <> i) lis lsts) <> "\n" - =?> let (_, _, f) = head lsts - in f . pure $ (para . text $ head lis) <> bldLsts para (tail lsts) (tail lis) + =?> let (_, _, f) = Unsafe.head lsts + in f . pure $ (para . text $ Unsafe.head lis) <> bldLsts para (Unsafe.tail lsts) (Unsafe.tail lis) | lsts <- [ [i, j, k] | i <- lists, j <- lists, k <- lists] ] , testGroup "emph and strong" diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index 68bdc87b4..6304a0dd8 100644 --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -22,7 +22,7 @@ import Test.Tasty.Options (IsOption(defaultValue)) import Tests.Helpers import Text.Pandoc import Text.Pandoc.Arbitrary () -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B import Text.Pandoc.Writers.Shared (toLegacyTable) import Text.Pandoc.Walk @@ -33,7 +33,7 @@ emacsMuse :: Text -> Pandoc emacsMuse = purely $ readMuse def { readerExtensions = emptyExtensions } infix 4 =: -(=:) :: ToString c +(=:) :: ToText c => String -> (Text, c) -> TestTree (=:) = test amuse @@ -59,7 +59,8 @@ makeRoundTrip t@(Table tattr blkCapt specs thead tbody tfoot) = then t else Para [Str "table was here"] where (_, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot - numcols = maximum (length aligns : length widths : map length (headers:rows)) + numcols = maximum1 + (length aligns :| length widths : map length (headers:rows)) isLineBreak LineBreak = Any True isLineBreak _ = Any False hasLineBreak = getAny . query isLineBreak @@ -107,7 +108,7 @@ makeRoundTrip x = x -- Currently we remove tables and compare first rewrite to the second. roundTrip :: Blocks -> Bool roundTrip b = d' == d'' - where d = walk makeRoundTrip $ Pandoc nullMeta $ toList b + where d = walk makeRoundTrip $ Pandoc nullMeta $ B.toList b d' = rewrite d d'' = rewrite d' rewrite = amuse . T.pack . (++ "\n") . T.unpack . @@ -801,7 +802,7 @@ tests = , testGroup "Directives" [ "Title" =: "#title Document title" =?> - let titleInline = toList "Document title" + let titleInline = B.toList "Document title" meta = setMeta "title" (MetaInlines titleInline) nullMeta in Pandoc meta mempty -- Emacs Muse documentation says that "You can use any combination @@ -809,25 +810,25 @@ tests = -- but also allows '-', which is not documented, but used for disable-tables. , test emacsMuse "Disable tables" ("#disable-tables t" =?> - Pandoc (setMeta "disable-tables" (MetaInlines $ toList "t") nullMeta) mempty) + Pandoc (setMeta "disable-tables" (MetaInlines $ B.toList "t") nullMeta) mempty) , "Multiple directives" =: T.unlines [ "#title Document title" , "#subtitle Document subtitle" ] =?> - Pandoc (setMeta "title" (MetaInlines $ toList "Document title") $ - setMeta "subtitle" (MetaInlines $ toList "Document subtitle") nullMeta) mempty + Pandoc (setMeta "title" (MetaInlines $ B.toList "Document title") $ + setMeta "subtitle" (MetaInlines $ B.toList "Document subtitle") nullMeta) mempty , "Multiline directive" =: T.unlines [ "#title Document title" , "#notes First line" , "and second line" , "#author Name" ] =?> - Pandoc (setMeta "title" (MetaInlines $ toList "Document title") $ - setMeta "notes" (MetaInlines $ toList "First line\nand second line") $ - setMeta "author" (MetaInlines $ toList "Name") nullMeta) mempty + Pandoc (setMeta "title" (MetaInlines $ B.toList "Document title") $ + setMeta "notes" (MetaInlines $ B.toList "First line\nand second line") $ + setMeta "author" (MetaInlines $ B.toList "Name") nullMeta) mempty , "Amusewiki's #cover is translated to pandoc's #cover-image" =: "#cover cover.png" =?> - let titleInline = toList "cover.png" + let titleInline = B.toList "cover.png" meta = setMeta "cover-image" (MetaInlines titleInline) nullMeta in Pandoc meta mempty ] diff --git a/test/Tests/Readers/Odt.hs b/test/Tests/Readers/Odt.hs index 9b5ec6b9e..f1155d23e 100644 --- a/test/Tests/Readers/Odt.hs +++ b/test/Tests/Readers/Odt.hs @@ -17,7 +17,7 @@ import Control.Monad (liftM) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as B import qualified Data.Map as M -import Data.Text (unpack) +import qualified Data.Text as T import System.IO.Unsafe (unsafePerformIO) import Test.Tasty import Tests.Helpers @@ -54,9 +54,8 @@ testsComparingToNative = map nameToTest namesOfTestsComparingToNative newtype NoNormPandoc = NoNormPandoc {unNoNorm :: Pandoc} deriving ( Show ) -instance ToString NoNormPandoc where - toString d = unpack $ - purely (writeNative def{ writerTemplate = s }) $ toPandoc d +instance ToText NoNormPandoc where + toText d = purely (writeNative def{ writerTemplate = s }) $ toPandoc d where s = case d of NoNormPandoc (Pandoc (Meta m) _) | M.null m -> Nothing @@ -66,7 +65,8 @@ instance ToPandoc NoNormPandoc where toPandoc = unNoNorm getNoNormVia :: (a -> Pandoc) -> String -> Either PandocError a -> NoNormPandoc -getNoNormVia _ readerName (Left _) = error (readerName ++ " reader failed") +getNoNormVia _ readerName (Left _) = + error $ T.pack (readerName ++ " reader failed") getNoNormVia f _ (Right a) = NoNormPandoc (f a) type TestCreator = ReaderOptions diff --git a/test/Tests/Readers/Org/Directive.hs b/test/Tests/Readers/Org/Directive.hs index 85d1bc088..c2409ce80 100644 --- a/test/Tests/Readers/Org/Directive.hs +++ b/test/Tests/Readers/Org/Directive.hs @@ -15,14 +15,14 @@ module Tests.Readers.Org.Directive (tests) where import Data.Time (UTCTime (UTCTime), secondsToDiffTime) import Data.Time.Calendar (Day (ModifiedJulianDay)) import Test.Tasty (TestTree, testGroup) -import Tests.Helpers ((=?>), ToString, purely, test) +import Tests.Helpers ((=?>), ToString, ToText, purely, test) import Tests.Readers.Org.Shared ((=:), tagSpan) import Text.Pandoc import Text.Pandoc.Builder import qualified Data.ByteString as BS import qualified Data.Text as T -testWithFiles :: (ToString c) +testWithFiles :: (ToText c) => [(FilePath, BS.ByteString)] -> String -- ^ name of test case -> (T.Text, c) -- ^ (input, expected value) diff --git a/test/Tests/Readers/Org/Inline/Citation.hs b/test/Tests/Readers/Org/Inline/Citation.hs index a11804983..fa1560772 100644 --- a/test/Tests/Readers/Org/Inline/Citation.hs +++ b/test/Tests/Readers/Org/Inline/Citation.hs @@ -15,7 +15,7 @@ module Tests.Readers.Org.Inline.Citation (tests) where import Test.Tasty (TestTree, testGroup) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:)) -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B tests :: [TestTree] tests = @@ -160,8 +160,8 @@ tests = "[[citep:Dominik201408][See page 20::, for example]]" =?> let citation = Citation { citationId = "Dominik201408" - , citationPrefix = toList "See page 20" - , citationSuffix = toList ", for example" + , citationPrefix = B.toList "See page 20" + , citationSuffix = B.toList ", for example" , citationMode = NormalCitation , citationNoteNum = 0 , citationHash = 0 @@ -198,17 +198,17 @@ tests = , "Berkeley-style parenthetical citation list" =: "[(cite): see; @Dominik201408;also @Pandoc; and others]" =?> let pandocCite' = pandocCite { - citationPrefix = toList "also" - , citationSuffix = toList "and others" + citationPrefix = B.toList "also" + , citationSuffix = B.toList "and others" } dominikCite' = dominikCite { - citationPrefix = toList "see" + citationPrefix = B.toList "see" } in (para $ cite [dominikCite', pandocCite'] "") , "Berkeley-style plain citation list" =: "[cite: See; @Dominik201408; and @Pandoc; and others]" =?> - let pandocCite' = pandocInText { citationPrefix = toList "and" } + let pandocCite' = pandocInText { citationPrefix = B.toList "and" } in (para $ "See " <> cite [dominikInText] "" <> "," <> space diff --git a/test/Tests/Readers/Org/Meta.hs b/test/Tests/Readers/Org/Meta.hs index 6363d84b0..f38ee7194 100644 --- a/test/Tests/Readers/Org/Meta.hs +++ b/test/Tests/Readers/Org/Meta.hs @@ -16,7 +16,7 @@ import Test.Tasty (TestTree, testGroup) import Tests.Helpers ((=?>)) import Tests.Readers.Org.Shared ((=:), spcSep) import Text.Pandoc -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B import qualified Data.Text as T tests :: [TestTree] @@ -43,14 +43,14 @@ tests = , testGroup "Export settings" [ "Title" =: "#+title: Hello, World" =?> - let titleInline = toList $ "Hello," <> space <> "World" + let titleInline = B.toList $ "Hello," <> space <> "World" meta = setMeta "title" (MetaInlines titleInline) nullMeta in Pandoc meta mempty , testGroup "Author" [ "sets 'author' field" =: "#+author: John /Emacs-Fanboy/ Doe" =?> - let author = toList . spcSep $ [ "John", emph "Emacs-Fanboy", "Doe" ] + let author = B.toList . spcSep $ [ "John", emph "Emacs-Fanboy", "Doe" ] meta = setMeta "author" (MetaInlines author) nullMeta in Pandoc meta mempty @@ -58,8 +58,8 @@ tests = T.unlines [ "#+author: James Dewey Watson," , "#+author: Francis Harry Compton Crick" ] =?> - let watson = toList "James Dewey Watson," - crick = toList "Francis Harry Compton Crick" + let watson = B.toList "James Dewey Watson," + crick = B.toList "Francis Harry Compton Crick" meta = setMeta "author" (MetaInlines (watson ++ SoftBreak : crick)) nullMeta @@ -68,7 +68,7 @@ tests = , "Date" =: "#+date: Feb. *28*, 2014" =?> - let date = toList . spcSep $ [ "Feb.", strong "28" <> ",", "2014" ] + let date = B.toList . spcSep $ [ "Feb.", strong "28" <> ",", "2014" ] meta = setMeta "date" (MetaInlines date) nullMeta in Pandoc meta mempty @@ -102,7 +102,7 @@ tests = T.unlines [ "#+keywords: pandoc, testing," , "#+keywords: Org" ] =?> - let keywords = toList $ "pandoc, testing," <> softbreak <> "Org" + let keywords = B.toList $ "pandoc, testing," <> softbreak <> "Org" meta = setMeta "keywords" (MetaInlines keywords) nullMeta in Pandoc meta mempty @@ -128,7 +128,7 @@ tests = [ "LATEX_HEADER" =: "#+latex_header: \\usepackage{tikz}" =?> let latexInlines = rawInline "latex" "\\usepackage{tikz}" - inclList = MetaList [MetaInlines (toList latexInlines)] + inclList = MetaList [MetaInlines (B.toList latexInlines)] meta = setMeta "header-includes" inclList nullMeta in Pandoc meta mempty @@ -162,7 +162,7 @@ tests = [ "HTML_HEAD values are added to header-includes" =: "#+html_head: <meta/>" =?> let html = rawInline "html" "<meta/>" - inclList = MetaList [MetaInlines (toList html)] + inclList = MetaList [MetaInlines (B.toList html)] meta = setMeta "header-includes" inclList nullMeta in Pandoc meta mempty diff --git a/test/Tests/Readers/Org/Shared.hs b/test/Tests/Readers/Org/Shared.hs index c584eff19..a1baaf75e 100644 --- a/test/Tests/Readers/Org/Shared.hs +++ b/test/Tests/Readers/Org/Shared.hs @@ -29,7 +29,7 @@ org :: Text -> Pandoc org = purely $ readOrg def{ readerExtensions = getDefaultExtensions "org" } infix 4 =: -(=:) :: ToString c +(=:) :: ToText c => String -> (Text, c) -> TestTree (=:) = test org diff --git a/test/Tests/Readers/RST.hs b/test/Tests/Readers/RST.hs index a12b59fc2..95e64c489 100644 --- a/test/Tests/Readers/RST.hs +++ b/test/Tests/Readers/RST.hs @@ -25,7 +25,7 @@ rst :: Text -> Pandoc rst = purely $ readRST def{ readerStandalone = True } infix 4 =: -(=:) :: ToString c +(=:) :: ToText c => String -> (Text, c) -> TestTree (=:) = test rst diff --git a/test/Tests/Readers/Txt2Tags.hs b/test/Tests/Readers/Txt2Tags.hs index 013f29d68..eb96b20ee 100644 --- a/test/Tests/Readers/Txt2Tags.hs +++ b/test/Tests/Readers/Txt2Tags.hs @@ -30,7 +30,7 @@ t2t = purely $ \s -> do readTxt2Tags def s infix 4 =: -(=:) :: ToString c +(=:) :: ToText c => String -> (Text, c) -> TestTree (=:) = test t2t diff --git a/test/Tests/Shared.hs b/test/Tests/Shared.hs index e415ea153..287c3a61b 100644 --- a/test/Tests/Shared.hs +++ b/test/Tests/Shared.hs @@ -16,7 +16,7 @@ import System.FilePath.Posix (joinPath) import Test.Tasty import Test.Tasty.HUnit (assertBool, testCase, (@?=)) import Text.Pandoc.Arbitrary () -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared (toLegacyTable) @@ -58,7 +58,7 @@ testLegacyTable = , testCase "decomposes a table without head" $ gen2 @?= expect2 ] where - pln = toList . plain . str + pln = B.toList . plain . str cl a h w = Cell ("", [], []) AlignDefault h w $ pln a rws = map $ Row nullAttr th = TableHead nullAttr . rws diff --git a/test/Tests/Writers/AnnotatedTable.hs b/test/Tests/Writers/AnnotatedTable.hs index 53cca80a6..8e8ce9d3e 100644 --- a/test/Tests/Writers/AnnotatedTable.hs +++ b/test/Tests/Writers/AnnotatedTable.hs @@ -35,7 +35,7 @@ import Test.Tasty.QuickCheck ( QuickCheckTests(..) , elements ) import Text.Pandoc.Arbitrary ( ) -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B import qualified Text.Pandoc.Writers.AnnotatedTable as Ann @@ -150,7 +150,7 @@ propBuilderAnnTable th tbs tf = withColSpec $ \cs -> convertTable (table emptyCaption cs th tbs tf) === convertAnnTable (Ann.toTable nullAttr emptyCaption cs th tbs tf) where - convertTable blks = case toList blks of + convertTable blks = case B.toList blks of [Table _ _ colspec a b c] -> Right (colspec, a, b, c) x -> Left x convertAnnTable x = case Ann.fromTable x of diff --git a/test/Tests/Writers/AsciiDoc.hs b/test/Tests/Writers/AsciiDoc.hs index 04655635f..6ab2bdb0d 100644 --- a/test/Tests/Writers/AsciiDoc.hs +++ b/test/Tests/Writers/AsciiDoc.hs @@ -11,9 +11,9 @@ import Text.Pandoc.Builder asciidoc :: (ToPandoc a) => a -> String asciidoc = unpack . purely (writeAsciiDoc def{ writerWrapText = WrapNone }) . toPandoc -testAsciidoc :: (ToString a, ToPandoc a) +testAsciidoc :: (ToText a, ToPandoc a) => String - -> (a, String) + -> (a, Text) -> TestTree testAsciidoc = test asciidoc diff --git a/test/Tests/Writers/ConTeXt.hs b/test/Tests/Writers/ConTeXt.hs index 5c1c98d4e..6aea41c85 100644 --- a/test/Tests/Writers/ConTeXt.hs +++ b/test/Tests/Writers/ConTeXt.hs @@ -34,8 +34,8 @@ which is in turn shorthand for -} infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree +(=:) :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree (=:) = test context tests :: [TestTree] diff --git a/test/Tests/Writers/Docbook.hs b/test/Tests/Writers/Docbook.hs index 842aed7ae..657461366 100644 --- a/test/Tests/Writers/Docbook.hs +++ b/test/Tests/Writers/Docbook.hs @@ -8,11 +8,11 @@ import Text.Pandoc import Text.Pandoc.Arbitrary () import Text.Pandoc.Builder -docbook :: (ToPandoc a) => a -> String +docbook :: (ToPandoc a) => a -> Text docbook = docbookWithOpts def{ writerWrapText = WrapNone } -docbookWithOpts :: ToPandoc a => WriterOptions -> a -> String -docbookWithOpts opts = unpack . purely (writeDocbook4 opts) . toPandoc +docbookWithOpts :: ToPandoc a => WriterOptions -> a -> Text +docbookWithOpts opts = purely (writeDocbook4 opts) . toPandoc {- "my test" =: X =?> Y @@ -27,15 +27,16 @@ which is in turn shorthand for -} infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree +(=:) :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree (=:) = test docbook lineblock :: Blocks lineblock = para ("some text" <> linebreak <> "and more lines" <> linebreak <> "and again") -lineblock_out :: [String] + +lineblock_out :: [Text] lineblock_out = [ "<literallayout>some text" , "and more lines" , "and again</literallayout>" @@ -304,7 +305,7 @@ tests = [ testGroup "line blocks" <> header 3 (text "header3") docbookTopLevelDiv :: (ToPandoc a) - => TopLevelDivision -> a -> String + => TopLevelDivision -> a -> Text docbookTopLevelDiv division = docbookWithOpts def{ writerTopLevelDivision = division } in diff --git a/test/Tests/Writers/FB2.hs b/test/Tests/Writers/FB2.hs index 2e10636fa..e4ff4d5cc 100644 --- a/test/Tests/Writers/FB2.hs +++ b/test/Tests/Writers/FB2.hs @@ -7,13 +7,13 @@ import Text.Pandoc import Text.Pandoc.Arbitrary () import Text.Pandoc.Builder -fb2 :: String -> String -fb2 x = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++ - "<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\" xmlns:l=\"http://www.w3.org/1999/xlink\"><description><title-info><genre>unrecognised</genre></title-info><document-info><program-used>pandoc</program-used></document-info></description><body><title><p /></title><section>" ++ x ++ "</section></body></FictionBook>" +fb2 :: Text -> Text +fb2 x = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" <> + "<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\" xmlns:l=\"http://www.w3.org/1999/xlink\"><description><title-info><genre>unrecognised</genre></title-info><document-info><program-used>pandoc</program-used></document-info></description><body><title><p /></title><section>" <> x <> "</section></body></FictionBook>" infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree +(=:) :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree (=:) = test (purely (writeFB2 def) . toPandoc) tests :: [TestTree] diff --git a/test/Tests/Writers/HTML.hs b/test/Tests/Writers/HTML.hs index 328801e31..5d59fd79b 100644 --- a/test/Tests/Writers/HTML.hs +++ b/test/Tests/Writers/HTML.hs @@ -29,8 +29,8 @@ which is in turn shorthand for -} infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree +(=:) :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree (=:) = test html tests :: [TestTree] @@ -72,17 +72,17 @@ tests = [ testGroup "inline code" , testGroup "sample with style" [ "samp should wrap highlighted code" =: codeWith ("",["sample","haskell"],[]) ">>=" - =?> ("<samp><code class=\"sourceCode haskell\">" ++ + =?> ("<samp><code class=\"sourceCode haskell\">" <> "<span class=\"op\">>>=</span></code></samp>") ] , testGroup "variable with style" [ "var should wrap highlighted code" =: codeWith ("",["haskell","variable"],[]) ">>=" - =?> ("<var><code class=\"sourceCode haskell\">" ++ + =?> ("<var><code class=\"sourceCode haskell\">" <> "<span class=\"op\">>>=</span></code></var>") ] ] where - tQ :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree + tQ :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree tQ = test htmlQTags diff --git a/test/Tests/Writers/JATS.hs b/test/Tests/Writers/JATS.hs index 2f501c890..55a277c6a 100644 --- a/test/Tests/Writers/JATS.hs +++ b/test/Tests/Writers/JATS.hs @@ -31,8 +31,8 @@ which is in turn shorthand for -} infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree +(=:) :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree (=:) = test jats tests :: [TestTree] diff --git a/test/Tests/Writers/Jira.hs b/test/Tests/Writers/Jira.hs index 0c6f48853..58abf8bc8 100644 --- a/test/Tests/Writers/Jira.hs +++ b/test/Tests/Writers/Jira.hs @@ -13,7 +13,7 @@ jira :: (ToPandoc a) => a -> String jira = unpack . purely (writeJira def) . toPandoc infix 4 =: -(=:) :: (ToString a, ToPandoc a, HasCallStack) +(=:) :: (ToText a, ToPandoc a, HasCallStack) => String -> (a, String) -> TestTree (=:) = test jira diff --git a/test/Tests/Writers/LaTeX.hs b/test/Tests/Writers/LaTeX.hs index ae5879099..1ce62487e 100644 --- a/test/Tests/Writers/LaTeX.hs +++ b/test/Tests/Writers/LaTeX.hs @@ -33,8 +33,8 @@ which is in turn shorthand for -} infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree +(=:) :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree (=:) = test latex tests :: [TestTree] diff --git a/test/Tests/Writers/Markdown.hs b/test/Tests/Writers/Markdown.hs index d4f927ebe..aea920b9d 100644 --- a/test/Tests/Writers/Markdown.hs +++ b/test/Tests/Writers/Markdown.hs @@ -14,11 +14,11 @@ defopts = def { writerExtensions = pandocExtensions , writerSetextHeaders = True } -markdown :: (ToPandoc a) => a -> String -markdown = unpack . purely (writeMarkdown defopts) . toPandoc +markdown :: (ToPandoc a) => a -> Text +markdown = purely (writeMarkdown defopts) . toPandoc -markdownWithOpts :: (ToPandoc a) => WriterOptions -> a -> String -markdownWithOpts opts x = unpack . purely (writeMarkdown opts) $ toPandoc x +markdownWithOpts :: (ToPandoc a) => WriterOptions -> a -> Text +markdownWithOpts opts x = purely (writeMarkdown opts) $ toPandoc x {- "my test" =: X =?> Y @@ -33,8 +33,8 @@ which is in turn shorthand for -} infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree +(=:) :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree (=:) = test markdown tests :: [TestTree] @@ -182,9 +182,9 @@ noteTests = testGroup "note and reference location" shortcutLinkRefsTests :: TestTree shortcutLinkRefsTests = let infix 4 =: - (=:) :: (ToString a, ToPandoc a) + (=:) :: (ToText a, ToPandoc a) - => String -> (a, String) -> TestTree + => String -> (a, Text) -> TestTree (=:) = test (purely (writeMarkdown defopts{writerReferenceLinks = True}) . toPandoc) in testGroup "Shortcut reference links" [ "Simple link (shortcutable)" diff --git a/test/Tests/Writers/Ms.hs b/test/Tests/Writers/Ms.hs index ad6849633..ce8c712ac 100644 --- a/test/Tests/Writers/Ms.hs +++ b/test/Tests/Writers/Ms.hs @@ -7,8 +7,8 @@ import Text.Pandoc import Text.Pandoc.Builder infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree +(=:) :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree (=:) = test (purely (writeMs def . toPandoc)) tests :: [TestTree] diff --git a/test/Tests/Writers/Muse.hs b/test/Tests/Writers/Muse.hs index 5bddca3af..c76574682 100644 --- a/test/Tests/Writers/Muse.hs +++ b/test/Tests/Writers/Muse.hs @@ -7,7 +7,7 @@ import Test.Tasty import Tests.Helpers import Text.Pandoc import Text.Pandoc.Arbitrary () -import Text.Pandoc.Builder +import Text.Pandoc.Builder as B defopts :: WriterOptions defopts = def{ writerWrapText = WrapPreserve, @@ -21,7 +21,7 @@ museWithOpts :: (ToPandoc a) => WriterOptions -> a -> Text museWithOpts opts = purely (writeMuse opts) . toPandoc infix 4 =: -(=:) :: (ToString a, ToPandoc a) +(=:) :: (ToText a, ToPandoc a) => String -> (a, Text) -> TestTree (=:) = test muse @@ -446,7 +446,7 @@ tests = [ testGroup "block elements" , "escape hash to avoid accidental anchors" =: text "#foo bar" =?> "<verbatim>#foo</verbatim> bar" , "escape definition list markers" =: str "::" =?> "<verbatim>::</verbatim>" - , "normalize strings before escaping" =: fromList [Str ":", Str ":"] =?> "<verbatim>::</verbatim>" + , "normalize strings before escaping" =: B.fromList [Str ":", Str ":"] =?> "<verbatim>::</verbatim>" -- We don't want colons to be escaped if they can't be confused -- with definition list item markers. , "do not escape colon" =: str ":" =?> ":" diff --git a/test/Tests/Writers/Native.hs b/test/Tests/Writers/Native.hs index d7771ca19..b1a8882f1 100644 --- a/test/Tests/Writers/Native.hs +++ b/test/Tests/Writers/Native.hs @@ -6,14 +6,15 @@ import Test.Tasty.QuickCheck import Tests.Helpers import Text.Pandoc import Text.Pandoc.Arbitrary () +import Text.Pandoc.Shared (safeRead) p_write_rt :: Pandoc -> Bool p_write_rt d = - read (unpack $ purely (writeNative def{ writerTemplate = Just mempty }) d) == d + safeRead (purely (writeNative def{ writerTemplate = Just mempty }) d) == Just d p_write_blocks_rt :: [Block] -> Bool p_write_blocks_rt bs = - read (unpack $ purely (writeNative def) (Pandoc nullMeta bs)) == bs + safeRead (purely (writeNative def) (Pandoc nullMeta bs)) == Just bs tests :: [TestTree] tests = [ testProperty "p_write_rt" p_write_rt diff --git a/test/Tests/Writers/OOXML.hs b/test/Tests/Writers/OOXML.hs index c1e47622d..ac74a9652 100644 --- a/test/Tests/Writers/OOXML.hs +++ b/test/Tests/Writers/OOXML.hs @@ -16,6 +16,7 @@ import Data.Maybe (catMaybes, mapMaybe) import Tests.Helpers import Data.Algorithm.Diff import System.FilePath.Glob (compile, match) +import qualified Data.Text as T compareXMLBool :: Content -> Content -> Bool -- We make a special exception for times at the moment, and just pass @@ -41,10 +42,11 @@ compareXMLBool (CRef myStr) (CRef goodStr) = myStr == goodStr compareXMLBool _ _ = False -displayDiff :: Content -> Content -> String +displayDiff :: Content -> Content -> Text displayDiff elemA elemB = - showDiff (1,1) - (getDiff (lines $ showContent elemA) (lines $ showContent elemB)) + T.pack $ showDiff (1,1) + (getDiff (lines $ T.pack $ showContent elemA) + (lines $ T.pack $ showContent elemB)) goldenArchive :: FilePath -> IO Archive goldenArchive fp = toArchive . BL.fromStrict <$> BS.readFile fp @@ -58,7 +60,7 @@ testArchive writerFn opts fp = do bs <- runIOorExplode $ readNative def txt >>= writerFn opts return $ toArchive bs -compareFileList :: FilePath -> Archive -> Archive -> Maybe String +compareFileList :: FilePath -> Archive -> Archive -> Maybe Text compareFileList goldenFP goldenArch testArch = let testFiles = filesInArchive testArch goldenFiles = filesInArchive goldenArch @@ -69,54 +71,58 @@ compareFileList goldenFP goldenArch testArch = [ if null diffGoldenTest then Nothing else Just $ - "Files in " ++ goldenFP ++ " but not in generated archive:\n" ++ - intercalate ", " diffGoldenTest + "Files in " <> T.pack goldenFP <> + " but not in generated archive:\n" <> + T.pack (intercalate ", " diffGoldenTest) , if null diffTestGolden then Nothing else Just $ - "Files in generated archive but not in " ++ goldenFP ++ ":\n" ++ - intercalate ", " diffTestGolden + "Files in generated archive but not in " <> T.pack goldenFP <> + ":\n" <> T.pack (intercalate ", " diffTestGolden) ] in if null $ catMaybes results then Nothing - else Just $ intercalate "\n" $ catMaybes results + else Just $ T.intercalate "\n" $ catMaybes results -compareXMLFile' :: FilePath -> Archive -> Archive -> Either String () +compareXMLFile' :: FilePath -> Archive -> Archive -> Either Text () compareXMLFile' fp goldenArch testArch = do testEntry <- case findEntryByPath fp testArch of Just entry -> Right entry Nothing -> Left $ - "Can't extract " ++ fp ++ " from generated archive" + "Can't extract " <> T.pack fp <> " from generated archive" testXMLDoc <- case parseXMLDoc $ fromEntry testEntry of Just doc -> Right doc Nothing -> Left $ - "Can't parse xml in " ++ fp ++ " from generated archive" + "Can't parse xml in " <> T.pack fp <> + " from generated archive" goldenEntry <- case findEntryByPath fp goldenArch of Just entry -> Right entry Nothing -> Left $ - "Can't extract " ++ fp ++ " from archive in stored file" + "Can't extract " <> T.pack fp <> + " from archive in stored file" goldenXMLDoc <- case parseXMLDoc $ fromEntry goldenEntry of Just doc -> Right doc Nothing -> Left $ - "Can't parse xml in " ++ fp ++ " from archive in stored file" + "Can't parse xml in " <> T.pack fp <> + " from archive in stored file" let testContent = Elem testXMLDoc goldenContent = Elem goldenXMLDoc if compareXMLBool goldenContent testContent then Right () - else Left $ - "Non-matching xml in " ++ fp ++ ":\n" ++ displayDiff testContent goldenContent + else Left $ "Non-matching xml in " <> T.pack fp <> ":\n" <> + displayDiff testContent goldenContent -compareXMLFile :: FilePath -> Archive -> Archive -> Maybe String +compareXMLFile :: FilePath -> Archive -> Archive -> Maybe Text compareXMLFile fp goldenArch testArch = case compareXMLFile' fp goldenArch testArch of Right _ -> Nothing Left s -> Just s -compareAllXMLFiles :: Archive -> Archive -> Maybe String +compareAllXMLFiles :: Archive -> Archive -> Maybe Text compareAllXMLFiles goldenArch testArch = let allFiles = filesInArchive goldenArch `union` filesInArchive testArch allXMLFiles = sort $ @@ -130,29 +136,30 @@ compareAllXMLFiles goldenArch testArch = then Nothing else Just $ unlines results -compareMediaFile' :: FilePath -> Archive -> Archive -> Either String () +compareMediaFile' :: FilePath -> Archive -> Archive -> Either Text () compareMediaFile' fp goldenArch testArch = do testEntry <- case findEntryByPath fp testArch of Just entry -> Right entry Nothing -> Left $ - "Can't extract " ++ fp ++ " from generated archive" + "Can't extract " <> T.pack fp <> " from generated archive" goldenEntry <- case findEntryByPath fp goldenArch of Just entry -> Right entry Nothing -> Left $ - "Can't extract " ++ fp ++ " from archive in stored file" + "Can't extract " <> T.pack fp <> + " from archive in stored file" if fromEntry testEntry == fromEntry goldenEntry then Right () else Left $ - "Non-matching binary file: " ++ fp + "Non-matching binary file: " <> T.pack fp -compareMediaFile :: FilePath -> Archive -> Archive -> Maybe String +compareMediaFile :: FilePath -> Archive -> Archive -> Maybe Text compareMediaFile fp goldenArch testArch = case compareMediaFile' fp goldenArch testArch of Right _ -> Nothing Left s -> Just s -compareAllMediaFiles :: Archive -> Archive -> Maybe String +compareAllMediaFiles :: Archive -> Archive -> Maybe Text compareAllMediaFiles goldenArch testArch = let allFiles = filesInArchive goldenArch `union` filesInArchive testArch mediaPattern = compile "*/media/*" @@ -181,5 +188,5 @@ ooxmlTest writerFn testName opts nativeFP goldenFP = , compareAllXMLFiles goldenArch testArch , compareAllMediaFiles goldenArch testArch ] - in return $ if null res then Nothing else Just $ unlines res) + in return $ if null res then Nothing else Just $ T.unpack $ unlines res) (\a -> BL.writeFile goldenFP $ fromArchive a) diff --git a/test/Tests/Writers/Org.hs b/test/Tests/Writers/Org.hs index bd6c9b7ab..1935861ab 100644 --- a/test/Tests/Writers/Org.hs +++ b/test/Tests/Writers/Org.hs @@ -9,7 +9,7 @@ import Text.Pandoc.Arbitrary () import Text.Pandoc.Builder infix 4 =: -(=:) :: (ToString a, ToPandoc a) +(=:) :: (ToText a, ToPandoc a) => String -> (a, Text) -> TestTree (=:) = test org diff --git a/test/Tests/Writers/Plain.hs b/test/Tests/Writers/Plain.hs index 17edc9dbd..f4c539805 100644 --- a/test/Tests/Writers/Plain.hs +++ b/test/Tests/Writers/Plain.hs @@ -9,8 +9,8 @@ import Text.Pandoc.Builder infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree +(=:) :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree (=:) = test (purely (writePlain def{ writerExtensions = enableExtension Ext_gutenberg plainExtensions }) . toPandoc) diff --git a/test/Tests/Writers/RST.hs b/test/Tests/Writers/RST.hs index 94745e9a2..64df785a8 100644 --- a/test/Tests/Writers/RST.hs +++ b/test/Tests/Writers/RST.hs @@ -12,19 +12,19 @@ import Text.Pandoc.Writers.RST import qualified Data.Text as T infix 4 =: -(=:) :: (ToString a, ToPandoc a) - => String -> (a, String) -> TestTree +(=:) :: (ToText a, ToPandoc a) + => String -> (a, Text) -> TestTree (=:) = test (purely (writeRST def . toPandoc)) -testTemplate :: (ToString a, ToString c, ToPandoc a) => +testTemplate :: (ToText a, ToText c, ToPandoc a) => String -> String -> (a, c) -> TestTree testTemplate t = case runIdentity (compileTemplate [] (T.pack t)) of - Left e -> error $ "Could not compile RST template: " ++ e + Left e -> error $ T.pack $ "Could not compile RST template: " ++ e Right templ -> test (purely (writeRST def{ writerTemplate = Just templ }) . toPandoc) bodyTemplate :: Template T.Text bodyTemplate = case runIdentity (compileTemplate [] "$body$\n") of - Left e -> error $ + Left e -> error $ T.pack $ "Could not compile RST bodyTemplate" ++ e Right templ -> templ diff --git a/test/Tests/Writers/TEI.hs b/test/Tests/Writers/TEI.hs index fa372909f..562b27187 100644 --- a/test/Tests/Writers/TEI.hs +++ b/test/Tests/Writers/TEI.hs @@ -20,7 +20,7 @@ which is in turn shorthand for -} infix 4 =: -(=:) :: (ToString a, ToPandoc a) +(=:) :: (ToText a, ToPandoc a) => String -> (a, String) -> TestTree (=:) = test (purely (writeTEI def) . toPandoc) diff --git a/test/fb2/meta.fb2 b/test/fb2/meta.fb2 index 1db48c068..1385949f8 100644 --- a/test/fb2/meta.fb2 +++ b/test/fb2/meta.fb2 @@ -1,3 +1,2 @@ <?xml version="1.0" encoding="UTF-8"?> <FictionBook xmlns="http://www.gribuser.ru/xml/fictionbook/2.0" xmlns:l="http://www.w3.org/1999/xlink"><description><title-info><genre>unrecognised</genre><book-title>Book title</book-title><annotation><p>This is the abstract.</p><p>It consists of two paragraphs.</p></annotation></title-info><document-info><program-used>pandoc</program-used></document-info></description><body><title><p>Book title</p></title></body></FictionBook> - diff --git a/test/fb2/titles.fb2 b/test/fb2/titles.fb2 index d7e585902..426cfe892 100644 --- a/test/fb2/titles.fb2 +++ b/test/fb2/titles.fb2 @@ -1,3 +1,2 @@ <?xml version="1.0" encoding="UTF-8"?> <FictionBook xmlns="http://www.gribuser.ru/xml/fictionbook/2.0" xmlns:l="http://www.w3.org/1999/xlink"><description><title-info><genre>unrecognised</genre></title-info><document-info><program-used>pandoc</program-used></document-info></description><body><title><p /></title><section id="simple-title"><title><p>Simple title</p></title><p>This example tests FictionBook titles.</p></section><section id="emphasized-strong-title"><title><p><emphasis>Emphasized</emphasis> <strong>Strong</strong> Title</p></title></section></body></FictionBook> - |