diff options
59 files changed, 689 insertions, 418 deletions
diff --git a/.travis.yml b/.travis.yml index 30395b8b2..37ea4fbb3 100644 --- a/.travis.yml +++ b/.travis.yml @@ -28,9 +28,6 @@ matrix: include: # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See: # https://github.com/hvr/multi-ghc-travis - - env: BUILD=cabal GHCVER=7.6.3 CABALVER=1.16 - compiler: ": #GHC 7.6.3" - addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}} - env: BUILD=cabal GHCVER=7.8.4 CABALVER=1.18 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 31d786214..97976fa09 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -132,7 +132,7 @@ Please follow these guidelines: 9. It is better not to introduce new dependencies. Dependencies on external C libraries should especially be avoided. -10. We aim for compatibility with ghc versions from 7.4.2 to the +10. We aim for compatibility with ghc versions from 7.8.3 to the latest release. All pull requests and commits are tested automatically on travis-ci.org, using GHC versions in the `Tested-With` stanza of `pandoc.cabal`. We currently relax @@ -8,6 +8,9 @@ There are also binary installers for Windows and Mac OS X. If you are installing the development version from github, see also: https://github.com/jgm/pandoc/wiki/Installing-the-development-version-of-pandoc +Please note that pandoc only supports [GHC] versions 7.8 and +above. The easiest way to get GHC is by installing the [Haskell platform] + How to get the source --------------------- diff --git a/MANUAL.txt b/MANUAL.txt index 2571b7ae0..749845416 100644 --- a/MANUAL.txt +++ b/MANUAL.txt @@ -960,6 +960,7 @@ Math rendering in HTML : Use [KaTeX] to display embedded TeX math in HTML output. The *URL* should point to the `katex.js` load script. If a *URL* is not provided, a link to the KaTeX CDN will be inserted. + Note: [KaTeX] seems to work best with `html5` output. `--katex-stylesheet=`*URL* @@ -3839,6 +3840,49 @@ To disable highlighting, use the `--no-highlight` option. [highlighting-kate]: https://github.com/jgm/highlighting-kate +Custom Styles in Docx Output +============================ + +By default, pandoc's docx output applies a predefined set of styles for +blocks such as paragraphs and block quotes, and uses largely default +formatting (italics, bold) for inlines. This will work for most +purposes, especially alongside a `reference.docx` file. However, if you +need to apply your own styles to blocks, or match a preexisting set of +styles, pandoc allows you to define custom styles for blocks and text +using `div`s and `span`s, respecitively. + +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, + + <span custom-style="Emphatically">Get out,</span> he said. + +would produce a docx file with "Get out," styled with character +style `Emphatically`. Similarly, + + Dickinson starts the poem simply: + + <div 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. + +If the styles are not yet in your reference.docx, they will be defined +in the output file as inheriting from normal text. If they are already +defined, pandoc will not alter the definition. + +This feature allows for greatest customization in conjunction with +[pandoc filters]. If you want all paragraphs after block quotes to be +indented, you can write a filter to apply the styles necessary. If you +want all italics to be transformed to the `Emphasis` character style +(perhaps to change their color), you can write a filter which will +transform all italicized inlines to inlines within an `Emphasis` +custom-style `span`. + +[pandoc filters]: http://pandoc.org/scripting.html + Custom writers ============== diff --git a/pandoc.cabal b/pandoc.cabal index 3565e4dd8..7b86304fc 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -11,7 +11,7 @@ Bug-Reports: https://github.com/jgm/pandoc/issues Stability: alpha Homepage: http://pandoc.org Category: Text -Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 +Tested-With: GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 Synopsis: Conversion between markup formats Description: Pandoc is a Haskell library for converting from one markup format to another, and a command-line tool that uses @@ -249,13 +249,13 @@ Flag old-locale Default: False Library - Build-Depends: base >= 4.2 && <5, + Build-Depends: base >= 4.7 && <5, syb >= 0.1 && < 0.7, containers >= 0.1 && < 0.6, unordered-containers >= 0.2 && < 0.3, array >= 0.3 && < 0.6, parsec >= 3.1 && < 3.2, - mtl >= 1.1 && < 2.3, + mtl >= 2.2 && < 2.3, filepath >= 1.1 && < 1.5, process >= 1 && < 1.5, directory >= 1 && < 1.3, @@ -268,7 +268,7 @@ Library random >= 1 && < 1.2, extensible-exceptions >= 0.1 && < 0.2, pandoc-types >= 1.16 && < 1.17, - aeson >= 0.7 && < 0.12, + aeson >= 0.7 && < 1.1, tagsoup >= 0.13.7 && < 0.15, base64-bytestring >= 0.1 && < 1.1, zlib >= 0.5 && < 0.7, @@ -401,6 +401,7 @@ Library Text.Pandoc.Readers.Org.Blocks, Text.Pandoc.Readers.Org.ExportSettings, Text.Pandoc.Readers.Org.Inlines, + Text.Pandoc.Readers.Org.Meta, Text.Pandoc.Readers.Org.ParserState, Text.Pandoc.Readers.Org.Parsing, Text.Pandoc.Readers.Org.Shared, @@ -414,10 +415,6 @@ Library Text.Pandoc.Slides, Text.Pandoc.Highlighting, Text.Pandoc.Compat.Time, - Text.Pandoc.Compat.Except, - Text.Pandoc.Compat.TagSoupEntity, - Text.Pandoc.Compat.Directory, - Text.Pandoc.Compat.Monoid, Paths_pandoc Buildable: True @@ -426,13 +423,13 @@ Executable pandoc Build-Depends: pandoc, pandoc-types >= 1.16 && < 1.17, base >= 4.2 && <5, - directory >= 1 && < 1.3, + directory >= 1.2 && < 1.3, filepath >= 1.1 && < 1.5, text >= 0.11 && < 1.3, bytestring >= 0.9 && < 0.11, extensible-exceptions >= 0.1 && < 0.2, highlighting-kate >= 0.6.2 && < 0.7, - aeson >= 0.7.0.5 && < 0.12, + aeson >= 0.7.0.5 && < 1.1, yaml >= 0.8.8.2 && < 0.9, containers >= 0.1 && < 0.6, HTTP >= 4000.0.5 && < 4000.4 @@ -939,10 +939,10 @@ usageMessage programName = usageInfo (programName ++ " [OPTIONS] [FILES]" ++ "\nInput formats: " ++ wrapWords 16 78 readers'names ++ '\n' : replicate 16 ' ' ++ - "[ *only Pandoc's JSON version of native AST]" ++ "\nOutput formats: " ++ + "[* only Pandoc's JSON version of native AST]" ++ "\nOutput formats: " ++ wrapWords 16 78 writers'names ++ '\n' : replicate 16 ' ' ++ - "[**for pdf output, use latex or beamer and -o FILENAME.pdf]\nOptions:") + "[** for pdf output, use latex or beamer and -o FILENAME.pdf]\nOptions:") where writers'names = sort $ "json*" : "pdf**" : delete "json" (map fst writers) readers'names = sort $ "json*" : delete "json" (map fst readers) diff --git a/prelude/Prelude.hs b/prelude/Prelude.hs index 50e86a7b9..34f133d83 100644 --- a/prelude/Prelude.hs +++ b/prelude/Prelude.hs @@ -19,12 +19,8 @@ where #if MIN_VERSION_base(4,8,0) import "base" Prelude as P -#elif MIN_VERSION_base(4,6,0) -import "base" Prelude as P -import Control.Applicative -import Data.Monoid #else -import "base" Prelude as P hiding (catch) +import "base" Prelude as P import Control.Applicative import Data.Monoid #endif diff --git a/src/Text/Pandoc/Compat/Directory.hs b/src/Text/Pandoc/Compat/Directory.hs deleted file mode 100644 index 61dd5c525..000000000 --- a/src/Text/Pandoc/Compat/Directory.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE CPP #-} -module Text.Pandoc.Compat.Directory ( getModificationTime ) - where - -#if MIN_VERSION_directory(1,2,0) -import System.Directory - - -#else -import qualified System.Directory as S -import Data.Time.Clock (UTCTime) -import Data.Time.Clock.POSIX -import System.Time - -getModificationTime :: FilePath -> IO UTCTime -getModificationTime fp = convert `fmap` S.getModificationTime fp - where - convert (TOD x _) = posixSecondsToUTCTime (realToFrac x) - -#endif - diff --git a/src/Text/Pandoc/Compat/Except.hs b/src/Text/Pandoc/Compat/Except.hs deleted file mode 100644 index 9ce7c0d36..000000000 --- a/src/Text/Pandoc/Compat/Except.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE CPP #-} -module Text.Pandoc.Compat.Except ( ExceptT - , Except - , Error(..) - , runExceptT - , runExcept - , MonadError - , throwError - , catchError ) - where - -#if MIN_VERSION_mtl(2,2,1) -import Control.Monad.Except - -class Error a where - noMsg :: a - strMsg :: String -> a - - noMsg = strMsg "" - strMsg _ = noMsg - -#else -import Control.Monad.Error -import Control.Monad.Identity (Identity, runIdentity) - -type ExceptT = ErrorT - -type Except s a = ErrorT s Identity a - -runExceptT :: ExceptT e m a -> m (Either e a) -runExceptT = runErrorT - -runExcept :: ExceptT e Identity a -> Either e a -runExcept = runIdentity . runExceptT -#endif - - diff --git a/src/Text/Pandoc/Compat/Monoid.hs b/src/Text/Pandoc/Compat/Monoid.hs deleted file mode 100644 index 4daceb8e1..000000000 --- a/src/Text/Pandoc/Compat/Monoid.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE CPP #-} -module Text.Pandoc.Compat.Monoid ( (<>) ) - where - -#if MIN_VERSION_base(4,5,0) -import Data.Monoid ((<>)) - -#else -import Data.Monoid - -infixr 6 <> - ---- | An infix synonym for 'mappend'. -(<>) :: Monoid m => m -> m -> m -(<>) = mappend -{-# INLINE (<>) #-} -#endif diff --git a/src/Text/Pandoc/Compat/TagSoupEntity.hs b/src/Text/Pandoc/Compat/TagSoupEntity.hs deleted file mode 100644 index 80985aef9..000000000 --- a/src/Text/Pandoc/Compat/TagSoupEntity.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE CPP #-} -module Text.Pandoc.Compat.TagSoupEntity (lookupEntity - ) where - -import qualified Text.HTML.TagSoup.Entity as TE - -lookupEntity :: String -> Maybe Char -#if MIN_VERSION_tagsoup(0,13,0) -lookupEntity = str2chr . TE.lookupEntity - where str2chr :: Maybe String -> Maybe Char - str2chr (Just [c]) = Just c - str2chr _ = Nothing -#else -lookupEntity = TE.lookupEntity -#endif diff --git a/src/Text/Pandoc/Compat/Time.hs b/src/Text/Pandoc/Compat/Time.hs index aa08ca224..b1cde82a4 100644 --- a/src/Text/Pandoc/Compat/Time.hs +++ b/src/Text/Pandoc/Compat/Time.hs @@ -1,4 +1,16 @@ {-# LANGUAGE CPP #-} + +{- +This compatibility module is needed because, in time 1.5, the +`defaultTimeLocale` function was moved from System.Locale (in the +old-locale library) into Data.Time. + +We support both behaviors because time 1.4 is a boot library for GHC +7.8. time 1.5 is a boot library for GHC 7.10. + +When support is dropped for GHC 7.8, this module may be obsoleted. +-} + #if MIN_VERSION_time(1,5,0) module Text.Pandoc.Compat.Time ( module Data.Time diff --git a/src/Text/Pandoc/Error.hs b/src/Text/Pandoc/Error.hs index 292396aee..5e26771fe 100644 --- a/src/Text/Pandoc/Error.hs +++ b/src/Text/Pandoc/Error.hs @@ -33,7 +33,6 @@ module Text.Pandoc.Error (PandocError(..), handleError) where import Text.Parsec.Error import Text.Parsec.Pos hiding (Line) -import Text.Pandoc.Compat.Except import GHC.Generics (Generic) import Data.Generics (Typeable) import Control.Exception (Exception) @@ -48,10 +47,6 @@ data PandocError = -- | Generic parse failure instance Exception PandocError -instance Error PandocError where - strMsg = ParseFailure - - -- | An unsafe method to handle `PandocError`s. handleError :: Either PandocError a -> a handleError (Right r) = r diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 90dfbb5fb..e46c91eda 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -59,8 +59,7 @@ import Numeric (showFFloat) import Text.Pandoc.Definition import Text.Pandoc.Options import qualified Data.Map as M -import Text.Pandoc.Compat.Except -import Control.Monad.Trans +import Control.Monad.Except import Data.Maybe (fromMaybe) -- quick and dirty functions to get image sizes diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs index 4dbe1f000..9faff1816 100644 --- a/src/Text/Pandoc/PDF.hs +++ b/src/Text/Pandoc/PDF.hs @@ -34,7 +34,7 @@ import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as BC import qualified Data.ByteString as BS -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import System.Exit (ExitCode (..)) import System.FilePath import System.IO (stderr, stdout) @@ -131,7 +131,8 @@ handleImage' opts tmpdir (Image attr ils (src,tit)) = do return $ Image attr ils (fname,tit) _ -> do warn $ "Could not find image `" ++ src ++ "', skipping..." - return $ Image attr ils (src,tit) + -- return alt text + return $ Emph ils handleImage' _ _ x = return x convertImages :: FilePath -> Inline -> IO Inline diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index f248b2514..e45e2247d 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -184,9 +184,9 @@ import Text.Pandoc.Shared import qualified Data.Map as M import Text.TeXMath.Readers.TeX.Macros (applyMacros, Macro, parseMacroDefinitions) -import Text.Pandoc.Compat.TagSoupEntity ( lookupEntity ) +import Text.HTML.TagSoup.Entity ( lookupEntity ) import Text.Pandoc.Asciify (toAsciiChar) -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import Data.Default import qualified Data.Set as Set import Control.Monad.Reader @@ -578,8 +578,8 @@ characterReference = try $ do '#':_ -> ent _ -> ent ++ ";" case lookupEntity ent' of - Just c -> return c - Nothing -> fail "entity not found" + Just (c : _) -> return c + _ -> fail "entity not found" -- | Parses an uppercase roman numeral and returns (UpperRoman, number). upperRoman :: Stream s m Char => ParserT s st m (ListNumberStyle, Int) diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs index e830a1e78..0bac628af 100644 --- a/src/Text/Pandoc/Pretty.hs +++ b/src/Text/Pandoc/Pretty.hs @@ -80,7 +80,7 @@ import Data.List (intercalate) import Data.String import Control.Monad.State import Data.Char (isSpace) -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) data RenderState a = RenderState{ output :: [a] -- ^ In reverse order @@ -126,18 +126,6 @@ isEmpty = null . toList . unDoc empty :: Doc empty = mempty -#if MIN_VERSION_base(4,5,0) --- (<>) is defined in Data.Monoid -#else -infixr 6 <> - --- | An infix synonym for 'mappend'. --- @a <> b@ is the result of concatenating @a@ with @b@. -(<>) :: Monoid m => m -> m -> m -(<>) = mappend -{-# INLINE (<>) #-} -#endif - -- | Concatenate a list of 'Doc's. cat :: [Doc] -> Doc cat = mconcat diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index e8fe92e27..336b40933 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -5,7 +5,7 @@ import Text.Pandoc.Options import Text.Pandoc.Definition import Text.Pandoc.Builder import Text.XML.Light -import Text.Pandoc.Compat.TagSoupEntity (lookupEntity) +import Text.HTML.TagSoup.Entity (lookupEntity) import Data.Either (rights) import Data.Generics import Data.Char (isSpace) @@ -14,7 +14,7 @@ import Data.List (intersperse) import Data.Maybe (fromMaybe) import Text.TeXMath (readMathML, writeTeX) import Text.Pandoc.Error (PandocError) -import Text.Pandoc.Compat.Except +import Control.Monad.Except import Data.Default import Data.Foldable (asum) @@ -564,7 +564,7 @@ normalizeTree = everywhere (mkT go) go xs = xs convertEntity :: String -> String -convertEntity e = maybe (map toUpper e) (:[]) (lookupEntity e) +convertEntity e = maybe (map toUpper e) id (lookupEntity e) -- convenience function to get an attribute value, defaulting to "" attrValue :: String -> Element -> String @@ -916,7 +916,7 @@ elementToStr x = x parseInline :: Content -> DB Inlines parseInline (Text (CData _ s _)) = return $ text s parseInline (CRef ref) = - return $ maybe (text $ map toUpper ref) (text . (:[])) $ lookupEntity ref + return $ maybe (text $ map toUpper ref) (text) $ lookupEntity ref parseInline (Elem e) = case qName (elName e) of "equation" -> equation displayMath diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 2bc17c069..fa534f801 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE PatternGuards, OverloadedStrings #-} +{-# LANGUAGE PatternGuards, OverloadedStrings, CPP #-} {- -Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu> +Copyright (C) 2014-2016 Jesse Rosenthal <jrosenthal@jhu.edu> 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 @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.Docx - Copyright : Copyright (C) 2014 Jesse Rosenthal + Copyright : Copyright (C) 2014-2016 Jesse Rosenthal License : GNU GPL, version 2 or above Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu> @@ -83,7 +83,7 @@ import Text.Pandoc.Readers.Docx.Lists import Text.Pandoc.Readers.Docx.Combine import Text.Pandoc.Shared import Text.Pandoc.MediaBag (insertMedia, MediaBag) -import Data.List (delete, (\\), intersect) +import Data.List (delete, intersect) import Text.TeXMath (writeTeX) import Data.Default (Default) import qualified Data.ByteString.Lazy as B @@ -93,9 +93,12 @@ import Control.Monad.Reader import Control.Monad.State import Data.Sequence (ViewL(..), viewl) import qualified Data.Sequence as Seq (null) +#if !(MIN_VERSION_base(4,8,0)) +import Data.Traversable (traverse) +#endif import Text.Pandoc.Error -import Text.Pandoc.Compat.Except +import Control.Monad.Except readDocxWithWarnings :: ReaderOptions -> B.ByteString @@ -412,39 +415,39 @@ parPartToInlines (PlainOMath exps) = do return $ math $ writeTeX exps isAnchorSpan :: Inline -> Bool -isAnchorSpan (Span (_, classes, kvs) ils) = +isAnchorSpan (Span (_, classes, kvs) _) = classes == ["anchor"] && - null kvs && - null ils + null kvs isAnchorSpan _ = False dummyAnchors :: [String] dummyAnchors = ["_GoBack"] makeHeaderAnchor :: Blocks -> DocxContext Blocks -makeHeaderAnchor bs = case viewl $ unMany bs of - (x :< xs) -> do - x' <- (makeHeaderAnchor' x) - xs' <- (makeHeaderAnchor $ Many xs) - return $ (singleton x') <> xs' - EmptyL -> return mempty +makeHeaderAnchor bs = traverse makeHeaderAnchor' bs makeHeaderAnchor' :: Block -> DocxContext Block -- If there is an anchor already there (an anchor span in the header, -- to be exact), we rename and associate the new id with the old one. -makeHeaderAnchor' (Header n (_, classes, kvs) ils) - | (c:cs) <- filter isAnchorSpan ils - , (Span (ident, ["anchor"], _) _) <- c = do +makeHeaderAnchor' (Header n (ident, classes, kvs) ils) + | (c:_) <- filter isAnchorSpan ils + , (Span (anchIdent, ["anchor"], _) cIls) <- c = do hdrIDMap <- gets docxAnchorMap - let newIdent = uniqueIdent ils (Set.fromList $ M.elems hdrIDMap) - modify $ \s -> s {docxAnchorMap = M.insert ident newIdent hdrIDMap} - return $ Header n (newIdent, classes, kvs) (ils \\ (c:cs)) + let newIdent = if null ident + then uniqueIdent ils (Set.fromList $ M.elems hdrIDMap) + else ident + newIls = concatMap f ils where f il | il == c = cIls + | otherwise = [il] + modify $ \s -> s {docxAnchorMap = M.insert anchIdent newIdent hdrIDMap} + makeHeaderAnchor' $ Header n (newIdent, classes, kvs) newIls -- Otherwise we just give it a name, and register that name (associate -- it with itself.) -makeHeaderAnchor' (Header n (_, classes, kvs) ils) = +makeHeaderAnchor' (Header n (ident, classes, kvs) ils) = do hdrIDMap <- gets docxAnchorMap - let newIdent = uniqueIdent ils (Set.fromList $ M.elems hdrIDMap) + let newIdent = if null ident + then uniqueIdent ils (Set.fromList $ M.elems hdrIDMap) + else ident modify $ \s -> s {docxAnchorMap = M.insert newIdent newIdent hdrIDMap} return $ Header n (newIdent, classes, kvs) ils makeHeaderAnchor' blk = return blk diff --git a/src/Text/Pandoc/Readers/Docx/Lists.hs b/src/Text/Pandoc/Readers/Docx/Lists.hs index c265ad074..395a53907 100644 --- a/src/Text/Pandoc/Readers/Docx/Lists.hs +++ b/src/Text/Pandoc/Readers/Docx/Lists.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu> +Copyright (C) 2014-2016 Jesse Rosenthal <jrosenthal@jhu.edu> 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 @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.Docx.Lists - Copyright : Copyright (C) 2014 Jesse Rosenthal + Copyright : Copyright (C) 2014-2016 Jesse Rosenthal License : GNU GPL, version 2 or above Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu> diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 9ae7f22ec..b9021ec08 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -1,7 +1,7 @@ {-# LANGUAGE PatternGuards, ViewPatterns, FlexibleInstances #-} {- -Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu> +Copyright (C) 2014-2016 Jesse Rosenthal <jrosenthal@jhu.edu> 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 @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.Docx.Parse - Copyright : Copyright (C) 2014 Jesse Rosenthal + Copyright : Copyright (C) 2014-2016 Jesse Rosenthal License : GNU GPL, version 2 or above Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu> @@ -64,7 +64,7 @@ import Control.Monad.Reader import Control.Monad.State import Control.Applicative ((<|>)) import qualified Data.Map as M -import Text.Pandoc.Compat.Except +import Control.Monad.Except import Text.Pandoc.Shared (safeRead) import Text.TeXMath.Readers.OMML (readOMML) import Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..)) @@ -91,9 +91,6 @@ data ReaderState = ReaderState { stateWarnings :: [String] } data DocxError = DocxError | WrongElem deriving Show -instance Error DocxError where - noMsg = WrongElem - type D = ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) runD :: D a -> ReaderEnv -> ReaderState -> (Either DocxError a, ReaderState) diff --git a/src/Text/Pandoc/Readers/Docx/StyleMap.hs b/src/Text/Pandoc/Readers/Docx/StyleMap.hs index 2901ea2a3..00906cf07 100644 --- a/src/Text/Pandoc/Readers/Docx/StyleMap.hs +++ b/src/Text/Pandoc/Readers/Docx/StyleMap.hs @@ -1,4 +1,6 @@ module Text.Pandoc.Readers.Docx.StyleMap ( StyleMaps(..) + , alterMap + , getMap , defaultStyleMaps , getStyleMaps , getStyleId diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index b8a0b47e7..e547b84cd 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -16,8 +16,7 @@ import Text.Pandoc.Options ( ReaderOptions(..), readerTrace) import Text.Pandoc.Shared (escapeURI, collapseFilePath, addMetaField) import Network.URI (unEscapeString) import Text.Pandoc.MediaBag (MediaBag, insertMedia) -import Text.Pandoc.Compat.Except (MonadError, throwError, runExcept, Except) -import Text.Pandoc.Compat.Monoid ((<>)) +import Control.Monad.Except (MonadError, throwError, runExcept, Except) import Text.Pandoc.MIME (MimeType) import qualified Text.Pandoc.Builder as B import Codec.Archive.Zip ( Archive (..), toArchiveOrFail, fromEntry @@ -31,6 +30,7 @@ import Control.Monad (guard, liftM, when) import Data.List (isPrefixOf, isInfixOf) import Data.Maybe (mapMaybe, fromMaybe) import qualified Data.Map as M (Map, lookup, fromList, elems) +import Data.Monoid ((<>)) import Control.DeepSeq (deepseq, NFData) import Debug.Trace (trace) diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 164e3a98f..8ce3fa379 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -66,7 +66,7 @@ import Control.Monad.Reader (Reader,ask, asks, local, runReader) import Network.URI (URI, parseURIReference, nonStrictRelativeTo) import Text.Pandoc.Error import Text.Pandoc.CSS (foldOrElse, pickStyleAttrProps) -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import Text.Parsec.Error import qualified Data.Set as Set diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index 99deac3c2..12953bb72 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -16,7 +16,7 @@ module Text.Pandoc.Readers.Haddock import Text.Pandoc.Builder (Blocks, Inlines) import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import Text.Pandoc.Shared (trim, splitBy) import Data.List (intersperse, stripPrefix) import Data.Maybe (fromMaybe) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index e43714526..9928500dc 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -64,7 +64,7 @@ import Text.HTML.TagSoup import qualified Data.Set as Set import Text.Printf (printf) import Debug.Trace (trace) -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import Text.Pandoc.Error type MarkdownParser = Parser [Char] ParserState diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index dcf0c5f4a..c625b8905 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -39,7 +39,7 @@ module Text.Pandoc.Readers.MediaWiki ( readMediaWiki ) where import Text.Pandoc.Definition import qualified Text.Pandoc.Builder as B import Text.Pandoc.Builder (Inlines, Blocks, trimInlines) -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import Text.Pandoc.Options import Text.Pandoc.Readers.HTML ( htmlTag, isBlockTag, isCommentTag ) import Text.Pandoc.XML ( fromEntities ) diff --git a/src/Text/Pandoc/Readers/OPML.hs b/src/Text/Pandoc/Readers/OPML.hs index b2e5f2e67..4dcf5e5a0 100644 --- a/src/Text/Pandoc/Readers/OPML.hs +++ b/src/Text/Pandoc/Readers/OPML.hs @@ -7,11 +7,11 @@ import Text.Pandoc.Builder import Text.Pandoc.Readers.HTML (readHtml) import Text.Pandoc.Readers.Markdown (readMarkdown) import Text.XML.Light -import Text.Pandoc.Compat.TagSoupEntity (lookupEntity) +import Text.HTML.TagSoup.Entity (lookupEntity) import Data.Generics import Control.Monad.State import Data.Default -import Text.Pandoc.Compat.Except +import Control.Monad.Except import Text.Pandoc.Error type OPML = ExceptT PandocError (State OPMLState) @@ -53,7 +53,7 @@ normalizeTree = everywhere (mkT go) go xs = xs convertEntity :: String -> String -convertEntity e = maybe (map toUpper e) (:[]) (lookupEntity e) +convertEntity e = maybe (map toUpper e) id (lookupEntity e) -- convenience function to get an attribute value, defaulting to "" attrValue :: String -> Element -> String diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs index 30f96c557..b056f1ecc 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs @@ -45,8 +45,8 @@ import Control.Arrow import Control.Monad import Data.Foldable +import Data.Monoid -import Text.Pandoc.Compat.Monoid import Text.Pandoc.Readers.Odt.Arrows.Utils import Text.Pandoc.Readers.Odt.Generic.Fallible diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs index fca2575c2..218a85661 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs @@ -43,10 +43,10 @@ import Control.Arrow import Control.Monad ( join, MonadPlus(..) ) import qualified Data.Foldable as F +import Data.Monoid import Text.Pandoc.Readers.Odt.Generic.Fallible import Text.Pandoc.Readers.Odt.Generic.Utils -import Text.Pandoc.Compat.Monoid and2 :: (Arrow a) => a b c -> a b c' -> a b (c,c') and2 = (&&&) diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs b/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs index d0fdc228f..877443543 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs @@ -41,8 +41,9 @@ module Text.Pandoc.Readers.Odt.Generic.Fallible where import Control.Applicative import Control.Monad -import Text.Pandoc.Compat.Monoid ((<>)) + import qualified Data.Foldable as F +import Data.Monoid ((<>)) -- | Default for now. Will probably become a class at some point. type Failure = () diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 6a8bb8b28..8961f73f1 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -34,8 +34,8 @@ module Text.Pandoc.Readers.Org.Blocks ) where import Text.Pandoc.Readers.Org.BlockStarts -import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings ) import Text.Pandoc.Readers.Org.Inlines +import Text.Pandoc.Readers.Org.Meta ( metaExport, metaLine ) import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing import Text.Pandoc.Readers.Org.Shared @@ -45,16 +45,14 @@ import Text.Pandoc.Readers.Org.Shared import qualified Text.Pandoc.Builder as B import Text.Pandoc.Builder ( Inlines, Blocks ) import Text.Pandoc.Definition -import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Options import Text.Pandoc.Shared ( compactify', compactify'DL ) import Control.Monad ( foldM, guard, mzero, void ) import Data.Char ( isSpace, toLower, toUpper) import Data.List ( foldl', intersperse, isPrefixOf ) -import qualified Data.Map as M import Data.Maybe ( fromMaybe, isNothing ) -import Network.HTTP ( urlEncode ) +import Data.Monoid ((<>)) -- -- Org headers @@ -82,6 +80,10 @@ newtype PropertyValue = PropertyValue { fromValue :: String } toPropertyValue :: String -> PropertyValue toPropertyValue = PropertyValue +-- | Check whether the property value is non-nil (i.e. truish). +isNonNil :: PropertyValue -> Bool +isNonNil p = map toLower (fromValue p) `notElem` ["()", "{}", "nil"] + -- | Key/value pairs from a PROPERTIES drawer type Properties = [(PropertyKey, PropertyValue)] @@ -202,12 +204,16 @@ propertiesToAttr properties = toStringPair prop = (fromKey (fst prop), fromValue (snd prop)) customIdKey = toPropertyKey "custom_id" classKey = toPropertyKey "class" + unnumberedKey = toPropertyKey "unnumbered" + specialProperties = [customIdKey, classKey, unnumberedKey] id' = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties cls = fromMaybe mempty . fmap fromValue . lookup classKey $ properties - kvs' = map toStringPair . filter ((`notElem` [customIdKey, classKey]) . fst) + kvs' = map toStringPair . filter ((`notElem` specialProperties) . fst) $ properties + isUnnumbered = + fromMaybe False . fmap isNonNil . lookup unnumberedKey $ properties in - (id', words cls, kvs') + (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs') tagTitle :: Inlines -> [Tag] -> Inlines tagTitle title tags = title <> (mconcat $ map tagToInline tags) @@ -232,8 +238,8 @@ blockList = do -- | Get the meta information safed in the state. meta :: OrgParser Meta meta = do - st <- getState - return $ runF (orgStateMeta st) st + meta' <- metaExport + runF meta' <$> getState blocks :: OrgParser (F Blocks) blocks = mconcat <$> manyTill block (void (lookAhead headerStart) <|> eof) @@ -631,67 +637,9 @@ exampleCode = B.codeBlockWith ("", ["example"], []) specialLine :: OrgParser (F Blocks) specialLine = fmap return . try $ metaLine <|> commentLine --- The order, in which blocks are tried, makes sure that we're not looking at --- the beginning of a block, so we don't need to check for it -metaLine :: OrgParser Blocks -metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine) - commentLine :: OrgParser Blocks commentLine = commentLineStart *> anyLine *> pure mempty -declarationLine :: OrgParser () -declarationLine = try $ do - key <- metaKey - value <- metaInlines - updateState $ \st -> - let meta' = B.setMeta key <$> value <*> pure nullMeta - in st { orgStateMeta = orgStateMeta st <> meta' } - -metaInlines :: OrgParser (F MetaValue) -metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline - -metaKey :: OrgParser String -metaKey = map toLower <$> many1 (noneOf ": \n\r") - <* char ':' - <* skipSpaces - -optionLine :: OrgParser () -optionLine = try $ do - key <- metaKey - case key of - "link" -> parseLinkFormat >>= uncurry addLinkFormat - "options" -> exportSettings - _ -> mzero - -addLinkFormat :: String - -> (String -> String) - -> OrgParser () -addLinkFormat key formatter = updateState $ \s -> - let fs = orgStateLinkFormatters s - in s{ orgStateLinkFormatters = M.insert key formatter fs } - -parseLinkFormat :: OrgParser ((String, String -> String)) -parseLinkFormat = try $ do - linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces - linkSubst <- parseFormat - return (linkType, linkSubst) - --- | An ad-hoc, single-argument-only implementation of a printf-style format --- parser. -parseFormat :: OrgParser (String -> String) -parseFormat = try $ do - replacePlain <|> replaceUrl <|> justAppend - where - -- inefficient, but who cares - replacePlain = try $ (\x -> concat . flip intersperse x) - <$> sequence [tillSpecifier 's', rest] - replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode) - <$> sequence [tillSpecifier 'h', rest] - justAppend = try $ (++) <$> rest - - rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r") - tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:"")) - -- -- Tables @@ -868,9 +816,6 @@ paraOrPlain = try $ do *> return (B.para <$> ils)) <|> (return (B.plain <$> ils)) -inlinesTillNewline :: OrgParser (F Inlines) -inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline - -- -- list blocks diff --git a/src/Text/Pandoc/Readers/Org/ExportSettings.hs b/src/Text/Pandoc/Readers/Org/ExportSettings.hs index b48acc9c4..283cfa998 100644 --- a/src/Text/Pandoc/Readers/Org/ExportSettings.hs +++ b/src/Text/Pandoc/Readers/Org/ExportSettings.hs @@ -54,13 +54,15 @@ exportSetting = choice , ignoredSetting "<" , ignoredSetting "\\n" , archivedTreeSetting "arch" (\val es -> es { exportArchivedTrees = val }) - , ignoredSetting "author" + , booleanSetting "author" (\val es -> es { exportWithAuthor = val }) , ignoredSetting "c" - , ignoredSetting "creator" + -- org-mode allows the special value `comment` for creator, which we'll + -- interpret as true as it doesn't make sense in the context of Pandoc. + , booleanSetting "creator" (\val es -> es { exportWithCreator = val }) , complementableListSetting "d" (\val es -> es { exportDrawers = val }) , ignoredSetting "date" , ignoredSetting "e" - , ignoredSetting "email" + , booleanSetting "email" (\val es -> es { exportWithEmail = val }) , ignoredSetting "f" , integerSetting "H" (\val es -> es { exportHeadlineLevels = val }) , ignoredSetting "inline" diff --git a/src/Text/Pandoc/Readers/Org/Inlines.hs b/src/Text/Pandoc/Readers/Org/Inlines.hs index 31f098d27..14e77dda9 100644 --- a/src/Text/Pandoc/Readers/Org/Inlines.hs +++ b/src/Text/Pandoc/Readers/Org/Inlines.hs @@ -43,7 +43,6 @@ import Text.Pandoc.Readers.Org.Shared import qualified Text.Pandoc.Builder as B import Text.Pandoc.Builder ( Inlines ) import Text.Pandoc.Definition -import Text.Pandoc.Compat.Monoid ( (<>) ) import Text.Pandoc.Options import Text.Pandoc.Readers.LaTeX ( inlineCommand, rawLaTeXInline ) import Text.TeXMath ( readTeX, writePandoc, DisplayType(..) ) @@ -55,6 +54,7 @@ import Data.Char ( isAlphaNum, isSpace ) import Data.List ( intersperse ) import Data.Maybe ( fromMaybe ) import qualified Data.Map as M +import Data.Monoid ( (<>) ) import Data.Traversable (sequence) -- diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs new file mode 100644 index 000000000..ea088bfdb --- /dev/null +++ b/src/Text/Pandoc/Readers/Org/Meta.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TupleSections #-} +{- +Copyright (C) 2014-2016 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.Readers.Org.Meta + Copyright : Copyright (C) 2014-2016 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + +Parsers for Org-mode meta declarations. +-} +module Text.Pandoc.Readers.Org.Meta + ( metaLine + , metaExport + ) where + +import Text.Pandoc.Readers.Org.BlockStarts +import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings ) +import Text.Pandoc.Readers.Org.Inlines +import Text.Pandoc.Readers.Org.ParserState +import Text.Pandoc.Readers.Org.Parsing + +import qualified Text.Pandoc.Builder as B +import Text.Pandoc.Builder ( Blocks, Inlines ) +import Text.Pandoc.Definition + +import Control.Monad ( mzero ) +import Data.Char ( toLower ) +import Data.List ( intersperse ) +import qualified Data.Map as M +import Data.Monoid ((<>)) +import Network.HTTP ( urlEncode ) + +-- | Returns the current meta, respecting export options. +metaExport :: OrgParser (F Meta) +metaExport = do + st <- getState + let settings = orgStateExportSettings st + return $ (if exportWithAuthor settings then id else removeMeta "author") + . (if exportWithCreator settings then id else removeMeta "creator") + . (if exportWithEmail settings then id else removeMeta "email") + <$> orgStateMeta st + +removeMeta :: String -> Meta -> Meta +removeMeta key meta' = + let metaMap = unMeta meta' + in Meta $ M.delete key metaMap + +-- | Parse and handle a single line containing meta information +-- The order, in which blocks are tried, makes sure that we're not looking at +-- the beginning of a block, so we don't need to check for it +metaLine :: OrgParser Blocks +metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine) + +declarationLine :: OrgParser () +declarationLine = try $ do + key <- map toLower <$> metaKey + (key', value) <- metaValue key + updateState $ \st -> + let meta' = B.setMeta key' <$> value <*> pure nullMeta + in st { orgStateMeta = meta' <> orgStateMeta st } + +metaKey :: OrgParser String +metaKey = map toLower <$> many1 (noneOf ": \n\r") + <* char ':' + <* skipSpaces + +metaValue :: String -> OrgParser (String, (F MetaValue)) +metaValue key = + let inclKey = "header-includes" + in case key of + "author" -> (key,) <$> metaInlinesCommaSeparated + "title" -> (key,) <$> metaInlines + "date" -> (key,) <$> metaInlines + "header-includes" -> (key,) <$> accumulatingList key metaInlines + "latex_header" -> (inclKey,) <$> + accumulatingList inclKey (metaExportSnippet "latex") + "latex_class" -> ("documentclass",) <$> metaString + -- Org-mode expects class options to contain the surrounding brackets, + -- pandoc does not. + "latex_class_options" -> ("classoption",) <$> + metaModifiedString (filter (`notElem` "[]")) + "html_head" -> (inclKey,) <$> + accumulatingList inclKey (metaExportSnippet "html") + _ -> (key,) <$> metaString + +metaInlines :: OrgParser (F MetaValue) +metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline + +metaInlinesCommaSeparated :: OrgParser (F MetaValue) +metaInlinesCommaSeparated = do + authStrs <- (many1 (noneOf ",\n")) `sepBy1` (char ',') + newline + authors <- mapM (parseFromString inlinesTillNewline . (++ "\n")) authStrs + let toMetaInlines = MetaInlines . B.toList + return $ MetaList . map toMetaInlines <$> sequence authors + +metaString :: OrgParser (F MetaValue) +metaString = metaModifiedString id + +metaModifiedString :: (String -> String) -> OrgParser (F MetaValue) +metaModifiedString f = return . MetaString . f <$> anyLine + +-- | Read an format specific meta definition +metaExportSnippet :: String -> OrgParser (F MetaValue) +metaExportSnippet format = + return . MetaInlines . B.toList . B.rawInline format <$> anyLine + +-- | Accumulate the result of the @parser@ in a list under @key@. +accumulatingList :: String + -> OrgParser (F MetaValue) + -> OrgParser (F MetaValue) +accumulatingList key p = do + value <- p + meta' <- orgStateMeta <$> getState + return $ (\m v -> MetaList (curList m ++ [v])) <$> meta' <*> value + where curList m = case lookupMeta key m of + Just (MetaList ms) -> ms + Just x -> [x] + _ -> [] + +-- +-- export options +-- +optionLine :: OrgParser () +optionLine = try $ do + key <- metaKey + case key of + "link" -> parseLinkFormat >>= uncurry addLinkFormat + "options" -> exportSettings + _ -> mzero + +addLinkFormat :: String + -> (String -> String) + -> OrgParser () +addLinkFormat key formatter = updateState $ \s -> + let fs = orgStateLinkFormatters s + in s{ orgStateLinkFormatters = M.insert key formatter fs } + +parseLinkFormat :: OrgParser ((String, String -> String)) +parseLinkFormat = try $ do + linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces + linkSubst <- parseFormat + return (linkType, linkSubst) + +-- | An ad-hoc, single-argument-only implementation of a printf-style format +-- parser. +parseFormat :: OrgParser (String -> String) +parseFormat = try $ do + replacePlain <|> replaceUrl <|> justAppend + where + -- inefficient, but who cares + replacePlain = try $ (\x -> concat . flip intersperse x) + <$> sequence [tillSpecifier 's', rest] + replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode) + <$> sequence [tillSpecifier 'h', rest] + justAppend = try $ (++) <$> rest + + rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r") + tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:"")) + +inlinesTillNewline :: OrgParser (F Inlines) +inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 48e7717cd..84dbe9d33 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -163,6 +163,9 @@ data ExportSettings = ExportSettings , exportSmartQuotes :: Bool -- ^ Parse quotes smartly , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts + , exportWithAuthor :: Bool -- ^ Include author in final meta-data + , exportWithCreator :: Bool -- ^ Include creator in final meta-data + , exportWithEmail :: Bool -- ^ Include email in final meta-data } instance Default ExportSettings where @@ -177,6 +180,9 @@ defaultExportSettings = ExportSettings , exportSmartQuotes = True , exportSpecialStrings = True , exportSubSuperscripts = True + , exportWithAuthor = True + , exportWithCreator = True + , exportWithEmail = True } diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 46f082ccd..f181d523a 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -48,7 +48,7 @@ import Text.Pandoc.Builder (Inlines, Blocks, trimInlines) import qualified Text.Pandoc.Builder as B import Data.Sequence (viewr, ViewR(..)) import Data.Char (toLower, isHexDigit, isSpace) -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import Text.Pandoc.Error -- | Parse reStructuredText string and return Pandoc document. diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index a4de85dfb..8dbbf7be2 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -65,7 +65,7 @@ import Text.HTML.TagSoup.Match import Data.List ( intercalate, transpose, intersperse ) import Data.Char ( digitToInt, isUpper ) import Control.Monad ( guard, liftM, when ) -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import Text.Printf import Debug.Trace (trace) import Text.Pandoc.Error diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 277d747d6..0aafc83c7 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -34,7 +34,7 @@ module Text.Pandoc.Readers.Txt2Tags ( readTxt2Tags import qualified Text.Pandoc.Builder as B import Text.Pandoc.Builder ( Inlines, Blocks, trimInlines ) -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared (escapeURI,compactify', compactify'DL) @@ -49,7 +49,7 @@ import Control.Monad.Reader (Reader, runReader, asks) import Text.Pandoc.Error import Data.Time.LocalTime (getZonedTime) -import Text.Pandoc.Compat.Directory(getModificationTime) +import System.Directory(getModificationTime) import Data.Time.Format (formatTime) import Text.Pandoc.Compat.Time (defaultTimeLocale) import System.IO.Error (catchIOError) diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index bd299a802..04752a194 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -132,7 +132,7 @@ import System.IO (stderr) import System.IO.Temp import Text.HTML.TagSoup (renderTagsOptions, RenderOptions(..), Tag(..), renderOptions) -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import Data.ByteString.Base64 (decodeLenient) @@ -152,16 +152,7 @@ import Paths_pandoc (getDataFileName) #ifdef HTTP_CLIENT import Network.HTTP.Client (httpLbs, responseBody, responseHeaders, Request(port,host)) -#if MIN_VERSION_http_client(0,4,30) -import Network.HTTP.Client (parseRequest) -#else -import Network.HTTP.Client (parseUrl) -#endif -#if MIN_VERSION_http_client(0,4,18) -import Network.HTTP.Client (newManager) -#else -import Network.HTTP.Client (withManager) -#endif +import Network.HTTP.Client (parseRequest, newManager) import Network.HTTP.Client.Internal (addProxy) import Network.HTTP.Client.TLS (tlsManagerSettings) import System.Environment (getEnv) diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index 925925872..d111b3efa 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP, +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings, GeneralizedNewtypeDeriving #-} {- Copyright (C) 2009-2016 John MacFarlane <jgm@berkeley.edu> @@ -98,7 +98,7 @@ import Control.Monad (guard, when) import Data.Aeson (ToJSON(..), Value(..)) import qualified Text.Parsec as P import Text.Parsec.Text (Parser) -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import qualified Data.Text as T import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) @@ -108,12 +108,8 @@ import qualified Data.Map as M import qualified Data.HashMap.Strict as H import Data.Foldable (toList) import qualified Control.Exception.Extensible as E (try, IOException) -#if MIN_VERSION_blaze_html(0,5,0) import Text.Blaze.Html (Html) import Text.Blaze.Internal (preEscapedText) -#else -import Text.Blaze (preEscapedText, Html) -#endif import Data.ByteString.Lazy (ByteString, fromChunks) import Text.Pandoc.Shared (readDataFileUTF8, ordNub) import Data.Vector ((!?)) diff --git a/src/Text/Pandoc/UTF8.hs b/src/Text/Pandoc/UTF8.hs index 87ed5312b..62a662029 100644 --- a/src/Text/Pandoc/UTF8.hs +++ b/src/Text/Pandoc/UTF8.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {- Copyright (C) 2010-2016 John MacFarlane <jgm@berkeley.edu> @@ -116,11 +115,7 @@ fromStringLazy :: String -> BL.ByteString fromStringLazy = TL.encodeUtf8 . TL.pack encodePath :: FilePath -> FilePath -decodeArg :: String -> String -#if MIN_VERSION_base(4,4,0) encodePath = id + +decodeArg :: String -> String decodeArg = id -#else -encodePath = B.unpack . fromString -decodeArg = toString . B.pack -#endif diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 9b1c70166..8bb0810e4 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -176,7 +176,11 @@ blockToDocbook opts (Div (ident,_,_) [Para lst]) = then flush $ nowrap $ inTags False "literallayout" attribs $ inlinesToDocbook opts lst else inTags True "para" attribs $ inlinesToDocbook opts lst -blockToDocbook opts (Div _ bs) = blocksToDocbook opts $ map plainToPara bs +blockToDocbook opts (Div (ident,_,_) bs) = + (if null ident + then mempty + else selfClosingTag "anchor" [("id", ident)]) $$ + blocksToDocbook opts (map plainToPara bs) blockToDocbook _ (Header _ _ _) = empty -- should not occur after hierarchicalize blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst -- title beginning with fig: indicates that the image is a figure @@ -313,7 +317,10 @@ inlineToDocbook opts (Quoted _ lst) = inTagsSimple "quote" $ inlinesToDocbook opts lst inlineToDocbook opts (Cite _ lst) = inlinesToDocbook opts lst -inlineToDocbook opts (Span _ ils) = +inlineToDocbook opts (Span (ident,_,_) ils) = + (if null ident + then mempty + else selfClosingTag "anchor" [("id", ident)]) <> inlinesToDocbook opts ils inlineToDocbook _ (Code _ str) = inTagsSimple "literal" $ text (escapeStringForXML str) diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index c3d1351e2..d31928b01 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -60,12 +60,12 @@ import Data.Unique (hashUnique, newUnique) import System.Random (randomRIO) import Text.Printf (printf) import qualified Control.Exception as E -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef, extensionFromMimeType) import Control.Applicative ((<|>)) -import Data.Maybe (fromMaybe, mapMaybe, maybeToList) -import Data.Char (ord) +import Data.Maybe (fromMaybe, mapMaybe, maybeToList, isNothing) +import Data.Char (ord, isSpace, toLower) data ListMarker = NoMarker | BulletMarker @@ -110,6 +110,8 @@ data WriterState = WriterState{ , stStyleMaps :: StyleMaps , stFirstPara :: Bool , stTocTitle :: [Inline] + , stDynamicParaProps :: [String] + , stDynamicTextProps :: [String] } defaultWriterState :: WriterState @@ -132,6 +134,8 @@ defaultWriterState = WriterState{ , stStyleMaps = defaultStyleMaps , stFirstPara = False , stTocTitle = normalizeInlines [Str "Table of Contents"] + , stDynamicParaProps = [] + , stDynamicTextProps = [] } type WS a = StateT WriterState IO a @@ -404,7 +408,21 @@ writeDocx opts doc@(Pandoc meta _) = do linkrels -- styles - let newstyles = styleToOpenXml styleMaps $ writerHighlightStyle opts + + -- We only want to inject paragraph and text properties that + -- are not already in the style map. Note that keys in the stylemap + -- are normalized as lowercase. + let newDynamicParaProps = filter + (\sty -> isNothing $ M.lookup (toLower <$> sty) $ getMap $ sParaStyleMap styleMaps) + (stDynamicParaProps st) + + newDynamicTextProps = filter + (\sty -> isNothing $ M.lookup (toLower <$> sty) $ getMap $ sCharStyleMap styleMaps) + (stDynamicTextProps st) + + let newstyles = map newParaPropToOpenXml newDynamicParaProps ++ + map newTextPropToOpenXml newDynamicTextProps ++ + (styleToOpenXml styleMaps $ writerHighlightStyle opts) let styledoc' = styledoc{ elContent = modifyContent (elContent styledoc) } where modifyContent @@ -499,6 +517,28 @@ writeDocx opts doc@(Pandoc meta _) = do miscRelEntries ++ otherMediaEntries return $ fromArchive archive + +newParaPropToOpenXml :: String -> Element +newParaPropToOpenXml s = + let styleId = filter (not . isSpace) s + in mknode "w:style" [ ("w:type", "paragraph") + , ("w:customStyle", "1") + , ("w:styleId", styleId)] + [ mknode "w:name" [("w:val", s)] () + , mknode "w:basedOn" [("w:val","BodyText")] () + , mknode "w:qFormat" [] () + ] + +newTextPropToOpenXml :: String -> Element +newTextPropToOpenXml s = + let styleId = filter (not . isSpace) s + in mknode "w:style" [ ("w:type", "character") + , ("w:customStyle", "1") + , ("w:styleId", styleId)] + [ mknode "w:name" [("w:val", s)] () + , mknode "w:basedOn" [("w:val","BodyTextChar")] () + ] + styleToOpenXml :: StyleMaps -> Style -> [Element] styleToOpenXml sm style = maybeToList parStyle ++ mapMaybe toStyle alltoktypes @@ -722,9 +762,17 @@ getUniqueId :: MonadIO m => m String -- already in word/document.xml.rel getUniqueId = liftIO $ (show . (+ 20) . hashUnique) `fmap` newUnique +-- | Key for specifying user-defined docx styles. +dynamicStyleKey :: String +dynamicStyleKey = "custom-style" + -- | Convert a Pandoc block element to OpenXML. blockToOpenXML :: WriterOptions -> Block -> WS [Element] blockToOpenXML _ Null = return [] +blockToOpenXML opts (Div (_,_,kvs) bs) + | Just sty <- lookup dynamicStyleKey kvs = do + modify $ \s -> s{stDynamicParaProps = sty : (stDynamicParaProps s)} + withParaPropM (pStyleM sty) $ blocksToOpenXML opts bs blockToOpenXML opts (Div (_,["references"],_) bs) = do let (hs, bs') = span isHeaderBlock bs header <- blocksToOpenXML opts hs @@ -981,7 +1029,12 @@ inlineToOpenXML :: WriterOptions -> Inline -> WS [Element] inlineToOpenXML _ (Str str) = formattedString str inlineToOpenXML opts Space = inlineToOpenXML opts (Str " ") inlineToOpenXML opts SoftBreak = inlineToOpenXML opts (Str " ") -inlineToOpenXML opts (Span (_,classes,kvs) ils) +inlineToOpenXML opts (Span (ident,classes,kvs) ils) + | Just sty <- lookup dynamicStyleKey kvs = do + let kvs' = filter ((dynamicStyleKey, sty)/=) kvs + modify $ \s -> s{stDynamicTextProps = sty : (stDynamicTextProps s)} + withTextProp (rCustomStyle sty) $ + inlineToOpenXML opts (Span (ident,classes,kvs') ils) | "insertion" `elem` classes = do defaultAuthor <- gets stChangesAuthor defaultDate <- gets stChangesDate diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 433e28bf2..db8c301ef 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -31,7 +31,7 @@ Conversion of 'Pandoc' documents to HTML. -} module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where import Text.Pandoc.Definition -import Text.Pandoc.Compat.Monoid ((<>)) +import Data.Monoid ((<>)) import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared import Text.Pandoc.Options diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 29e8c962c..600685427 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -276,6 +276,7 @@ stringToLaTeX ctx (x:xs) = do '€' -> "\\euro{}" ++ rest '{' -> "\\{" ++ rest '}' -> "\\}" ++ rest + '`' | ctx == CodeString -> "{`}" ++ rest '$' | not isUrl -> "\\$" ++ rest '%' -> "\\%" ++ rest '&' -> "\\&" ++ rest @@ -296,6 +297,7 @@ stringToLaTeX ctx (x:xs) = do ']' -> "{]}" ++ rest -- optional arguments '\'' | ctx == CodeString -> "\\textquotesingle{}" ++ rest '\160' -> "~" ++ rest + '\x202F' -> "\\," ++ rest '\x2026' -> "\\ldots{}" ++ rest '\x2018' | ligatures -> "`" ++ rest '\x2019' | ligatures -> "'" ++ rest diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 5c7d760ac..caf26d515 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -41,7 +41,6 @@ import Data.Maybe (fromMaybe) import Text.Pandoc.Pretty import Text.Pandoc.Builder (deleteMeta) import Control.Monad.State -import Data.Char ( isDigit ) type Notes = [[Block]] data WriterState = WriterState { stNotes :: Notes @@ -62,10 +61,11 @@ pandocToMan opts (Pandoc meta blocks) = do let title' = render' titleText let setFieldsFromTitle = case break (== ' ') title' of - (cmdName, rest) -> case reverse cmdName of - (')':d:'(':xs) | isDigit d -> - defField "title" (reverse xs) . - defField "section" [d] . + (cmdName, rest) -> case break (=='(') cmdName of + (xs, '(':ys) | not (null ys) && + last ys == ')' -> + defField "title" xs . + defField "section" (init ys) . case splitBy (=='|') rest of (ft:hds) -> defField "footer" (trim ft) . diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index e903e9e42..96baacbb6 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -39,8 +39,8 @@ import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared import Text.Pandoc.Pretty import Text.Pandoc.Templates (renderTemplate') -import Data.Char ( toLower ) -import Data.List ( intersect, intersperse, partition, transpose ) +import Data.Char ( isAlphaNum, toLower ) +import Data.List ( isPrefixOf, intersect, intersperse, partition, transpose ) import Control.Monad.State data WriterState = @@ -158,10 +158,9 @@ blockToOrg (Plain inlines) = inlineListToOrg inlines blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return empty - else (\c -> "#+CAPTION: " <> c <> blankline) `fmap` - inlineListToOrg txt + else ("#+CAPTION: " <>) `fmap` inlineListToOrg txt img <- inlineToOrg (Image attr txt (src,tit)) - return $ capt <> img + return $ capt $$ img $$ blankline blockToOrg (Para inlines) = do contents <- inlineListToOrg inlines return $ contents <> blankline @@ -182,11 +181,7 @@ blockToOrg (Header level attr inlines) = do blockToOrg (CodeBlock (_,classes,_) str) = do opts <- stOptions <$> get let tabstop = writerTabStop opts - let at = classes `intersect` ["asymptote", "C", "clojure", "css", "ditaa", - "dot", "emacs-lisp", "gnuplot", "haskell", "js", "latex", - "ledger", "lisp", "matlab", "mscgen", "ocaml", "octave", - "oz", "perl", "plantuml", "python", "R", "ruby", "sass", - "scheme", "screen", "sh", "sql", "sqlite"] + let at = map pandocLangToOrg classes `intersect` orgLangIdentifiers let (beg, end) = case at of [] -> ("#+BEGIN_EXAMPLE", "#+END_EXAMPLE") (x:_) -> ("#+BEGIN_SRC " ++ x, "#+END_SRC") @@ -355,16 +350,56 @@ inlineToOrg (Link _ txt (src, _)) = do case txt of [Str x] | escapeURI x == src -> -- autolink do modify $ \s -> s{ stLinks = True } - return $ "[[" <> text x <> "]]" + return $ "[[" <> text (orgPath x) <> "]]" _ -> do contents <- inlineListToOrg txt modify $ \s -> s{ stLinks = True } - return $ "[[" <> text src <> "][" <> contents <> "]]" + return $ "[[" <> text (orgPath src) <> "][" <> contents <> "]]" inlineToOrg (Image _ _ (source, _)) = do modify $ \s -> s{ stImages = True } - return $ "[[" <> text source <> "]]" + return $ "[[" <> text (orgPath source) <> "]]" inlineToOrg (Note contents) = do -- add to notes in state notes <- get >>= (return . stNotes) modify $ \st -> st { stNotes = contents:notes } let ref = show $ (length notes) + 1 return $ " [" <> text ref <> "]" + +orgPath :: String -> String +orgPath src = + case src of + [] -> mempty -- wiki link + ('#':xs) -> xs -- internal link + _ | isUrl src -> src + _ | isFilePath src -> src + _ -> "file:" <> src + where + isFilePath :: String -> Bool + isFilePath cs = any (`isPrefixOf` cs) ["/", "./", "../", "file:"] + + isUrl :: String -> Bool + isUrl cs = + let (scheme, path) = break (== ':') cs + in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme + && not (null path) + +-- | Translate from pandoc's programming language identifiers to those used by +-- org-mode. +pandocLangToOrg :: String -> String +pandocLangToOrg cs = + case cs of + "c" -> "C" + "cpp" -> "C++" + "commonlisp" -> "lisp" + "r" -> "R" + "bash" -> "sh" + _ -> cs + +-- | List of language identifiers recognized by org-mode. +orgLangIdentifiers :: [String] +orgLangIdentifiers = + [ "asymptote", "awk", "C", "C++", "clojure", "css", "d", "ditaa", "dot" + , "calc", "emacs-lisp", "fortran", "gnuplot", "haskell", "java", "js" + , "latex", "ledger", "lisp", "lilypond", "matlab", "mscgen", "ocaml" + , "octave", "org", "oz", "perl", "plantuml", "processing", "python", "R" + , "ruby", "sass", "scheme", "screen", "sed", "sh", "sql", "sqlite" + ] diff --git a/src/Text/Pandoc/XML.hs b/src/Text/Pandoc/XML.hs index 4cc2141b4..e105aee91 100644 --- a/src/Text/Pandoc/XML.hs +++ b/src/Text/Pandoc/XML.hs @@ -38,7 +38,7 @@ module Text.Pandoc.XML ( escapeCharForXML, import Text.Pandoc.Pretty import Data.Char (ord, isAscii, isSpace) -import Text.Pandoc.Compat.TagSoupEntity (lookupEntity) +import Text.HTML.TagSoup.Entity (lookupEntity) -- | Escape one character as needed for XML. escapeCharForXML :: Char -> String @@ -101,7 +101,7 @@ toEntities (c:cs) fromEntities :: String -> String fromEntities ('&':xs) = case lookupEntity ent' of - Just c -> c : fromEntities rest + Just c -> c ++ fromEntities rest Nothing -> '&' : fromEntities xs where (ent, rest) = case break (\c -> isSpace c || c == ';') xs of (zs,';':ys) -> (zs,ys) diff --git a/tests/Tests/Readers/Docx.hs b/tests/Tests/Readers/Docx.hs index a9a9094f1..8ae0532e4 100644 --- a/tests/Tests/Readers/Docx.hs +++ b/tests/Tests/Readers/Docx.hs @@ -182,6 +182,10 @@ tests = [ testGroup "inlines" "docx/already_auto_ident.docx" "docx/already_auto_ident.native" , testCompare + "nested anchor spans in header" + "docx/nested_anchors_in_header.docx" + "docx/nested_anchors_in_header.native" + , testCompare "single numbered item not made into list" "docx/numbered_header.docx" "docx/numbered_header.native" diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 0a3f9c222..d4fedc797 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -467,7 +467,14 @@ tests = , "Author" =: "#+author: Albert /Emacs-Fanboy/ Krewinkel" =?> let author = toList . spcSep $ [ "Albert", emph "Emacs-Fanboy", "Krewinkel" ] - meta = setMeta "author" (MetaInlines author) $ nullMeta + meta = setMeta "author" (MetaList [MetaInlines author]) $ nullMeta + in Pandoc meta mempty + + , "Multiple authors" =: + "#+author: James Dewey Watson, Francis Harry Compton Crick " =?> + let watson = MetaInlines $ toList "James Dewey Watson" + crick = MetaInlines $ toList "Francis Harry Compton Crick" + meta = setMeta "author" (MetaList [watson, crick]) $ nullMeta in Pandoc meta mempty , "Date" =: @@ -478,8 +485,8 @@ tests = , "Description" =: "#+DESCRIPTION: Explanatory text" =?> - let description = toList . spcSep $ [ "Explanatory", "text" ] - meta = setMeta "description" (MetaInlines description) $ nullMeta + let description = "Explanatory text" + meta = setMeta "description" (MetaString description) $ nullMeta in Pandoc meta mempty , "Properties drawer" =: @@ -489,6 +496,38 @@ tests = ] =?> (mempty::Blocks) + , "LaTeX_headers options are translated to header-includes" =: + "#+LaTeX_header: \\usepackage{tikz}" =?> + let latexInlines = rawInline "latex" "\\usepackage{tikz}" + inclList = MetaList [MetaInlines (toList latexInlines)] + meta = setMeta "header-includes" inclList nullMeta + in Pandoc meta mempty + + , "LaTeX_class option is translated to documentclass" =: + "#+LATEX_CLASS: article" =?> + let meta = setMeta "documentclass" (MetaString "article") nullMeta + in Pandoc meta mempty + + , "LaTeX_class_options is translated to classoption" =: + "#+LATEX_CLASS_OPTIONS: [a4paper]" =?> + let meta = setMeta "classoption" (MetaString "a4paper") nullMeta + in Pandoc meta mempty + + , "LaTeX_class_options is translated to classoption" =: + "#+html_head: <meta/>" =?> + let html = rawInline "html" "<meta/>" + inclList = MetaList [MetaInlines (toList html)] + meta = setMeta "header-includes" inclList nullMeta + in Pandoc meta mempty + + , "later meta definitions take precedence" =: + unlines [ "#+AUTHOR: this will not be used" + , "#+author: Max" + ] =?> + let author = MetaInlines [Str "Max"] + meta = setMeta "author" (MetaList [author]) $ nullMeta + in Pandoc meta mempty + , "Logbook drawer" =: unlines [ " :LogBook:" , " - State \"DONE\" from \"TODO\" [2014-03-03 Mon 11:00]" @@ -563,69 +602,91 @@ tests = ] =?> (para (link "http://example.com/foo" "" "bar")) - , "Export option: Disable simple sub/superscript syntax" =: - unlines [ "#+OPTIONS: ^:nil" - , "a^b" - ] =?> - para "a^b" - , "Export option: directly select drawers to be exported" =: - unlines [ "#+OPTIONS: d:(\"IMPORTANT\")" - , ":IMPORTANT:" - , "23" - , ":END:" - , ":BORING:" - , "very boring" - , ":END:" - ] =?> - divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "23") - - , "Export option: exclude drawers from being exported" =: - unlines [ "#+OPTIONS: d:(not \"BORING\")" - , ":IMPORTANT:" - , "5" - , ":END:" - , ":BORING:" - , "very boring" - , ":END:" - ] =?> - divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5") - - , "Export option: don't include archive trees" =: - unlines [ "#+OPTIONS: arch:nil" - , "* old :ARCHIVE:" - ] =?> - (mempty ::Blocks) + , testGroup "export options" + + [ "disable simple sub/superscript syntax" =: + unlines [ "#+OPTIONS: ^:nil" + , "a^b" + ] =?> + para "a^b" + + , "directly select drawers to be exported" =: + unlines [ "#+OPTIONS: d:(\"IMPORTANT\")" + , ":IMPORTANT:" + , "23" + , ":END:" + , ":BORING:" + , "very boring" + , ":END:" + ] =?> + divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "23") + + , "exclude drawers from being exported" =: + unlines [ "#+OPTIONS: d:(not \"BORING\")" + , ":IMPORTANT:" + , "5" + , ":END:" + , ":BORING:" + , "very boring" + , ":END:" + ] =?> + divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5") + + , "don't include archive trees" =: + unlines [ "#+OPTIONS: arch:nil" + , "* old :ARCHIVE:" + ] =?> + (mempty ::Blocks) + + , "include complete archive trees" =: + unlines [ "#+OPTIONS: arch:t" + , "* old :ARCHIVE:" + , " boring" + ] =?> + let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + , para "boring" + ] - , "Export option: include complete archive trees" =: - unlines [ "#+OPTIONS: arch:t" - , "* old :ARCHIVE:" - , " boring" - ] =?> - let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty - in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") - , para "boring" - ] + , "include archive tree header only" =: + unlines [ "#+OPTIONS: arch:headline" + , "* old :ARCHIVE:" + , " boring" + ] =?> + let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + + , "limit headline depth" =: + unlines [ "#+OPTIONS: H:2" + , "* section" + , "** subsection" + , "*** list item 1" + , "*** list item 2" + ] =?> + mconcat [ headerWith ("section", [], []) 1 "section" + , headerWith ("subsection", [], []) 2 "subsection" + , orderedList [ para "list item 1", para "list item 2" ] + ] - , "Export option: include archive tree header only" =: - unlines [ "#+OPTIONS: arch:headline" - , "* old :ARCHIVE:" - , " boring" - ] =?> - let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty - in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") - - , "Export option: limit headline depth" =: - unlines [ "#+OPTIONS: H:2" - , "* section" - , "** subsection" - , "*** list item 1" - , "*** list item 2" - ] =?> - mconcat [ headerWith ("section", [], []) 1 "section" - , headerWith ("subsection", [], []) 2 "subsection" - , orderedList [ para "list item 1", para "list item 2" ] - ] + , "disable author export" =: + unlines [ "#+OPTIONS: author:nil" + , "#+AUTHOR: ShyGuy" + ] =?> + Pandoc nullMeta mempty + + , "disable creator export" =: + unlines [ "#+OPTIONS: creator:nil" + , "#+creator: The Architect" + ] =?> + Pandoc nullMeta mempty + + , "disable email export" =: + unlines [ "#+OPTIONS: email:nil" + , "#+email: no-mail-please@example.com" + ] =?> + Pandoc nullMeta mempty + ] ] , testGroup "Basic Blocks" $ @@ -757,6 +818,15 @@ tests = ] =?> headerWith ("fubar", [], [("bar", "baz")]) 1 "foo" + + , "Headers marked with a unnumbered property get a class of the same name" =: + unlines [ "* Not numbered" + , " :PROPERTIES:" + , " :UNNUMBERED: t" + , " :END:" + ] =?> + headerWith ("not-numbered", ["unnumbered"], []) 1 "Not numbered" + , "Paragraph starting with an asterisk" =: "*five" =?> para "*five" diff --git a/tests/Tests/Writers/Docx.hs b/tests/Tests/Writers/Docx.hs index 8dba0ea55..31fc3a47b 100644 --- a/tests/Tests/Writers/Docx.hs +++ b/tests/Tests/Writers/Docx.hs @@ -13,120 +13,137 @@ import System.FilePath ((</>)) type Options = (WriterOptions, ReaderOptions) compareOutput :: Options - -> FilePath - -> IO (Pandoc, Pandoc) -compareOutput opts nativeFile = do - nf <- Prelude.readFile nativeFile + -> FilePath + -> FilePath + -> IO (Pandoc, Pandoc) +compareOutput opts nativeFileIn nativeFileOut = do + nf <- Prelude.readFile nativeFileIn + nf' <- Prelude.readFile nativeFileOut let wopts = fst opts df <- writeDocx wopts{writerUserDataDir = Just (".." </> "data")} (handleError $ readNative nf) let (p, _) = handleError $ readDocx (snd opts) df - return (p, handleError $ readNative nf) + return (p, handleError $ readNative nf') -testCompareWithOptsIO :: Options -> String -> FilePath -> IO Test -testCompareWithOptsIO opts name nativeFile = do - (dp, np) <- compareOutput opts nativeFile +testCompareWithOptsIO :: Options -> String -> FilePath -> FilePath -> IO Test +testCompareWithOptsIO opts name nativeFileIn nativeFileOut = do + (dp, np) <- compareOutput opts nativeFileIn nativeFileOut return $ test id name (dp, np) -testCompareWithOpts :: Options -> String -> FilePath -> Test -testCompareWithOpts opts name nativeFile = - buildTest $ testCompareWithOptsIO opts name nativeFile +testCompareWithOpts :: Options -> String -> FilePath -> FilePath -> Test +testCompareWithOpts opts name nativeFileIn nativeFileOut = + buildTest $ testCompareWithOptsIO opts name nativeFileIn nativeFileOut -testCompare :: String -> FilePath -> Test -testCompare = testCompareWithOpts def +roundTripCompareWithOpts :: Options -> String -> FilePath -> Test +roundTripCompareWithOpts opts name nativeFile = + testCompareWithOpts opts name nativeFile nativeFile + +-- testCompare :: String -> FilePath -> FilePath -> Test +-- testCompare = testCompareWithOpts def + +roundTripCompare :: String -> FilePath -> Test +roundTripCompare = roundTripCompareWithOpts def tests :: [Test] tests = [ testGroup "inlines" - [ testCompare + [ roundTripCompare "font formatting" "docx/inline_formatting_writer.native" - , testCompare + , roundTripCompare "font formatting with character styles" "docx/char_styles.native" - , testCompare + , roundTripCompare "hyperlinks" "docx/links_writer.native" - , testCompare + , roundTripCompare "inline image" "docx/image_no_embed_writer.native" - , testCompare + , roundTripCompare "inline image in links" "docx/inline_images_writer.native" - , testCompare + , roundTripCompare "handling unicode input" "docx/unicode.native" - , testCompare + , roundTripCompare "literal tabs" "docx/tabs.native" - , testCompare + , roundTripCompare "normalizing inlines" "docx/normalize.native" - , testCompare + , roundTripCompare "normalizing inlines deep inside blocks" "docx/deep_normalize.native" - , testCompare + , roundTripCompare "move trailing spaces outside of formatting" "docx/trailing_spaces_in_formatting.native" - , testCompare + , roundTripCompare "inline code (with VerbatimChar style)" "docx/inline_code.native" - , testCompare + , roundTripCompare "inline code in subscript and superscript" "docx/verbatim_subsuper.native" ] , testGroup "blocks" - [ testCompare + [ roundTripCompare "headers" "docx/headers.native" - , testCompare + , roundTripCompare "headers already having auto identifiers" "docx/already_auto_ident.native" - , testCompare + , roundTripCompare "numbered headers automatically made into list" "docx/numbered_header.native" - , testCompare + , roundTripCompare "i18n blocks (headers and blockquotes)" "docx/i18n_blocks.native" -- Continuation does not survive round-trip - , testCompare + , roundTripCompare "lists" "docx/lists_writer.native" - , testCompare + , roundTripCompare "definition lists" "docx/definition_list.native" - , testCompare + , roundTripCompare "custom defined lists in styles" "docx/german_styled_lists.native" - , testCompare + , roundTripCompare "footnotes and endnotes" "docx/notes.native" - , testCompare + , roundTripCompare "blockquotes (parsing indent as blockquote)" "docx/block_quotes_parse_indent.native" - , testCompare + , roundTripCompare "hanging indents" "docx/hanging_indent.native" -- tables headers do not survive round-trip, should look into that - , testCompare + , roundTripCompare "tables" "docx/tables.native" - , testCompare + , roundTripCompare "tables with lists in cells" "docx/table_with_list_cell.native" - , testCompare + , roundTripCompare "code block" "docx/codeblock.native" - , testCompare + , roundTripCompare "dropcap paragraphs" "docx/drop_cap.native" ] , testGroup "metadata" - [ testCompareWithOpts (def,def{readerStandalone=True}) + [ roundTripCompareWithOpts (def,def{readerStandalone=True}) "metadata fields" "docx/metadata.native" - , testCompareWithOpts (def,def{readerStandalone=True}) + , roundTripCompareWithOpts (def,def{readerStandalone=True}) "stop recording metadata with normal text" "docx/metadata_after_normal.native" ] + , testGroup "customized styles" + [ testCompareWithOpts + ( def{writerReferenceDocx=Just "docx/custom-style-reference.docx"} + , def) + "simple customized blocks and inlines" + "docx/custom-style-roundtrip-start.native" + "docx/custom-style-roundtrip-end.native" + ] ] diff --git a/tests/Tests/Writers/LaTeX.hs b/tests/Tests/Writers/LaTeX.hs index 4a1232db2..afab7d628 100644 --- a/tests/Tests/Writers/LaTeX.hs +++ b/tests/Tests/Writers/LaTeX.hs @@ -75,5 +75,7 @@ tests = [ testGroup "code blocks" "\\sout{\\texttt{foo} bar}" , "single quotes" =: code "dog's" =?> "\\texttt{dog\\textquotesingle{}s}" + , "backtick" =: + code "`nu?`" =?> "\\texttt{{`}nu?{`}}" ] ] diff --git a/tests/docx/custom-style-reference.docx b/tests/docx/custom-style-reference.docx Binary files differnew file mode 100644 index 000000000..0f53c6c88 --- /dev/null +++ b/tests/docx/custom-style-reference.docx diff --git a/tests/docx/custom-style-roundtrip-end.native b/tests/docx/custom-style-roundtrip-end.native new file mode 100644 index 000000000..4313c3595 --- /dev/null +++ b/tests/docx/custom-style-roundtrip-end.native @@ -0,0 +1,5 @@ +[Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "test",Space,Str "of",Space,Str "custom-styles."] +,Para [Str "Here",Space,Str "is",Space,Str "something",Space,Emph [Str "emphasized"],Str ".",Space,Str "And",Space,Str "here",Space,Str "is",Space,Str "something",Space,Strong [Str "strong"],Str "."] +,BlockQuote + [Para [Str "One",Space,Str "paragraph",Space,Str "of",Space,Str "text."] + ,Para [Str "And",Space,Str "another",Space,Str "paragraph",Space,Str "of",Space,Emph [Str "really",Space,Str "cool"],Space,Str "text."]]] diff --git a/tests/docx/custom-style-roundtrip-start.native b/tests/docx/custom-style-roundtrip-start.native new file mode 100644 index 000000000..c4566ed85 --- /dev/null +++ b/tests/docx/custom-style-roundtrip-start.native @@ -0,0 +1,5 @@ +[Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "test",Space,Str "of",Space,Str "custom-styles."] +,Para [Str "Here",Space,Str "is",Space,Str "something",Space,Span ("",[],[("custom-style","Emphatic")]) [Str "emphasized"],Str ".",Space,Str "And",SoftBreak,Str "here",Space,Str "is",Space,Str "something",Space,Span ("",[],[("custom-style","Strengthened")]) [Str "strong"],Str "."] +,Div ("",[],[("custom-style","My Block Style")]) + [Para [Str "One",Space,Str "paragraph",Space,Str "of",Space,Str "text."] + ,Para [Str "And",Space,Str "another",Space,Str "paragraph",Space,Str "of",Space,Span ("",[],[("custom-style","Emphatic")]) [Str "really",SoftBreak,Str "cool"],Space,Str "text."]]] diff --git a/tests/docx/nested_anchors_in_header.docx b/tests/docx/nested_anchors_in_header.docx Binary files differnew file mode 100644 index 000000000..ddebb7ff4 --- /dev/null +++ b/tests/docx/nested_anchors_in_header.docx diff --git a/tests/docx/nested_anchors_in_header.native b/tests/docx/nested_anchors_in_header.native new file mode 100644 index 000000000..e2b6eb1ef --- /dev/null +++ b/tests/docx/nested_anchors_in_header.native @@ -0,0 +1,10 @@ +[Header 1 ("short-instructions",[],[]) [Str "Short",Space,Str "instructions"] +,Para [Link ("",[],[]) [Str "Open",Space,Str "remote",Space,Str "folder"] ("#remote-folder-or-longlonglonglonglong-file-with-manymanymanymany-letters-inside-opening","")] +,Para [Str "Do",Space,Str "staff"] +,Para [Link ("",[],[]) [Str "Close",Space,Str "remote",Space,Str "folder"] ("#remote-folder-or-longlonglonglonglong-file-with-manymanymanymany-letters-inside-closing","")] +,Header 1 ("some-instructions",[],[]) [Str "Some",Space,Str "instructions"] +,Para [Str "Lines"] +,Header 2 ("remote-folder-or-longlonglonglonglong-file-with-manymanymanymany-letters-inside-opening",[],[]) [Str "Remote",Space,Str "folder",Space,Str "or",Space,Str "longlonglonglonglong",Space,Str "file",Space,Str "with",Space,Str "manymanymanymany",Space,Str "letters",Space,Str "inside",Space,Str "opening"] +,Para [Str "Open",Space,Str "folder"] +,Header 2 ("remote-folder-or-longlonglonglonglong-file-with-manymanymanymany-letters-inside-closing",[],[]) [Str "Remote",Space,Str "folder",Space,Str "or",Space,Str "longlonglonglonglong",Space,Str "file",Space,Str "with",Space,Str "manymanymanymany",Space,Str "letters",Space,Str "inside",Space,Str "closing"] +,Para [Str "Close",Space,Str "folder"]] diff --git a/tests/writer.org b/tests/writer.org index cf6305ec9..6a86a4e3f 100644 --- a/tests/writer.org +++ b/tests/writer.org @@ -808,9 +808,9 @@ Auto-links should not occur here: =<http://example.com/>= From "Voyage dans la Lune" by Georges Melies (1902): #+CAPTION: lalune +[[file:lalune.jpg]] -[[lalune.jpg]] -Here is a movie [[movie.jpg]] icon. +Here is a movie [[file:movie.jpg]] icon. -------------- |