From 965f1ddd4a9d1317455094b8c41016624d92f8ce Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 13 May 2017 23:30:13 +0200 Subject: Update dates in copyright notices This follows the suggestions given by the FSF for GPL licensed software. --- src/Text/Pandoc/Logging.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Logging.hs') diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index 59b010034..2cca4b7d3 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Logging - Copyright : Copyright (C) 2006-2016 John MacFarlane + Copyright : Copyright (C) 2006-2017 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane -- cgit v1.2.3 From aa1e39858dd0ad25fd5e0cf0e2e19182bd4f157b Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 21 May 2017 11:42:50 +0200 Subject: Text.Pandoc.App: ToJSON and FromJSON instances for Opts. This can be used e.g. to pass options via web interface, such as trypandoc. --- src/Text/Pandoc/App.hs | 27 ++++++++++++++++++++++----- src/Text/Pandoc/Logging.hs | 10 ++++++++++ src/Text/Pandoc/Options.hs | 34 ++++++++++++++++++++++++++++++++++ 3 files changed, 66 insertions(+), 5 deletions(-) (limited to 'src/Text/Pandoc/Logging.hs') diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index c874a2cde..eee72fd3c 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE DeriveGeneric #-} {- Copyright (C) 2006-2017 John MacFarlane @@ -42,12 +43,14 @@ import qualified Control.Exception as E import Control.Monad.Except (throwError) import Control.Monad import Control.Monad.Trans -import Data.Aeson (eitherDecode', encode) +import Data.Aeson (eitherDecode', encode, ToJSON(..), FromJSON(..), + genericToEncoding, defaultOptions) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as B import Data.Char (toLower, toUpper) import qualified Data.Set as Set import Data.Foldable (foldrM) +import GHC.Generics import Data.List (intercalate, isPrefixOf, isSuffixOf, sort) import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust, isNothing) @@ -65,7 +68,8 @@ import System.Directory (Permissions (..), doesFileExist, findExecutable, import System.Environment (getArgs, getEnvironment, getProgName) import System.Exit (ExitCode (..), exitSuccess) import System.FilePath -import System.IO (stdout, nativeNewline, Newline(..)) +import System.IO (stdout, nativeNewline) +import qualified System.IO as IO (Newline(..)) import System.IO.Error (isDoesNotExistError) import Text.Pandoc import Text.Pandoc.Builder (setMeta) @@ -86,6 +90,12 @@ import System.Posix.IO (stdOutput) import System.Posix.Terminal (queryTerminal) #endif +data Newline = LF | CRLF deriving (Show, Generic) + +instance ToJSON Newline where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Newline + parseOptions :: [OptDescr (Opt -> IO Opt)] -> Opt -> IO Opt parseOptions options' defaults = do rawArgs <- map UTF8.decodeArg <$> getArgs @@ -411,7 +421,10 @@ convertWithOpts opts = do return $ ("csl", jatsEncoded) : optMetadata opts else return $ optMetadata opts - let eol = fromMaybe nativeNewline $ optEol opts + let eol = case optEol opts of + Just CRLF -> IO.CRLF + Just LF -> IO.LF + Nothing -> nativeNewline runIO' $ do setResourcePath (optResourcePath opts) @@ -572,7 +585,11 @@ data Opt = Opt , optIncludeInHeader :: [FilePath] -- ^ Files to include in header , optResourcePath :: [FilePath] -- ^ Path to search for images etc , optEol :: Maybe Newline -- ^ Enforce line-endings - } + } deriving (Generic, Show) + +instance ToJSON Opt where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Opt -- | Defaults for command-line options. defaultOpts :: Opt @@ -790,7 +807,7 @@ writeFnBinary :: MonadIO m => FilePath -> B.ByteString -> m () writeFnBinary "-" = liftIO . B.putStr writeFnBinary f = liftIO . B.writeFile (UTF8.encodePath f) -writerFn :: MonadIO m => Newline -> FilePath -> String -> m () +writerFn :: MonadIO m => IO.Newline -> FilePath -> String -> m () writerFn eol "-" = liftIO . UTF8.putStrWith eol writerFn eol f = liftIO . UTF8.writeFileWith eol f diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index 2cca4b7d3..bf7f33d29 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -39,6 +39,7 @@ module Text.Pandoc.Logging ( , messageVerbosity ) where +import Control.Monad (mzero) import Data.Aeson import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder) @@ -56,6 +57,15 @@ data Verbosity = ERROR | WARNING | INFO | DEBUG instance ToJSON Verbosity where toJSON x = toJSON (show x) +instance FromJSON Verbosity where + parseJSON (String t) = + case t of + "ERROR" -> return ERROR + "WARNING" -> return WARNING + "INFO" -> return INFO + "DEBUG" -> return DEBUG + _ -> mzero + parseJSON _ = mzero data LogMessage = SkippedContent String SourcePos diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 6757c6782..c7211c86e 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -45,6 +45,8 @@ module Text.Pandoc.Options ( module Text.Pandoc.Extensions , def , isEnabled ) where +import Data.Aeson (ToJSON(..), FromJSON(..), + genericToEncoding, defaultOptions) import Data.Data (Data) import Data.Default import qualified Data.Set as Set @@ -104,17 +106,29 @@ data HTMLMathMethod = PlainMath | KaTeX String String -- url of stylesheet and katex.js deriving (Show, Read, Eq, Data, Typeable, Generic) +instance ToJSON HTMLMathMethod where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HTMLMathMethod + data CiteMethod = Citeproc -- use citeproc to render them | Natbib -- output natbib cite commands | Biblatex -- output biblatex cite commands deriving (Show, Read, Eq, Data, Typeable, Generic) +instance ToJSON CiteMethod where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CiteMethod + -- | Methods for obfuscating email addresses in HTML. data ObfuscationMethod = NoObfuscation | ReferenceObfuscation | JavascriptObfuscation deriving (Show, Read, Eq, Data, Typeable, Generic) +instance ToJSON ObfuscationMethod where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ObfuscationMethod + -- | Varieties of HTML slide shows. data HTMLSlideVariant = S5Slides | SlidySlides @@ -124,18 +138,30 @@ data HTMLSlideVariant = S5Slides | NoSlides deriving (Show, Read, Eq, Data, Typeable, Generic) +instance ToJSON HTMLSlideVariant where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HTMLSlideVariant + -- | Options for accepting or rejecting MS Word track-changes. data TrackChanges = AcceptChanges | RejectChanges | AllChanges deriving (Show, Read, Eq, Data, Typeable, Generic) +instance ToJSON TrackChanges where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TrackChanges + -- | Options for wrapping text in the output. data WrapOption = WrapAuto -- ^ Automatically wrap to width | WrapNone -- ^ No non-semantic newlines | WrapPreserve -- ^ Preserve wrapping of input source deriving (Show, Read, Eq, Data, Typeable, Generic) +instance ToJSON WrapOption where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WrapOption + -- | Options defining the type of top-level headers. data TopLevelDivision = TopLevelPart -- ^ Top-level headers become parts | TopLevelChapter -- ^ Top-level headers become chapters @@ -144,12 +170,20 @@ data TopLevelDivision = TopLevelPart -- ^ Top-level headers become parts -- heuristics deriving (Show, Read, Eq, Data, Typeable, Generic) +instance ToJSON TopLevelDivision where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TopLevelDivision + -- | Locations for footnotes and references in markdown output data ReferenceLocation = EndOfBlock -- ^ End of block | EndOfSection -- ^ prior to next section header (or end of document) | EndOfDocument -- ^ at end of document deriving (Show, Read, Eq, Data, Typeable, Generic) +instance ToJSON ReferenceLocation where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ReferenceLocation + -- | Options for writers data WriterOptions = WriterOptions { writerTemplate :: Maybe String -- ^ Template to use -- cgit v1.2.3 From 19d3a2bbe5291dcba0bdba9f6faf0103f5f47245 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 24 May 2017 21:46:43 +0200 Subject: Logging: Made SkippedContent WARNING not INFO. --- src/Text/Pandoc/Logging.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Logging.hs') diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index bf7f33d29..70384f936 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -252,7 +252,7 @@ showLogMessage msg = messageVerbosity:: LogMessage -> Verbosity messageVerbosity msg = case msg of - SkippedContent{} -> INFO + SkippedContent{} -> WARNING CouldNotParseYamlMetadata{} -> WARNING DuplicateLinkReference{} -> WARNING DuplicateNoteReference{} -> WARNING -- cgit v1.2.3 From 8f2c803f973d53da340c876edbbcb2b1223f35cd Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 25 May 2017 11:15:52 +0200 Subject: Markdown reader: warn for notes defined but not used. Closes #1718. Parsing.ParserState: Make stateNotes' a Map, add stateNoteRefs. --- src/Text/Pandoc/Logging.hs | 10 ++++++++++ src/Text/Pandoc/Parsing.hs | 7 +++++-- src/Text/Pandoc/Readers/Markdown.hs | 20 ++++++++++++++------ 3 files changed, 29 insertions(+), 8 deletions(-) (limited to 'src/Text/Pandoc/Logging.hs') diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index 70384f936..7afce9f5f 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -72,6 +72,7 @@ data LogMessage = | CouldNotParseYamlMetadata String SourcePos | DuplicateLinkReference String SourcePos | DuplicateNoteReference String SourcePos + | NoteDefinedButNotUsed String SourcePos | DuplicateIdentifier String SourcePos | ReferenceNotFound String SourcePos | CircularReference String SourcePos @@ -113,6 +114,11 @@ instance ToJSON LogMessage where "source" .= Text.pack (sourceName pos), "line" .= toJSON (sourceLine pos), "column" .= toJSON (sourceColumn pos)] + NoteDefinedButNotUsed s pos -> + ["key" .= Text.pack s, + "source" .= Text.pack (sourceName pos), + "line" .= toJSON (sourceLine pos), + "column" .= toJSON (sourceColumn pos)] DuplicateNoteReference s pos -> ["contents" .= Text.pack s, "source" .= Text.pack (sourceName pos), @@ -203,6 +209,9 @@ showLogMessage msg = "Duplicate link reference '" ++ s ++ "' at " ++ showPos pos DuplicateNoteReference s pos -> "Duplicate note reference '" ++ s ++ "' at " ++ showPos pos + NoteDefinedButNotUsed s pos -> + "Note with key '" ++ s ++ "' defined at " ++ showPos pos ++ + " but not used." DuplicateIdentifier s pos -> "Duplicate identifier '" ++ s ++ "' at " ++ showPos pos ReferenceNotFound s pos -> @@ -256,6 +265,7 @@ messageVerbosity msg = CouldNotParseYamlMetadata{} -> WARNING DuplicateLinkReference{} -> WARNING DuplicateNoteReference{} -> WARNING + NoteDefinedButNotUsed{} -> WARNING DuplicateIdentifier{} -> WARNING ReferenceNotFound{} -> WARNING CircularReference{} -> WARNING diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index e6157dde3..225796272 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -983,6 +983,7 @@ data ParserState = ParserState stateSubstitutions :: SubstTable, -- ^ List of substitution references stateNotes :: NoteTable, -- ^ List of notes (raw bodies) stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies) + stateNoteRefs :: Set.Set String, -- ^ List of note references used stateMeta :: Meta, -- ^ Document metadata stateMeta' :: F Meta, -- ^ Document metadata stateCitations :: M.Map String String, -- ^ RST-style citations @@ -1099,7 +1100,8 @@ defaultParserState = stateHeaderKeys = M.empty, stateSubstitutions = M.empty, stateNotes = [], - stateNotes' = [], + stateNotes' = M.empty, + stateNoteRefs = Set.empty, stateMeta = nullMeta, stateMeta' = return nullMeta, stateCitations = M.empty, @@ -1166,7 +1168,8 @@ data QuoteContext type NoteTable = [(String, String)] -type NoteTable' = [(String, F Blocks)] -- used in markdown reader +type NoteTable' = M.Map String (SourcePos, F Blocks) +-- used in markdown reader newtype Key = Key String deriving (Show, Read, Eq, Ord) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 3e3de0d9d..11f35deb2 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -362,6 +362,14 @@ parseMarkdown = do optional titleBlock blocks <- parseBlocks st <- getState + -- check for notes with no corresponding note references + let notesUsed = stateNoteRefs st + let notesDefined = M.keys (stateNotes' st) + mapM_ (\n -> unless (n `Set.member` notesUsed) $ do + -- lookup to get sourcepos + case M.lookup n (stateNotes' st) of + Just (pos, _) -> report (NoteDefinedButNotUsed n pos) + Nothing -> error "The impossible happened.") notesDefined let doc = runF (do Pandoc _ bs <- B.doc <$> blocks meta <- stateMeta' st return $ Pandoc meta bs) st @@ -469,12 +477,11 @@ noteBlock = try $ do let raw = unlines (first:rest) ++ "\n" optional blanklines parsed <- parseFromString' parseBlocks raw - let newnote = (ref, parsed) oldnotes <- stateNotes' <$> getState - case lookup ref oldnotes of + case M.lookup ref oldnotes of Just _ -> logMessage $ DuplicateNoteReference ref pos Nothing -> return () - updateState $ \s -> s { stateNotes' = newnote : oldnotes } + updateState $ \s -> s { stateNotes' = M.insert ref (pos, parsed) oldnotes } return mempty -- @@ -1816,16 +1823,17 @@ note :: PandocMonad m => MarkdownParser m (F Inlines) note = try $ do guardEnabled Ext_footnotes ref <- noteMarker + updateState $ \st -> st{ stateNoteRefs = Set.insert ref (stateNoteRefs st) } return $ do notes <- asksF stateNotes' - case lookup ref notes of + case M.lookup ref notes of Nothing -> return $ B.str $ "[^" ++ ref ++ "]" - Just contents -> do + Just (_pos, contents) -> do st <- askF -- process the note in a context that doesn't resolve -- notes, to avoid infinite looping with notes inside -- notes: - let contents' = runF contents st{ stateNotes' = [] } + let contents' = runF contents st{ stateNotes' = M.empty } return $ B.note contents' inlineNote :: PandocMonad m => MarkdownParser m (F Inlines) -- cgit v1.2.3 From 23f3c2d7b4796d1af742a74999ce67924bf2abb3 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Mon, 12 Jun 2017 15:28:39 +0200 Subject: Changed "extracting..." warning to a regular log message. This makes it sensitive to proper verbosity settings. (It is now treated as INFO rather than WARNING, so one doesn't get these messages for creation of tmp images while making a pdf.) API changes: * Removed extractMediaBag from Text.Pandoc.MediaBag. * Added Extracting as constructor for LogMessage. --- src/Text/Pandoc/Class.hs | 23 +++++++++++++++++++---- src/Text/Pandoc/Logging.hs | 6 ++++++ src/Text/Pandoc/MediaBag.hs | 31 ------------------------------- 3 files changed, 25 insertions(+), 35 deletions(-) (limited to 'src/Text/Pandoc/Logging.hs') diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs index 91731d396..14a0b8044 100644 --- a/src/Text/Pandoc/Class.hs +++ b/src/Text/Pandoc/Class.hs @@ -93,15 +93,16 @@ import Network.URI ( escapeURIString, nonStrictRelativeTo, unEscapeString, parseURIReference, isAllowedInURI, parseURI, URI(..) ) import qualified Data.Time.LocalTime as IO (getCurrentTimeZone) -import Text.Pandoc.MediaBag (MediaBag, lookupMedia, extractMediaBag, - mediaDirectory) +import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory) import Text.Pandoc.Walk (walkM, walk) import qualified Text.Pandoc.MediaBag as MB import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified System.Environment as IO (lookupEnv) import System.FilePath.Glob (match, compile) -import System.FilePath ((), (<.>), takeExtension, dropExtension, isRelative) +import System.Directory (createDirectoryIfMissing) +import System.FilePath ((), (<.>), takeDirectory, + takeExtension, dropExtension, isRelative, normalise) import qualified System.FilePath.Glob as IO (glob) import qualified System.Directory as IO (getModificationTime) import Control.Monad as M (fail) @@ -387,9 +388,23 @@ extractMedia dir d = do case [fp | (fp, _, _) <- mediaDirectory media] of [] -> return d fps -> do - liftIO $ extractMediaBag True dir media + mapM_ (writeMedia dir media) fps return $ walk (adjustImagePath dir fps) d +writeMedia :: FilePath -> MediaBag -> FilePath -> PandocIO () +writeMedia dir mediabag subpath = do + -- we join and split to convert a/b/c to a\b\c on Windows; + -- in zip containers all paths use / + let fullpath = dir normalise subpath + let mbcontents = lookupMedia subpath mediabag + case mbcontents of + Nothing -> throwError $ PandocResourceNotFound subpath + Just (_, bs) -> do + report $ Extracting fullpath + liftIO $ do + createDirectoryIfMissing True $ takeDirectory fullpath + BL.writeFile fullpath bs + adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline adjustImagePath dir paths (Image attr lab (src, tit)) | src `elem` paths = Image attr lab (dir ++ "/" ++ src, tit) diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index 7afce9f5f..da8c775f6 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -89,6 +89,7 @@ data LogMessage = | CouldNotConvertTeXMath String String | CouldNotParseCSS String | Fetching String + | Extracting String | NoTitleElement String | NoLangSpecified | CouldNotHighlight String @@ -178,6 +179,8 @@ instance ToJSON LogMessage where ["message" .= Text.pack msg] Fetching fp -> ["path" .= Text.pack fp] + Extracting fp -> + ["path" .= Text.pack fp] NoTitleElement fallback -> ["fallback" .= Text.pack fallback] NoLangSpecified -> [] @@ -248,6 +251,8 @@ showLogMessage msg = "Could not parse CSS" ++ if null m then "" else (':':'\n':m) Fetching fp -> "Fetching " ++ fp ++ "..." + Extracting fp -> + "Extracting " ++ fp ++ "..." NoTitleElement fallback -> "This document format requires a nonempty element.\n" ++ "Please specify either 'title' or 'pagetitle' in the metadata.\n" ++ @@ -282,6 +287,7 @@ messageVerbosity msg = CouldNotConvertTeXMath{} -> WARNING CouldNotParseCSS{} -> WARNING Fetching{} -> INFO + Extracting{} -> INFO NoTitleElement{} -> WARNING NoLangSpecified -> INFO CouldNotHighlight{} -> WARNING diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs index 980511acc..d8d6da345 100644 --- a/src/Text/Pandoc/MediaBag.hs +++ b/src/Text/Pandoc/MediaBag.hs @@ -35,21 +35,15 @@ module Text.Pandoc.MediaBag ( lookupMedia, insertMedia, mediaDirectory, - extractMediaBag ) where -import Control.Monad (when) -import Control.Monad.Trans (MonadIO (..)) import qualified Data.ByteString.Lazy as BL import Data.Data (Data) import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Typeable (Typeable) -import System.Directory (createDirectoryIfMissing) import System.FilePath import qualified System.FilePath.Posix as Posix -import System.IO (stderr) import Text.Pandoc.MIME (MimeType, getMimeTypeDef) -import qualified Text.Pandoc.UTF8 as UTF8 -- | A container for a collection of binary resources, with names and -- mime types. Note that a 'MediaBag' is a Monoid, so 'mempty' @@ -87,28 +81,3 @@ mediaDirectory :: MediaBag -> [(String, MimeType, Int)] mediaDirectory (MediaBag mediamap) = M.foldWithKey (\fp (mime,contents) -> (((Posix.joinPath fp), mime, fromIntegral $ BL.length contents):)) [] mediamap - --- | Extract contents of MediaBag to a given directory. Print informational --- messages if 'verbose' is true. --- TODO: eventually we may want to put this into PandocMonad --- In PandocPure, it could write to the fake file system... -extractMediaBag :: MonadIO m - => Bool - -> FilePath - -> MediaBag - -> m () -extractMediaBag verbose dir (MediaBag mediamap) = liftIO $ do - sequence_ $ M.foldWithKey - (\fp (_ ,contents) -> - ((writeMedia verbose dir (Posix.joinPath fp, contents)):)) [] mediamap - -writeMedia :: Bool -> FilePath -> (FilePath, BL.ByteString) -> IO () -writeMedia verbose dir (subpath, bs) = do - -- we join and split to convert a/b/c to a\b\c on Windows; - -- in zip containers all paths use / - let fullpath = dir </> normalise subpath - createDirectoryIfMissing True $ takeDirectory fullpath - when verbose $ UTF8.hPutStrLn stderr $ "pandoc: extracting " ++ fullpath - BL.writeFile fullpath bs - - -- cgit v1.2.3