diff options
31 files changed, 611 insertions, 689 deletions
diff --git a/.travis.yml b/.travis.yml index 75366b9c0..9c4177357 100644 --- a/.travis.yml +++ b/.travis.yml @@ -61,12 +61,12 @@ matrix: # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS # variable, such as using --stack-yaml to point to a different file. - - env: BUILD=stack ARGS="--resolver lts-9" OPTS="-Wall -Wincomplete-record-updates -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -fno-warn-unused-do-bind -Werror" - compiler: ": #stack 8.0.2" - addons: {apt: {packages: [ghc-8.0.2], sources: [hvr-ghc]}} + - env: BUILD=stack ARGS="--resolver lts-10" OPTS="-Wall -Wincomplete-record-updates -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -fno-warn-unused-do-bind -Werror" + compiler: ": #stack 8.2.2" + addons: {apt: {packages: [ghc-8.2.2], sources: [hvr-ghc]}} # Nightly builds are allowed to fail - - env: BUILD=stack ARGS="--resolver nightly" + - env: BUILD=stack ARGS="--resolver nightly" OPTS="-Wall -Wincomplete-record-updates -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances -fno-warn-unused-do-bind -Werror" compiler: ": #stack nightly" addons: {apt: {packages: [ghc-8.2.2], sources: [hvr-ghc]}} @@ -107,7 +107,7 @@ install: case "$BUILD" in stack) ulimit -n 4096 - stack --no-terminal --install-ghc $ARGS build --only-dependencies --fast --flag 'pandoc:embed_data_files' --flag 'aeson:fast' + stack --no-terminal --install-ghc $ARGS build --only-dependencies --fast --flag 'pandoc:embed_data_files' --flag 'aeson:fast' --jobs 2 ;; cabal) cabal --version diff --git a/MANUAL.txt b/MANUAL.txt index 3d69e90d8..bc332300d 100644 --- a/MANUAL.txt +++ b/MANUAL.txt @@ -4335,19 +4335,19 @@ using `div`s and `span`s, respectively. If you define a `div` or `span` with the attribute `custom-style`, pandoc will apply your specified style to the contained elements. So, -for example, +for example using the `bracketed_spans` syntax, - <span custom-style="Emphatically">Get out,</span> he said. + [Get out]{custom-style="Emphatically"}, he said. -would produce a docx file with "Get out," styled with character -style `Emphatically`. Similarly, +would produce a docx file with "Get out" styled with character +style `Emphatically`. Similarly, using the `fenced_divs` syntax, Dickinson starts the poem simply: - <div custom-style="Poetry"> + ::: {custom-style="Poetry"} | A Bird came down the Walk--- | He did not know I saw--- - </div> + ::: would style the two contained lines with the `Poetry` paragraph style. @@ -2,7 +2,7 @@ version?=$(shell grep '^[Vv]ersion:' pandoc.cabal | awk '{print $$2;}') pandoc=$(shell find dist -name pandoc -type f -exec ls -t {} \; | head -1) SOURCEFILES?=$(shell find pandoc.hs src test -name '*.hs') BRANCH?=master -RESOLVER=nightly-2017-10-22 +RESOLVER=lts-10 GHCOPTS=-fdiagnostics-color=always -Wall -fno-warn-unused-do-bind -Wincomplete-record-updates -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances quick: diff --git a/data/default.theme b/data/default.theme deleted file mode 100644 index cf1bf53cd..000000000 --- a/data/default.theme +++ /dev/null @@ -1,177 +0,0 @@ -{ - "metadata" : { - "revision" : 1, - "name" : "Default", - "author" : "Kate Authors", - "license" : "MIT", - "read-only" : true - }, - "text-styles": { - "Normal" : { - "text-color" : "#1f1c1b", - "selected-text-color" : "#ffffff", - "bold" : false, - "italic" : false, - "underline" : false, - "strike-through" : false - }, - "Keyword" : { - "text-color" : "#1f1c1b", - "selected-text-color" : "#ffffff", - "bold" : true - }, - "Function" : { - "text-color" : "#644a9b", - "selected-text-color" : "#452886" - }, - "Variable" : { - "text-color" : "#0057ae", - "selected-text-color" : "#00316e" - }, - "ControlFlow" : { - "text-color" : "#1f1c1b", - "selected-text-color" : "#ffffff", - "bold" : true - }, - "Operator" : { - "text-color" : "#1f1c1b", - "selected-text-color" : "#ffffff" - }, - "BuiltIn" : { - "text-color" : "#644a9b", - "selected-text-color" : "#452886", - "bold" : true - }, - "Extension" : { - "text-color" : "#0095ff", - "selected-text-color" : "#ffffff", - "bold" : true - }, - "Preprocessor" : { - "text-color" : "#006e28", - "selected-text-color" : "#006e28" - }, - "Attribute" : { - "text-color" : "#0057ae", - "selected-text-color" : "#00316e" - }, - "Char" : { - "text-color" : "#924c9d", - "selected-text-color" : "#6c2477" - }, - "SpecialChar" : { - "text-color" : "#3daee9", - "selected-text-color" : "#fcfcfc" - }, - "String" : { - "text-color" : "#bf0303", - "selected-text-color" : "#9c0e0e" - }, - "VerbatimString" : { - "text-color" : "#bf0303", - "selected-text-color" : "#9c0e0e" - }, - "SpecialString" : { - "text-color" : "#ff5500", - "selected-text-color" : "#ff5500" - }, - "Import" : { - "text-color" : "#ff5500", - "selected-text-color" : "#ff5500" - }, - "DataType" : { - "text-color" : "#0057ae", - "selected-text-color" : "#00316e" - }, - "DecVal" : { - "text-color" : "#b08000", - "selected-text-color" : "#805c00" - }, - "BaseN" : { - "text-color" : "#b08000", - "selected-text-color" : "#805c00" - }, - "Float" : { - "text-color" : "#b08000", - "selected-text-color" : "#805c00" - }, - "Constant" : { - "text-color" : "#aa5500", - "selected-text-color" : "#5e2f00" - }, - "Comment" : { - "text-color" : "#898887", - "selected-text-color" : "#5e5d5d" - }, - "Documentation" : { - "text-color" : "#607880", - "selected-text-color" : "#46585e" - }, - "Annotation" : { - "text-color" : "#ca60ca", - "selected-text-color" : "#a44ea4" - }, - "CommentVar" : { - "text-color" : "#0095ff", - "selected-text-color" : "#ffffff" - }, - "RegionMarker" : { - "text-color" : "#0057ae", - "selected-text-color" : "#00316e", - "background-color" : "#e0e9f8" - }, - "Information" : { - "text-color" : "#b08000", - "selected-text-color" : "#805c00" - }, - "Warning" : { - "text-color" : "#bf0303", - "selected-text-color" : "#9c0e0e" - }, - "Alert" : { - "text-color" : "#bf0303", - "selected-text-color" : "#9c0e0e", - "background-color" : "#f7e6e6", - "bold" : true - }, - "Error" : { - "text-color" : "#bf0303", - "selected-text-color" : "#9c0e0e", - "underline" : true - }, - "Others" : { - "text-color" : "#006e28", - "selected-text-color" : "#006e28" - } - }, - "editor-colors": { - "background-color" : "#ffffff", - "code-folding" : "#94caef", - "bracket-matching" : "#ffff00", - "current-line" : "#f8f7f6", - "icon-border" : "#f0f0f0", - "indentation-line" : "#d2d2d2", - "line-numbers" : "#a0a0a0", - "current-line-number" : "#1e1e1e", - "mark-bookmark" : "#0000ff", - "mark-breakpoint-active" : "#ff0000", - "mark-breakpoint-reached" : "#ffff00", - "mark-breakpoint-disabled" : "#ff00ff", - "mark-execution" : "#a0a0a4", - "mark-warning" : "#00ff00", - "mark-error" : "#ff0000", - "modified-lines" : "#fdbc4b", - "replace-highlight" : "#00ff00", - "saved-lines" : "#2ecc71", - "search-highlight" : "#ffff00", - "selection" : "#94caef", - "separator" : "#898887", - "spell-checking" : "#bf0303", - "tab-marker" : "#d2d2d2", - "template-background" : "#d6d2d0", - "template-placeholder" : "#baf8ce", - "template-focused-placeholder" : "#76da98", - "template-read-only-placeholder" : "#f6e6e6", - "word-wrap-marker" : "#ededed" - } -} diff --git a/data/pandoc.lua b/data/pandoc.lua index 3be3b507a..98d274cf4 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -874,53 +874,6 @@ M.UpperAlpha = "UpperAlpha" -- Helper Functions -- @section helpers ---- Parse the given string into a Pandoc document. --- The method used to interpret input is specified by *format*. Acceptable --- values for this parameter are equal to those that can be given to the --- `--from` command line option. --- @tparam string markup the markup to be parsed --- @tparam[opt] string format format specification, defaults to "markdown". --- @treturn Pandoc pandoc document --- @usage --- local org_markup = "/emphasis/" -- Input to be read --- local document = pandoc.read(org_markup, "org") --- -- Get the first block of the document --- local block = document.blocks[1] --- -- The inline element in that block is an `Emph` --- assert(block.content[1].t == "Emph") -function M.read(markup, format) - format = format or "markdown" - local pd = pandoc._read(format, markup) - if type(pd) == "string" then - error(pd) - else - return pd - end -end - ---- Runs command with arguments, passing it some input, and returns the output. --- @treturn string Output of command. --- @raise A table containing the keys `command`, `error_code`, and `output` is --- thrown if the command exits with a non-zero error code. --- @usage --- local ec, output = pandoc.pipe("sed", {"-e","s/a/b/"}, "abc") -function M.pipe (command, args, input) - local ec, output = pandoc._pipe(command, args, input) - if ec ~= 0 then - err = setmetatable( - { command = command, error_code = ec, output = output}, - { __tostring = function(e) - return "Error running " .. e.command - .. " (error code " .. e.error_code .. "): " - .. e.output - end - } - ) - error(err) - end - return output -end - --- Use functions defined in the global namespace to create a pandoc filter. -- All globally defined functions which have names of pandoc elements are -- collected into a new table. @@ -950,4 +903,9 @@ function M.global_filter() return res end +------------------------------------------------------------------------ +-- Functions which have moved to different modules +local utils = require 'pandoc.utils' +M.sha1 = utils.sha1 + return M diff --git a/doc/lua-filters.md b/doc/lua-filters.md index 9beeda185..a109871f6 100644 --- a/doc/lua-filters.md +++ b/doc/lua-filters.md @@ -1405,18 +1405,6 @@ Lua functions for pandoc scripts. -- the above is equivallent to -- return {{Str = Str}} -[`sha1 (contents)`]{#mediabag-sha1} - -: Returns the SHA1 has of the contents. - - Returns: - - - SHA1 hash of the contents. - - Usage: - - local fp = pandoc.mediabag.sha1("foobar") - [`pipe (command, args, input)`]{#mediabag-sha1} : Runs command with arguments, passing it some input, @@ -1436,9 +1424,28 @@ Lua functions for pandoc scripts. local output = pandoc.pipe("sed", {"-e","s/a/b/"}, "abc") -# Submodule mediabag -The submodule `mediabag` allows accessing pandoc's media +# Module pandoc.utils + +This module exposes internal pandoc functions and utility +functions. + +[`sha1 (contents)`]{#utils-sha1} + +: Returns the SHA1 has of the contents. + + Returns: + + - SHA1 hash of the contents. + + Usage: + + local fp = pandoc.utils.sha1("foobar") + + +# Module pandoc.mediabag + +The `pandoc.mediabag` module allows accessing pandoc's media storage. The "media bag" is used when pandoc is called with the `--extract-media` or `--standalone`/`-s` option. diff --git a/pandoc.cabal b/pandoc.cabal index 4ad2005b8..665f3ed21 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -155,8 +155,6 @@ data-files: data/pandoc.lua -- lua List module data/pandoc.List.lua - -- sample highlighting theme - data/default.theme -- bash completion template data/bash_completion.tpl -- jats csl @@ -527,8 +525,10 @@ library Text.Pandoc.Readers.Org.Shared, Text.Pandoc.Lua.Filter, Text.Pandoc.Lua.Init, + Text.Pandoc.Lua.Module.MediaBag, + Text.Pandoc.Lua.Module.Pandoc, + Text.Pandoc.Lua.Module.Utils, Text.Pandoc.Lua.Packages, - Text.Pandoc.Lua.PandocModule, Text.Pandoc.Lua.StackInstances, Text.Pandoc.Lua.Util, Text.Pandoc.CSS, diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index e70b606a9..df4bdc151 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -538,7 +538,7 @@ convertWithOpts opts = do type Transform = Pandoc -> Pandoc isTextFormat :: String -> Bool -isTextFormat s = s `notElem` ["odt","docx","epub2","epub3","epub"] +isTextFormat s = s `notElem` ["odt","docx","epub2","epub3","epub","pptx"] externalFilter :: MonadIO m => ReaderOptions -> FilePath -> [String] -> Pandoc -> m Pandoc diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index a56e89511..ee259e3fd 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -39,7 +39,7 @@ import Text.Pandoc.Class (PandocIO) import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter) import Text.Pandoc.Lua.Init (runPandocLua) -import Text.Pandoc.Lua.PandocModule (pushPandocModule) -- TODO: remove +import Text.Pandoc.Lua.Module.Pandoc (pushModule) -- TODO: remove import qualified Foreign.Lua as Lua -- | Run the Lua filter in @filterPath@ for a transformation to target @@ -81,3 +81,7 @@ pushGlobalFilter = do runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc runAll = foldr ((>=>) . walkMWithLuaFilter) return + +-- | DEPRECATED: Push the pandoc module to the Lua Stack. +pushPandocModule :: Maybe FilePath -> Lua Lua.NumResults +pushPandocModule = pushModule diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs index 6bc2618fd..33c441c99 100644 --- a/src/Text/Pandoc/Lua/PandocModule.hs +++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE FlexibleContexts #-} {- Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -17,88 +15,39 @@ You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -{-# LANGUAGE CPP #-} {- | - Module : Text.Pandoc.Lua.PandocModule + Module : Text.Pandoc.Lua.Module.MediaBag Copyright : Copyright © 2017 Albert Krewinkel License : GNU GPL, version 2 or above Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> Stability : alpha -Pandoc module for lua. +The lua module @pandoc.mediabag@. -} -module Text.Pandoc.Lua.PandocModule - ( pushPandocModule - , pushMediaBagModule +module Text.Pandoc.Lua.Module.MediaBag + ( pushModule ) where import Control.Monad (zipWithM_) -import Data.Default (Default (..)) -import Data.Digest.Pure.SHA (sha1, showDigest) import Data.IORef (IORef, modifyIORef', readIORef) import Data.Maybe (fromMaybe) -import Data.Text (pack) -import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO) -import Foreign.Lua.FunctionCalling (ToHaskellFunction) -import System.Exit (ExitCode (..)) +import Foreign.Lua (Lua, NumResults, liftIO) import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState, - runIO, runIOorExplode, setMediaBag) -import Text.Pandoc.Definition (Block, Inline) -import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter) + runIOorExplode, setMediaBag) import Text.Pandoc.Lua.StackInstances () -import Text.Pandoc.Lua.Util (loadScriptFromDataDir) -import Text.Pandoc.Walk (Walkable) +import Text.Pandoc.Lua.Util (OrNil (toMaybe), addFunction) import Text.Pandoc.MIME (MimeType) -import Text.Pandoc.Options (ReaderOptions (readerExtensions)) -import Text.Pandoc.Process (pipeProcess) -import Text.Pandoc.Readers (Reader (..), getReader) import qualified Data.ByteString.Lazy as BL import qualified Foreign.Lua as Lua import qualified Text.Pandoc.MediaBag as MB --- | Push the "pandoc" on the lua stack. Requires the `list` module to be --- loaded. -pushPandocModule :: Maybe FilePath -> Lua NumResults -pushPandocModule datadir = do - loadScriptFromDataDir datadir "pandoc.lua" - addFunction "_pipe" pipeFn - addFunction "_read" readDoc - addFunction "sha1" sha1HashFn - addFunction "walk_block" walkBlock - addFunction "walk_inline" walkInline - return 1 - -walkElement :: (ToLuaStack a, Walkable [Inline] a, Walkable [Block] a) - => a -> LuaFilter -> Lua a -walkElement x f = walkInlines f x >>= walkBlocks f - -walkInline :: Inline -> LuaFilter -> Lua Inline -walkInline = walkElement - -walkBlock :: Block -> LuaFilter -> Lua Block -walkBlock = walkElement - -readDoc :: String -> String -> Lua NumResults -readDoc formatSpec content = do - case getReader formatSpec of - Left s -> Lua.push s -- Unknown reader - Right (reader, es) -> - case reader of - TextReader r -> do - res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content) - case res of - Left s -> Lua.push $ show s -- error while reading - Right pd -> Lua.push pd -- success, push Pandoc - _ -> Lua.push "Only string formats are supported at the moment." - return 1 - -- -- MediaBag submodule -- -pushMediaBagModule :: CommonState -> IORef MB.MediaBag -> Lua NumResults -pushMediaBagModule commonState mediaBagRef = do +pushModule :: CommonState -> IORef MB.MediaBag -> Lua NumResults +pushModule commonState mediaBagRef = do Lua.newtable addFunction "insert" (insertMediaFn mediaBagRef) addFunction "lookup" (lookupMediaFn mediaBagRef) @@ -106,30 +55,6 @@ pushMediaBagModule commonState mediaBagRef = do addFunction "fetch" (fetch commonState mediaBagRef) return 1 -addFunction :: ToHaskellFunction a => String -> a -> Lua () -addFunction name fn = do - Lua.push name - Lua.pushHaskellFunction fn - Lua.rawset (-3) - -sha1HashFn :: BL.ByteString - -> Lua NumResults -sha1HashFn contents = do - Lua.push $ showDigest (sha1 contents) - return 1 - -pipeFn :: String - -> [String] - -> BL.ByteString - -> Lua NumResults -pipeFn command args input = do - (ec, output) <- liftIO $ pipeProcess Nothing command args input - Lua.push $ case ec of - ExitSuccess -> 0 - ExitFailure n -> n - Lua.push output - return 2 - insertMediaFn :: IORef MB.MediaBag -> FilePath -> OrNil MimeType @@ -181,16 +106,3 @@ fetch commonState mbRef src = do Lua.push $ fromMaybe "" mimeType Lua.push bs return 2 -- returns 2 values: contents, mimetype - --- --- Helper types and orphan instances --- - -newtype OrNil a = OrNil { toMaybe :: Maybe a } - -instance FromLuaStack a => FromLuaStack (OrNil a) where - peek idx = do - noValue <- Lua.isnil idx - if noValue - then return (OrNil Nothing) - else OrNil . Just <$> Lua.peek idx diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs new file mode 100644 index 000000000..5b8714e07 --- /dev/null +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -0,0 +1,135 @@ +{- +Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} +{-# LANGUAGE FlexibleContexts #-} +{- | + Module : Text.Pandoc.Lua.Module.Pandoc + Copyright : Copyright © 2017 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + Stability : alpha + +Pandoc module for lua. +-} +module Text.Pandoc.Lua.Module.Pandoc + ( pushModule + ) where + +import Control.Monad (when) +import Data.Default (Default (..)) +import Data.Maybe (fromMaybe) +import Data.Text (pack) +import Foreign.Lua (ToLuaStack, FromLuaStack, Lua, NumResults, liftIO) +import System.Exit (ExitCode (..)) +import Text.Pandoc.Class (runIO) +import Text.Pandoc.Definition (Block, Inline) +import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter) +import Text.Pandoc.Lua.StackInstances () +import Text.Pandoc.Lua.Util (OrNil (toMaybe), addFunction, addValue, + loadScriptFromDataDir, raiseError) +import Text.Pandoc.Walk (Walkable) +import Text.Pandoc.Options (ReaderOptions (readerExtensions)) +import Text.Pandoc.Process (pipeProcess) +import Text.Pandoc.Readers (Reader (..), getReader) + +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BSL +import qualified Foreign.Lua as Lua + +-- | Push the "pandoc" on the lua stack. Requires the `list` module to be +-- loaded. +pushModule :: Maybe FilePath -> Lua NumResults +pushModule datadir = do + loadScriptFromDataDir datadir "pandoc.lua" + addFunction "read" readDoc + addFunction "pipe" pipeFn + addFunction "walk_block" walkBlock + addFunction "walk_inline" walkInline + return 1 + +walkElement :: (ToLuaStack a, Walkable [Inline] a, Walkable [Block] a) + => a -> LuaFilter -> Lua a +walkElement x f = walkInlines f x >>= walkBlocks f + +walkInline :: Inline -> LuaFilter -> Lua Inline +walkInline = walkElement + +walkBlock :: Block -> LuaFilter -> Lua Block +walkBlock = walkElement + +readDoc :: String -> OrNil String -> Lua NumResults +readDoc content formatSpecOrNil = do + let formatSpec = fromMaybe "markdown" (toMaybe formatSpecOrNil) + case getReader formatSpec of + Left s -> raiseError s -- Unknown reader + Right (reader, es) -> + case reader of + TextReader r -> do + res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content) + case res of + Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc + Left s -> raiseError (show s) -- error while reading + _ -> raiseError "Only string formats are supported at the moment." + +-- | Pipes input through a command. +pipeFn :: String + -> [String] + -> BL.ByteString + -> Lua NumResults +pipeFn command args input = do + (ec, output) <- liftIO $ pipeProcess Nothing command args input + case ec of + ExitSuccess -> 1 <$ Lua.push output + ExitFailure n -> raiseError (PipeError command n output) + +data PipeError = PipeError + { pipeErrorCommand :: String + , pipeErrorCode :: Int + , pipeErrorOutput :: BL.ByteString + } + +instance FromLuaStack PipeError where + peek idx = + PipeError + <$> (Lua.getfield idx "command" *> Lua.peek (-1) <* Lua.pop 1) + <*> (Lua.getfield idx "error_code" *> Lua.peek (-1) <* Lua.pop 1) + <*> (Lua.getfield idx "output" *> Lua.peek (-1) <* Lua.pop 1) + +instance ToLuaStack PipeError where + push pipeErr = do + Lua.newtable + addValue "command" (pipeErrorCommand pipeErr) + addValue "error_code" (pipeErrorCode pipeErr) + addValue "output" (pipeErrorOutput pipeErr) + pushPipeErrorMetaTable + Lua.setmetatable (-2) + where + pushPipeErrorMetaTable :: Lua () + pushPipeErrorMetaTable = do + v <- Lua.newmetatable "pandoc pipe error" + when v $ addFunction "__tostring" pipeErrorMessage + + pipeErrorMessage :: PipeError -> Lua BL.ByteString + pipeErrorMessage (PipeError cmd errorCode output) = return $ mconcat + [ BSL.pack "Error running " + , BSL.pack cmd + , BSL.pack " (error code " + , BSL.pack $ show errorCode + , BSL.pack "): " + , if output == mempty then BSL.pack "<no output>" else output + ] diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs new file mode 100644 index 000000000..496fdbc0a --- /dev/null +++ b/src/Text/Pandoc/Lua/Module/Utils.hs @@ -0,0 +1,50 @@ +{- +Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} +{- | + Module : Text.Pandoc.Lua.Module.Utils + Copyright : Copyright © 2017 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + Stability : alpha + +Utility module for lua, exposing internal helper functions. +-} +module Text.Pandoc.Lua.Module.Utils + ( pushModule + ) where + +import Data.Digest.Pure.SHA (sha1, showDigest) +import Foreign.Lua (Lua, NumResults) +import Text.Pandoc.Lua.StackInstances () +import Text.Pandoc.Lua.Util (addFunction) + +import qualified Data.ByteString.Lazy as BSL +import qualified Foreign.Lua as Lua + +-- | Push the "pandoc.utils" module to the lua stack. +pushModule :: Lua NumResults +pushModule = do + Lua.newtable + addFunction "sha1" sha1HashFn + return 1 + +-- | Calculate the hash of the given contents. +sha1HashFn :: BSL.ByteString + -> Lua String +sha1HashFn = return . showDigest . sha1 diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs index b2dbff496..f26c17084 100644 --- a/src/Text/Pandoc/Lua/Packages.hs +++ b/src/Text/Pandoc/Lua/Packages.hs @@ -38,10 +38,12 @@ import Data.IORef (IORef) import Foreign.Lua (Lua, NumResults, liftIO) import Text.Pandoc.Class (CommonState, readDataFile, runIO, setUserDataDir) import Text.Pandoc.MediaBag (MediaBag) -import Text.Pandoc.Lua.PandocModule (pushPandocModule, pushMediaBagModule) import Text.Pandoc.Lua.Util (dostring') import qualified Foreign.Lua as Lua +import Text.Pandoc.Lua.Module.Pandoc as Pandoc +import Text.Pandoc.Lua.Module.MediaBag as MediaBag +import Text.Pandoc.Lua.Module.Utils as Utils -- | Parameters used to create lua packages/modules. data LuaPackageParams = LuaPackageParams @@ -72,10 +74,11 @@ pandocPackageSearcher :: LuaPackageParams -> String -> Lua NumResults pandocPackageSearcher luaPkgParams pkgName = case pkgName of "pandoc" -> let datadir = luaPkgDataDir luaPkgParams - in pushWrappedHsFun (pushPandocModule datadir) + in pushWrappedHsFun (Pandoc.pushModule datadir) "pandoc.mediabag" -> let st = luaPkgCommonState luaPkgParams mbRef = luaPkgMediaBag luaPkgParams - in pushWrappedHsFun (pushMediaBagModule st mbRef) + in pushWrappedHsFun (MediaBag.pushModule st mbRef) + "pandoc.utils" -> pushWrappedHsFun Utils.pushModule _ -> searchPureLuaLoader where pushWrappedHsFun f = do diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs index 5803e62dc..e688ad255 100644 --- a/src/Text/Pandoc/Lua/Util.hs +++ b/src/Text/Pandoc/Lua/Util.hs @@ -32,9 +32,12 @@ module Text.Pandoc.Lua.Util ( adjustIndexBy , getTable , addValue + , addFunction , getRawInt , setRawInt , addRawInt + , raiseError + , OrNil (..) , PushViaCall , pushViaCall , pushViaConstructor @@ -44,8 +47,8 @@ module Text.Pandoc.Lua.Util import Control.Monad (when) import Data.ByteString.Char8 (unpack) -import Foreign.Lua (FromLuaStack (..), Lua, NumArgs, StackIndex, - ToLuaStack (..), getglobal') +import Foreign.Lua (FromLuaStack (..), NumResults, Lua, NumArgs, StackIndex, + ToLuaStack (..), ToHaskellFunction, getglobal') import Foreign.Lua.Api (Status, call, pop, rawget, rawgeti, rawset, rawseti) import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir) @@ -66,13 +69,21 @@ getTable idx key = do rawget (idx `adjustIndexBy` 1) peek (-1) <* pop 1 --- | Add a key-value pair to the table at the top of the stack +-- | Add a key-value pair to the table at the top of the stack. addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua () addValue key value = do push key push value rawset (-3) +-- | Add a function to the table at the top of the stack, using the given name. +addFunction :: ToHaskellFunction a => String -> a -> Lua () +addFunction name fn = do + Lua.push name + Lua.pushHaskellFunction fn + Lua.wrapHaskellFunction + Lua.rawset (-3) + -- | Get value behind key from table at given index. getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a getRawInt idx key = @@ -90,6 +101,22 @@ setRawInt idx key value = do addRawInt :: ToLuaStack a => Int -> a -> Lua () addRawInt = setRawInt (-1) +raiseError :: ToLuaStack a => a -> Lua NumResults +raiseError e = do + Lua.push e + fromIntegral <$> Lua.lerror + +-- | Newtype wrapper intended to be used for optional Lua values. Nesting this +-- type is strongly discouraged and will likely lead to a wrong result. +newtype OrNil a = OrNil { toMaybe :: Maybe a } + +instance FromLuaStack a => FromLuaStack (OrNil a) where + peek idx = do + noValue <- Lua.isnoneornil idx + if noValue + then return (OrNil Nothing) + else OrNil . Just <$> Lua.peek idx + -- | Helper class for pushing a single value to the stack via a lua function. -- See @pushViaCall@. class PushViaCall a where diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index c82697704..e6ae4c11b 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -376,8 +376,9 @@ totoks pos t = | d < '\128' -> Tok pos Esc1 (T.pack ['^','^',d]) : totoks (incSourceColumn pos 3) rest'' - _ -> [Tok pos Symbol ("^"), - Tok (incSourceColumn pos 1) Symbol ("^")] + _ -> Tok pos Symbol ("^") : + Tok (incSourceColumn pos 1) Symbol ("^") : + totoks (incSourceColumn pos 2) rest' _ -> Tok pos Symbol ("^") : totoks (incSourceColumn pos 1) rest | otherwise -> diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 46dcf38d9..7142c249f 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -31,7 +31,6 @@ Conversion of Muse text to 'Pandoc' document. {- TODO: - Page breaks (five "*") -- Headings with anchors (make it round trip with Muse writer) - Org tables - table.el tables - Images with attributes (floating and width) @@ -241,7 +240,8 @@ header = try $ do guard $ level <= 5 spaceChar content <- trimInlinesF . mconcat <$> manyTill inline eol - attr <- registerHeader ("", [], []) (runF content defaultParserState) + anchorId <- option "" parseAnchor + attr <- registerHeader (anchorId, [], []) (runF content defaultParserState) return $ B.headerWith attr level <$> content example :: PandocMonad m => MuseParser m (F Blocks) @@ -336,7 +336,9 @@ para = do noteMarker :: PandocMonad m => MuseParser m String noteMarker = try $ do char '[' - many1Till digit $ char ']' + first <- oneOf "123456789" + rest <- manyTill digit (char ']') + return $ first:rest -- Amusewiki version of note -- Parsing is similar to list item, except that note marker is used instead of list marker @@ -627,14 +629,18 @@ endline = try $ do notFollowedBy blankline returnF B.softbreak -anchor :: PandocMonad m => MuseParser m (F Inlines) -anchor = try $ do +parseAnchor :: PandocMonad m => MuseParser m String +parseAnchor = try $ do getPosition >>= \pos -> guard (sourceColumn pos == 1) char '#' first <- letter rest <- many (letter <|> digit) skipMany spaceChar <|> void newline - let anchorId = first:rest + return $ first:rest + +anchor :: PandocMonad m => MuseParser m (F Inlines) +anchor = try $ do + anchorId <- parseAnchor return $ return $ B.spanWith (anchorId, [], []) mempty footnote :: PandocMonad m => MuseParser m (F Inlines) diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 04a0efc15..cc6abbfa5 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -737,7 +737,7 @@ noteBlock = try $ do paraOrPlain :: PandocMonad m => OrgParser m (F Blocks) paraOrPlain = try $ do -- Make sure we are not looking at a headline - notFollowedBy' (char '*' *> oneOf " *") + notFollowedBy' headerStart ils <- inlines nl <- option False (newline *> return True) -- Read block as paragraph, except if we are in a list context and the block diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index 1ba8d5a05..d4524c333 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -59,6 +59,7 @@ getDefaultTemplate writer = do "json" -> return "" "docx" -> return "" "fb2" -> return "" + "pptx" -> return "" "odt" -> getDefaultTemplate "opendocument" "html" -> getDefaultTemplate "html5" "docbook" -> getDefaultTemplate "docbook5" diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 94529dad4..e4240ca4f 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -213,8 +213,12 @@ writeDocx opts doc@(Pandoc meta _) = do let doc' = walk fixDisplayMath doc username <- P.lookupEnv "USERNAME" utctime <- P.getCurrentTime - distArchive <- (toArchive . BL.fromStrict) <$> - P.readDefaultDataFile "reference.docx" + distArchive <- (toArchive . BL.fromStrict) <$> do + oldUserDataDir <- P.getUserDataDir + P.setUserDataDir Nothing + res <- P.readDefaultDataFile "reference.docx" + P.setUserDataDir oldUserDataDir + return res refArchive <- case writerReferenceDoc opts of Just f -> toArchive <$> P.readFileLazy f Nothing -> (toArchive . BL.fromStrict) <$> diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 8dda969d9..e9e380a6c 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -325,6 +325,9 @@ tableItemToJATS :: PandocMonad m -> Bool -> [Block] -> JATS m Doc +tableItemToJATS opts isHeader [Plain item] = + inTags True (if isHeader then "th" else "td") [] <$> + inlinesToJATS opts item tableItemToJATS opts isHeader item = (inTags True (if isHeader then "th" else "td") [] . vcat) <$> mapM (blockToJATS opts) item @@ -416,8 +419,11 @@ inlineToJATS opts (Link (ident,_,kvs) txt ('#':src, _)) = do [("alt", stringify txt) | not (null txt)] ++ [("rid", src)] ++ [(k,v) | (k,v) <- kvs, k `elem` ["ref-type", "specific-use"]] - contents <- inlinesToJATS opts txt - return $ inTags False "xref" attr contents + if null txt + then return $ selfClosingTag "xref" attr + else do + contents <- inlinesToJATS opts txt + return $ inTags False "xref" attr contents inlineToJATS opts (Link (ident,_,kvs) txt (src, tit)) = do let attr = [("id", ident) | not (null ident)] ++ [("ext-link-type", "uri"), diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index 545891d97..34936504e 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -229,7 +229,7 @@ blockToMuse (Header level (ident,_,_) inlines) = do else "#" <> text ident <> cr let header' = text $ replicate level '*' return $ blankline <> nowrap (header' <> space <> contents) - <> blankline <> attr' + $$ attr' <> blankline -- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors blockToMuse HorizontalRule = return $ blankline $$ "----" $$ blankline blockToMuse (Table caption _ _ headers rows) = do diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index e10fcd5ce..43b5b59ee 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -308,13 +308,18 @@ blockListToOrg blocks = vcat <$> mapM blockToOrg blocks inlineListToOrg :: PandocMonad m => [Inline] -> Org m Doc -inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixNotes lst) - where fixNotes [] = [] -- prevent note ref from wrapping, see #4171 - fixNotes (Space : n@Note{} : rest) = - Str " " : n : fixNotes rest - fixNotes (SoftBreak : n@Note{} : rest) = - Str " " : n : fixNotes rest - fixNotes (x : rest) = x : fixNotes rest +inlineListToOrg lst = hcat <$> mapM inlineToOrg (fixMarkers lst) + where fixMarkers [] = [] -- prevent note refs and list markers from wrapping, see #4171 + fixMarkers (Space : x : rest) | shouldFix x = + Str " " : x : fixMarkers rest + fixMarkers (SoftBreak : x : rest) | shouldFix x = + Str " " : x : fixMarkers rest + fixMarkers (x : rest) = x : fixMarkers rest + + shouldFix Note{} = True -- Prevent footnotes + shouldFix (Str "-") = True -- Prevent bullet list items + -- TODO: prevent ordered list items + shouldFix _ = False -- | Convert Pandoc inline element to Org. inlineToOrg :: PandocMonad m => Inline -> Org m Doc diff --git a/src/Text/Pandoc/Writers/Powerpoint.hs b/src/Text/Pandoc/Writers/Powerpoint.hs index b5f06c581..7a453ef1f 100644 --- a/src/Text/Pandoc/Writers/Powerpoint.hs +++ b/src/Text/Pandoc/Writers/Powerpoint.hs @@ -105,6 +105,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta , envPresentationSize :: PresentationSize , envSlideHasHeader :: Bool , envInList :: Bool + , envInNoteSlide :: Bool } deriving (Show) @@ -120,6 +121,7 @@ instance Default WriterEnv where , envPresentationSize = def , envSlideHasHeader = False , envInList = False + , envInNoteSlide = False } data MediaInfo = MediaInfo { mInfoFilePath :: FilePath @@ -139,6 +141,7 @@ data WriterState = WriterState { stCurSlideId :: Int -- (FP, Local ID, Global ID, Maybe Mime) , stMediaIds :: M.Map Int [MediaInfo] , stMediaGlobalIds :: M.Map FilePath Int + , stNoteIds :: M.Map Int [Block] } deriving (Show, Eq) instance Default WriterState where @@ -147,6 +150,7 @@ instance Default WriterState where , stLinkIds = mempty , stMediaIds = mempty , stMediaGlobalIds = mempty + , stNoteIds = mempty } type P m = ReaderT WriterEnv (StateT WriterState m) @@ -300,6 +304,7 @@ data RunProps = RunProps { rPropBold :: Bool , rLink :: Maybe (URL, String) , rPropCode :: Bool , rPropBlockQuote :: Bool + , rPropForceSize :: Maybe Pixels } deriving (Show, Eq) instance Default RunProps where @@ -311,6 +316,7 @@ instance Default RunProps where , rLink = Nothing , rPropCode = False , rPropBlockQuote = False + , rPropForceSize = Nothing } -------------------------------------------------- @@ -351,6 +357,14 @@ inlineToParElems (Code _ str) = do inlineToParElems $ Str str inlineToParElems (Math mathtype str) = return [MathElem mathtype (TeXString str)] +inlineToParElems (Note blks) = do + notes <- gets stNoteIds + let maxNoteId = case M.keys notes of + [] -> 0 + lst -> maximum lst + curNoteId = maxNoteId + 1 + modify $ \st -> st { stNoteIds = M.insert curNoteId blks notes } + inlineToParElems $ Superscript [Str $ show curNoteId] inlineToParElems (Span _ ils) = concatMapM inlineToParElems ils inlineToParElems (RawInline _ _) = return [] inlineToParElems _ = return [] @@ -375,7 +389,7 @@ blockToParagraphs (CodeBlock attr str) = -- TODO: work out the format blockToParagraphs (BlockQuote blks) = local (\r -> r{ envParaProps = (envParaProps r){pPropMarginLeft = Just 100} - , envRunProps = (envRunProps r){rPropBlockQuote = True}})$ + , envRunProps = (envRunProps r){rPropForceSize = Just blockQuoteSize}})$ concatMapM blockToParagraphs blks -- TODO: work out the format blockToParagraphs (RawBlock _ _) = return [] @@ -411,6 +425,15 @@ blockToParagraphs (OrderedList listAttr blksLst) = do , pPropMarginLeft = Nothing }}) $ concatMapM multiParBullet blksLst +blockToParagraphs (DefinitionList entries) = do + let go :: PandocMonad m => ([Inline], [[Block]]) -> P m [Paragraph] + go (ils, blksLst) = do + term <-blockToParagraphs $ Para [Strong ils] + -- For now, we'll treat each definition term as a + -- blockquote. We can extend this further later. + definition <- concatMapM (blockToParagraphs . BlockQuote) blksLst + return $ term ++ definition + concatMapM go entries blockToParagraphs (Div _ blks) = concatMapM blockToParagraphs blks -- TODO blockToParagraphs blk = do @@ -527,12 +550,18 @@ blocksToSlide' lvl ((Header n _ ils) : blks) return $ TitleSlide {titleSlideHeader = hdr} | n == lvl = do hdr <- inlinesToParElems ils - shapes <- blocksToShapes blks + inNoteSlide <- asks envInNoteSlide + shapes <- if inNoteSlide + then forceFontSize noteSize $ blocksToShapes blks + else blocksToShapes blks return $ ContentSlide { contentSlideHeader = hdr , contentSlideContent = shapes } blocksToSlide' _ (blk : blks) = do - shapes <- blocksToShapes (blk : blks) + inNoteSlide <- asks envInNoteSlide + shapes <- if inNoteSlide + then forceFontSize noteSize $ blocksToShapes (blk : blks) + else blocksToShapes (blk : blks) return $ ContentSlide { contentSlideHeader = [] , contentSlideContent = shapes } @@ -545,6 +574,38 @@ blocksToSlide blks = do slideLevel <- asks envSlideLevel blocksToSlide' slideLevel blks +makeNoteEntry :: Int -> [Block] -> [Block] +makeNoteEntry n blks = + let enum = Str (show n ++ ".") + in + case blks of + (Para ils : blks') -> (Para $ enum : Space : ils) : blks' + _ -> (Para [enum]) : blks + +forceFontSize :: PandocMonad m => Pixels -> P m a -> P m a +forceFontSize px x = do + rpr <- asks envRunProps + local (\r -> r {envRunProps = rpr{rPropForceSize = Just px}}) x + +-- Right now, there's no logic for making more than one slide, but I +-- want to leave the option open to make multiple slides if we figure +-- out how to guess at how much space the text of the notes will take +-- up (or if we allow a way for it to be manually controlled). Plus a +-- list will make it easier to put together in the final +-- `blocksToPresentation` function (since we can just add an empty +-- list without checking the state). +makeNotesSlides :: PandocMonad m => P m [Slide] +makeNotesSlides = local (\env -> env{envInNoteSlide=True}) $ do + noteIds <- gets stNoteIds + if M.null noteIds + then return [] + else do let hdr = Header 2 nullAttr [Str "Notes"] + blks <- return $ + concatMap (\(n, bs) -> makeNoteEntry n bs) $ + M.toList noteIds + sld <- blocksToSlide $ hdr : blks + return [sld] + getMetaSlide :: PandocMonad m => P m (Maybe Slide) getMetaSlide = do meta <- asks envMetadata @@ -570,11 +631,13 @@ blocksToPresentation :: PandocMonad m => [Block] -> P m Presentation blocksToPresentation blks = do blksLst <- splitBlocks blks slides <- mapM blocksToSlide blksLst + noteSlides <- makeNotesSlides + let slides' = slides ++ noteSlides metadataslide <- getMetaSlide presSize <- asks envPresentationSize return $ case metadataslide of - Just metadataslide' -> Presentation presSize $ metadataslide' : slides - Nothing -> Presentation presSize slides + Just metadataslide' -> Presentation presSize $ metadataslide' : slides' + Nothing -> Presentation presSize slides' -------------------------------------------------------------------- @@ -1045,13 +1108,18 @@ makePicElement mInfo attr = do blockQuoteSize :: Pixels blockQuoteSize = 20 +noteSize :: Pixels +noteSize = 18 + paraElemToElement :: PandocMonad m => ParaElem -> P m Element paraElemToElement Break = return $ mknode "a:br" [] () paraElemToElement (Run rpr s) = do let attrs = if rPropCode rpr then [] - else (if rPropBlockQuote rpr then [("sz", (show $ blockQuoteSize * 100))] else []) ++ + else (case rPropForceSize rpr of + Just n -> [("sz", (show $ n * 100))] + Nothing -> []) ++ (if rPropBold rpr then [("b", "1")] else []) ++ (if rPropItalics rpr then [("i", "1")] else []) ++ (case rStrikethrough rpr of diff --git a/stack.pkg.yaml b/stack.pkg.yaml index fc59a9566..fe6f0622c 100644 --- a/stack.pkg.yaml +++ b/stack.pkg.yaml @@ -12,18 +12,5 @@ flags: debug: false packages: - '.' -extra-deps: -- pandoc-types-1.17.3 -- hslua-0.9.3 -- hslua-module-text-0.1.2 -- skylighting-0.5 -- texmath-0.10 -- cmark-gfm-0.1.1 -- QuickCheck-2.10.0.1 -- tasty-quickcheck-0.9.1 -- hs-bibutils-6.2.0.1 -- doctemplates-0.2.1 -- pandoc-citeproc-0.12.1.1 -- haddock-library-1.4.3 -- tagsoup-0.14.2 -resolver: lts-9.14 +extra-deps: [] +resolver: lts-10.0 diff --git a/stack.yaml b/stack.yaml index 6cd42b23b..c8e1990d7 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,16 +5,5 @@ flags: old-locale: false network-uri: true packages: -extra-deps: -- pandoc-types-1.17.3 -- hslua-0.9.3 -- hslua-module-text-0.1.2 -- skylighting-0.5 -- texmath-0.10 -- cmark-gfm-0.1.1 -- QuickCheck-2.10.0.1 -- tasty-quickcheck-0.9.1 -- doctemplates-0.2.1 -- haddock-library-1.4.3 -- tagsoup-0.14.2 -resolver: lts-9.14 +extra-deps: [] +resolver: lts-10.0 diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index 4f14a834b..0e76249fe 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -91,6 +91,17 @@ tests = map (localOption (QuickCheckTests 20)) "attr-test.lua" (doc $ divWith ("", [], kv_before) (para "nil")) (doc $ divWith ("", [], kv_after) (para "nil")) + + , testCase "Test module pandoc.utils" $ + assertFilterConversion "pandoc.utils doesn't work as expected." + "test-pandoc-utils.lua" + (doc $ para "doesn't matter") + (doc $ mconcat [ plain (str "sha1: OK") + , plain (str "pipe: OK") + , plain (str "failing pipe: OK") + , plain (str "read: OK") + , plain (str "failing read: OK") + ]) ] assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index 41d1d9710..abd230c8c 100644 --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -455,6 +455,18 @@ tests = , "</quote>" ] =?> blockQuote (para "* Hi") + , "Headers consume anchors" =: + T.unlines [ "** Foo" + , "#bar" + ] =?> + headerWith ("bar",[],[]) 2 "Foo" + , "Headers don't consume anchors separated with a blankline" =: + T.unlines [ "** Foo" + , "" + , "#bar" + ] =?> + header 2 "Foo" <> + para (spanWith ("bar", [], []) mempty) ] , testGroup "Directives" [ "Title" =: @@ -505,6 +517,20 @@ tests = ] =?> para (text "Start recursion here" <> note (para "Recursion continues here[1]")) + , "No zero footnotes" =: + T.unlines [ "Here is a footnote[0]." + , "" + , "[0] Footnote contents" + ] =?> + para "Here is a footnote[0]." <> + para "[0] Footnote contents" + , "Footnotes can't start with zero" =: + T.unlines [ "Here is a footnote[01]." + , "" + , "[01] Footnote contents" + ] =?> + para "Here is a footnote[01]." <> + para "[01] Footnote contents" , testGroup "Multiparagraph footnotes" [ "Amusewiki multiparagraph footnotes" =: T.unlines [ "Multiparagraph[1] footnotes[2]" diff --git a/test/Tests/Writers/Muse.hs b/test/Tests/Writers/Muse.hs index 77e741534..e2e6ba06c 100644 --- a/test/Tests/Writers/Muse.hs +++ b/test/Tests/Writers/Muse.hs @@ -234,6 +234,11 @@ tests = [ testGroup "block elements" , "" , "*** Third level" ] + , "heading with ID" =: + headerWith ("bar", [], []) 2 (text "Foo") =?> + unlines [ "** Foo" + , "#bar" + ] ] , "horizontal rule" =: horizontalRule =?> "----" , "escape horizontal rule" =: para (text "----") =?> "<verbatim>----</verbatim>" diff --git a/test/command/4171.md b/test/command/4171.md index 3256d4673..42b4576e3 100644 --- a/test/command/4171.md +++ b/test/command/4171.md @@ -23,3 +23,12 @@ a [fn:1] b ``` + +Similar bug: "-" should not be wrapped: +``` +% pandoc -f org -t org +aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa - abc +^D +aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa - +abc +``` diff --git a/test/lua/test-pandoc-utils.lua b/test/lua/test-pandoc-utils.lua new file mode 100644 index 000000000..7354496f9 --- /dev/null +++ b/test/lua/test-pandoc-utils.lua @@ -0,0 +1,69 @@ +utils = require 'pandoc' + +-- SHA1 +------------------------------------------------------------------------ +function test_sha1 () + local ref_hash = '0a0a9f2a6772942557ab5355d76af442f8f65e01' + local hash = utils.sha1 'Hello, World!' + return hash == ref_hash +end + +-- Pipe +------------------------------------------------------------------------ +function file_exists (filename) + local fh = io.open(filename, 'r') + return fh ~= nil and (fh:close() or true) +end + +function warn (...) io.stderr:write(...) end + +function test_pipe () + if not file_exists('/bin/sed') then + warn 'Did not find /bin/sed, skipping test' + return true + end + local pipe_result = utils.pipe('/bin/sed', {'-e', 's/a/b/'}, 'abc') + return pipe_result == 'bbc' +end + +function test_failing_pipe () + if not file_exists('/bin/false') then + warn 'Did not find /bin/false, skipping test' + return true + end + local res, err = pcall(utils.pipe, '/bin/false', {}, 'abc') + return not res and + err.command == '/bin/false' and + err.error_code == 1 and + err.output == '' +end + +-- Read +------------------------------------------------------------------------ +function test_read () + local valid_markdown = '*Hello*, World!\n' + local res = pandoc.read(valid_markdown).blocks[1].content + return res[1].t == 'Emph' and res[3].t == 'Space' and res[4].t == 'Str' +end + +function test_failing_read () + local res, err = pcall(pandoc.read, 'foo', 'nosuchreader') + return not res and err:match 'Unknown reader: nosuchreader' +end + + +-- Return result +------------------------------------------------------------------------ +function run(fn) + return fn() and "OK" or "FAIL" +end + +function Para (el) + return { + pandoc.Plain{pandoc.Str("sha1: " .. run(test_sha1))}, + pandoc.Plain{pandoc.Str("pipe: " .. run(test_pipe))}, + pandoc.Plain{pandoc.Str("failing pipe: " .. run(test_failing_pipe))}, + pandoc.Plain{pandoc.Str("read: " .. run(test_read))}, + pandoc.Plain{pandoc.Str("failing read: " .. run(test_failing_read))}, + } +end diff --git a/test/tables.jats b/test/tables.jats index b213a83bb..46af61635 100644 --- a/test/tables.jats +++ b/test/tables.jats @@ -15,92 +15,60 @@ <thead> <tr> <th> - <p> - Right - </p> + Right </th> <th> - <p> - Left - </p> + Left </th> <th> - <p> - Center - </p> + Center </th> <th> - <p> - Default - </p> + Default </th> </tr> </thead> <tbody> <tr> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> </tr> <tr> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> </tr> <tr> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> </tr> </tbody> @@ -117,92 +85,60 @@ <thead> <tr> <th> - <p> - Right - </p> + Right </th> <th> - <p> - Left - </p> + Left </th> <th> - <p> - Center - </p> + Center </th> <th> - <p> - Default - </p> + Default </th> </tr> </thead> <tbody> <tr> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> </tr> <tr> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> </tr> <tr> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> </tr> </tbody> @@ -224,92 +160,60 @@ <thead> <tr> <th> - <p> - Right - </p> + Right </th> <th> - <p> - Left - </p> + Left </th> <th> - <p> - Center - </p> + Center </th> <th> - <p> - Default - </p> + Default </th> </tr> </thead> <tbody> <tr> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> </tr> <tr> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> </tr> <tr> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> </tr> </tbody> @@ -332,70 +236,46 @@ <thead> <tr> <th> - <p> - Centered Header - </p> + Centered Header </th> <th> - <p> - Left Aligned - </p> + Left Aligned </th> <th> - <p> - Right Aligned - </p> + Right Aligned </th> <th> - <p> - Default aligned - </p> + Default aligned </th> </tr> </thead> <tbody> <tr> <td> - <p> - First - </p> + First </td> <td> - <p> - row - </p> + row </td> <td> - <p> - 12.0 - </p> + 12.0 </td> <td> - <p> - Example of a row that spans multiple lines. - </p> + Example of a row that spans multiple lines. </td> </tr> <tr> <td> - <p> - Second - </p> + Second </td> <td> - <p> - row - </p> + row </td> <td> - <p> - 5.0 - </p> + 5.0 </td> <td> - <p> - Here’s another one. Note the blank line between rows. - </p> + Here’s another one. Note the blank line between rows. </td> </tr> </tbody> @@ -412,70 +292,46 @@ <thead> <tr> <th> - <p> - Centered Header - </p> + Centered Header </th> <th> - <p> - Left Aligned - </p> + Left Aligned </th> <th> - <p> - Right Aligned - </p> + Right Aligned </th> <th> - <p> - Default aligned - </p> + Default aligned </th> </tr> </thead> <tbody> <tr> <td> - <p> - First - </p> + First </td> <td> - <p> - row - </p> + row </td> <td> - <p> - 12.0 - </p> + 12.0 </td> <td> - <p> - Example of a row that spans multiple lines. - </p> + Example of a row that spans multiple lines. </td> </tr> <tr> <td> - <p> - Second - </p> + Second </td> <td> - <p> - row - </p> + row </td> <td> - <p> - 5.0 - </p> + 5.0 </td> <td> - <p> - Here’s another one. Note the blank line between rows. - </p> + Here’s another one. Note the blank line between rows. </td> </tr> </tbody> @@ -491,68 +347,44 @@ <tbody> <tr> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> <td> - <p> - 12 - </p> + 12 </td> </tr> <tr> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> <td> - <p> - 123 - </p> + 123 </td> </tr> <tr> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> <td> - <p> - 1 - </p> + 1 </td> </tr> </tbody> @@ -568,46 +400,30 @@ <tbody> <tr> <td> - <p> - First - </p> + First </td> <td> - <p> - row - </p> + row </td> <td> - <p> - 12.0 - </p> + 12.0 </td> <td> - <p> - Example of a row that spans multiple lines. - </p> + Example of a row that spans multiple lines. </td> </tr> <tr> <td> - <p> - Second - </p> + Second </td> <td> - <p> - row - </p> + row </td> <td> - <p> - 5.0 - </p> + 5.0 </td> <td> - <p> - Here’s another one. Note the blank line between rows. - </p> + Here’s another one. Note the blank line between rows. </td> </tr> </tbody> |