Text.Pandoc.App: ToJSON and FromJSON instances for Opts.

This can be used e.g. to pass options via web interface,
such as trypandoc.
This commit is contained in:
John MacFarlane 2017-05-21 11:42:50 +02:00
parent 8c1b81bbef
commit aa1e39858d
3 changed files with 66 additions and 5 deletions

View file

@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveGeneric #-}
{- {-
Copyright (C) 2006-2017 John MacFarlane <jgm@berkeley.edu> Copyright (C) 2006-2017 John MacFarlane <jgm@berkeley.edu>
@ -42,12 +43,14 @@ import qualified Control.Exception as E
import Control.Monad.Except (throwError) import Control.Monad.Except (throwError)
import Control.Monad import Control.Monad
import Control.Monad.Trans 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 as BS
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
import Data.Char (toLower, toUpper) import Data.Char (toLower, toUpper)
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Foldable (foldrM) import Data.Foldable (foldrM)
import GHC.Generics
import Data.List (intercalate, isPrefixOf, isSuffixOf, sort) import Data.List (intercalate, isPrefixOf, isSuffixOf, sort)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Maybe (fromMaybe, isJust, isNothing)
@ -65,7 +68,8 @@ import System.Directory (Permissions (..), doesFileExist, findExecutable,
import System.Environment (getArgs, getEnvironment, getProgName) import System.Environment (getArgs, getEnvironment, getProgName)
import System.Exit (ExitCode (..), exitSuccess) import System.Exit (ExitCode (..), exitSuccess)
import System.FilePath 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 System.IO.Error (isDoesNotExistError)
import Text.Pandoc import Text.Pandoc
import Text.Pandoc.Builder (setMeta) import Text.Pandoc.Builder (setMeta)
@ -86,6 +90,12 @@ import System.Posix.IO (stdOutput)
import System.Posix.Terminal (queryTerminal) import System.Posix.Terminal (queryTerminal)
#endif #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 :: [OptDescr (Opt -> IO Opt)] -> Opt -> IO Opt
parseOptions options' defaults = do parseOptions options' defaults = do
rawArgs <- map UTF8.decodeArg <$> getArgs rawArgs <- map UTF8.decodeArg <$> getArgs
@ -411,7 +421,10 @@ convertWithOpts opts = do
return $ ("csl", jatsEncoded) : optMetadata opts return $ ("csl", jatsEncoded) : optMetadata opts
else return $ 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 runIO' $ do
setResourcePath (optResourcePath opts) setResourcePath (optResourcePath opts)
@ -572,7 +585,11 @@ data Opt = Opt
, optIncludeInHeader :: [FilePath] -- ^ Files to include in header , optIncludeInHeader :: [FilePath] -- ^ Files to include in header
, optResourcePath :: [FilePath] -- ^ Path to search for images etc , optResourcePath :: [FilePath] -- ^ Path to search for images etc
, optEol :: Maybe Newline -- ^ Enforce line-endings , optEol :: Maybe Newline -- ^ Enforce line-endings
} } deriving (Generic, Show)
instance ToJSON Opt where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Opt
-- | Defaults for command-line options. -- | Defaults for command-line options.
defaultOpts :: Opt defaultOpts :: Opt
@ -790,7 +807,7 @@ writeFnBinary :: MonadIO m => FilePath -> B.ByteString -> m ()
writeFnBinary "-" = liftIO . B.putStr writeFnBinary "-" = liftIO . B.putStr
writeFnBinary f = liftIO . B.writeFile (UTF8.encodePath f) 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 "-" = liftIO . UTF8.putStrWith eol
writerFn eol f = liftIO . UTF8.writeFileWith eol f writerFn eol f = liftIO . UTF8.writeFileWith eol f

View file

@ -39,6 +39,7 @@ module Text.Pandoc.Logging (
, messageVerbosity , messageVerbosity
) where ) where
import Control.Monad (mzero)
import Data.Aeson import Data.Aeson
import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty',
keyOrder) keyOrder)
@ -56,6 +57,15 @@ data Verbosity = ERROR | WARNING | INFO | DEBUG
instance ToJSON Verbosity where instance ToJSON Verbosity where
toJSON x = toJSON (show x) 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 = data LogMessage =
SkippedContent String SourcePos SkippedContent String SourcePos

View file

@ -45,6 +45,8 @@ module Text.Pandoc.Options ( module Text.Pandoc.Extensions
, def , def
, isEnabled , isEnabled
) where ) where
import Data.Aeson (ToJSON(..), FromJSON(..),
genericToEncoding, defaultOptions)
import Data.Data (Data) import Data.Data (Data)
import Data.Default import Data.Default
import qualified Data.Set as Set import qualified Data.Set as Set
@ -104,17 +106,29 @@ data HTMLMathMethod = PlainMath
| KaTeX String String -- url of stylesheet and katex.js | KaTeX String String -- url of stylesheet and katex.js
deriving (Show, Read, Eq, Data, Typeable, Generic) 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 data CiteMethod = Citeproc -- use citeproc to render them
| Natbib -- output natbib cite commands | Natbib -- output natbib cite commands
| Biblatex -- output biblatex cite commands | Biblatex -- output biblatex cite commands
deriving (Show, Read, Eq, Data, Typeable, Generic) deriving (Show, Read, Eq, Data, Typeable, Generic)
instance ToJSON CiteMethod where
toEncoding = genericToEncoding defaultOptions
instance FromJSON CiteMethod
-- | Methods for obfuscating email addresses in HTML. -- | Methods for obfuscating email addresses in HTML.
data ObfuscationMethod = NoObfuscation data ObfuscationMethod = NoObfuscation
| ReferenceObfuscation | ReferenceObfuscation
| JavascriptObfuscation | JavascriptObfuscation
deriving (Show, Read, Eq, Data, Typeable, Generic) deriving (Show, Read, Eq, Data, Typeable, Generic)
instance ToJSON ObfuscationMethod where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ObfuscationMethod
-- | Varieties of HTML slide shows. -- | Varieties of HTML slide shows.
data HTMLSlideVariant = S5Slides data HTMLSlideVariant = S5Slides
| SlidySlides | SlidySlides
@ -124,18 +138,30 @@ data HTMLSlideVariant = S5Slides
| NoSlides | NoSlides
deriving (Show, Read, Eq, Data, Typeable, Generic) 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. -- | Options for accepting or rejecting MS Word track-changes.
data TrackChanges = AcceptChanges data TrackChanges = AcceptChanges
| RejectChanges | RejectChanges
| AllChanges | AllChanges
deriving (Show, Read, Eq, Data, Typeable, Generic) deriving (Show, Read, Eq, Data, Typeable, Generic)
instance ToJSON TrackChanges where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TrackChanges
-- | Options for wrapping text in the output. -- | Options for wrapping text in the output.
data WrapOption = WrapAuto -- ^ Automatically wrap to width data WrapOption = WrapAuto -- ^ Automatically wrap to width
| WrapNone -- ^ No non-semantic newlines | WrapNone -- ^ No non-semantic newlines
| WrapPreserve -- ^ Preserve wrapping of input source | WrapPreserve -- ^ Preserve wrapping of input source
deriving (Show, Read, Eq, Data, Typeable, Generic) 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. -- | Options defining the type of top-level headers.
data TopLevelDivision = TopLevelPart -- ^ Top-level headers become parts data TopLevelDivision = TopLevelPart -- ^ Top-level headers become parts
| TopLevelChapter -- ^ Top-level headers become chapters | TopLevelChapter -- ^ Top-level headers become chapters
@ -144,12 +170,20 @@ data TopLevelDivision = TopLevelPart -- ^ Top-level headers become parts
-- heuristics -- heuristics
deriving (Show, Read, Eq, Data, Typeable, Generic) 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 -- | Locations for footnotes and references in markdown output
data ReferenceLocation = EndOfBlock -- ^ End of block data ReferenceLocation = EndOfBlock -- ^ End of block
| EndOfSection -- ^ prior to next section header (or end of document) | EndOfSection -- ^ prior to next section header (or end of document)
| EndOfDocument -- ^ at end of document | EndOfDocument -- ^ at end of document
deriving (Show, Read, Eq, Data, Typeable, Generic) deriving (Show, Read, Eq, Data, Typeable, Generic)
instance ToJSON ReferenceLocation where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ReferenceLocation
-- | Options for writers -- | Options for writers
data WriterOptions = WriterOptions data WriterOptions = WriterOptions
{ writerTemplate :: Maybe String -- ^ Template to use { writerTemplate :: Maybe String -- ^ Template to use