diff --git a/pandoc.cabal b/pandoc.cabal index 01e7b1153..94013af53 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -337,6 +337,11 @@ flag embed_data_files Description: Embed data files in binary for relocatable executable. Default: False +flag derive_json_via_th + Description: Use Template Haskell instead of GHC Generics to derive ToJSON + and FromJSON instances. + Default: True + flag trypandoc Description: Build trypandoc cgi executable. Default: False @@ -413,6 +418,8 @@ library cpp-options: -DEMBED_DATA_FILES build-depends: file-embed >= 0.0 && < 0.1 other-modules: Text.Pandoc.Data + if flag(derive_json_via_th) + cpp-options: -DDERIVE_JSON_VIA_TH if os(windows) cpp-options: -D_WINDOWS ghc-options: -Wall -fno-warn-unused-do-bind diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs index 9cbef3ee6..0fb88aeb3 100644 --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -2,8 +2,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} +#ifdef DERIVE_JSON_VIA_TH +{-# LANGUAGE TemplateHaskell #-} +#endif {- Copyright (C) 2006-2018 John MacFarlane @@ -46,7 +48,6 @@ import Control.Monad import Control.Monad.Trans import Data.Aeson.Encode.Pretty (encodePretty', Config(..), keyOrder, defConfig, Indent(..), NumberFormat(..)) -import Data.Aeson.TH (deriveJSON, defaultOptions) import Data.Char (toLower, toUpper) import Data.List (intercalate, sort) import Data.Maybe (fromMaybe) @@ -65,6 +66,13 @@ import Text.Pandoc.Writers.Math (defaultMathJaxURL, defaultKaTeXURL) import Text.Pandoc.Shared (ordNub, safeRead) import Text.Printf +#ifdef DERIVE_JSON_VIA_TH +import Data.Aeson.TH (deriveJSON, defaultOptions) +#else +import Data.Aeson (FromJSON (..), ToJSON (..), + defaultOptions, genericToEncoding) +#endif + #ifdef EMBED_DATA_FILES import Text.Pandoc.Data (dataFiles) import System.Directory (getAppUserDataDirectory) @@ -1086,5 +1094,15 @@ deprecatedOption o msg = -- see https://github.com/jgm/pandoc/pull/4083 -- using generic deriving caused long compilation times +#ifdef DERIVE_JSON_VIA_TH $(deriveJSON defaultOptions ''LineEnding) $(deriveJSON defaultOptions ''Opt) +#else +instance ToJSON LineEnding where + toEncoding = genericToEncoding defaultOptions +instance FromJSON LineEnding + +instance ToJSON Opt where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Opt +#endif diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs index b60c57497..495c6e5de 100644 --- a/src/Text/Pandoc/Extensions.hs +++ b/src/Text/Pandoc/Extensions.hs @@ -1,9 +1,11 @@ -{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +#ifndef AVOID_TEMPLATE_HASKELL {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} +#endif {- Copyright (C) 2012-2018 John MacFarlane @@ -50,8 +52,6 @@ module Text.Pandoc.Extensions ( Extension(..) , multimarkdownExtensions ) where import Prelude -import Data.Aeson (FromJSON (..), ToJSON (..), defaultOptions) -import Data.Aeson.TH (deriveJSON) import Data.Bits (clearBit, setBit, testBit, (.|.)) import Data.Data (Data) import Data.Typeable (Typeable) @@ -59,8 +59,15 @@ import GHC.Generics (Generic) import Text.Pandoc.Shared (safeRead) import Text.Parsec +#ifdef DERIVE_JSON_VIA_TH +import Data.Aeson.TH (deriveJSON, defaultOptions) +#else +import Data.Aeson (FromJSON (..), ToJSON (..), + defaultOptions, genericToEncoding) +#endif + newtype Extensions = Extensions Integer - deriving (Show, Read, Eq, Ord, Data, Typeable, Generic, ToJSON, FromJSON) + deriving (Show, Read, Eq, Ord, Data, Typeable, Generic) instance Semigroup Extensions where (Extensions a) <> (Extensions b) = Extensions (a .|. b) @@ -387,4 +394,15 @@ parseFormatSpec = parse formatSpec "" '-' -> disableExtension ext _ -> enableExtension ext +#ifdef DERIVE_JSON_VIA_TH $(deriveJSON defaultOptions ''Extension) +$(deriveJSON defaultOptions ''Extensions) +#else +instance ToJSON Extension where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Extension + +instance ToJSON Extensions where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Extensions +#endif diff --git a/src/Text/Pandoc/Filter.hs b/src/Text/Pandoc/Filter.hs index 1c25a5a6e..5f8a9fdee 100644 --- a/src/Text/Pandoc/Filter.hs +++ b/src/Text/Pandoc/Filter.hs @@ -1,5 +1,9 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} +#ifndef AVOID_TEMPLATE_HASKELL {-# LANGUAGE TemplateHaskell #-} +#endif {- Copyright (C) 2006-2018 John MacFarlane @@ -34,9 +38,14 @@ module Text.Pandoc.Filter ) where import Prelude -import Data.Aeson (defaultOptions) -import Data.Aeson.TH (deriveJSON) +#ifdef AVOID_TEMPLATE_HASKELL +import Data.Aeson (FromJSON (..), ToJSON (..), + defaultOptions, genericToEncoding) +#else +import Data.Aeson.TH (deriveJSON, defaultOptions) +#endif import Data.Foldable (foldrM) +import GHC.Generics (Generic) import Text.Pandoc.Class (PandocIO) import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.Options (ReaderOptions) @@ -47,7 +56,7 @@ import qualified Text.Pandoc.Filter.Path as Path -- | Type of filter and path to filter file. data Filter = LuaFilter FilePath | JSONFilter FilePath - deriving (Show) + deriving (Show, Generic) -- | Modify the given document using a filter. applyFilters :: ReaderOptions @@ -67,4 +76,10 @@ expandFilterPath :: Filter -> PandocIO Filter expandFilterPath (LuaFilter fp) = LuaFilter <$> Path.expandFilterPath fp expandFilterPath (JSONFilter fp) = JSONFilter <$> Path.expandFilterPath fp +#ifdef AVOID_TEMPLATE_HASKELL +instance ToJSON Filter where + toEncoding = genericToEncoding defaultOptions +instance FromJSON Filter +#else $(deriveJSON defaultOptions ''Filter) +#endif diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 204060d70..cea365ab4 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -1,7 +1,11 @@ -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} +#ifndef AVOID_TEMPLATE_HASKELL {-# LANGUAGE TemplateHaskell #-} +#endif + {- Copyright (C) 2012-2018 John MacFarlane @@ -48,8 +52,6 @@ module Text.Pandoc.Options ( module Text.Pandoc.Extensions , isEnabled ) where import Prelude -import Data.Aeson (defaultOptions) -import Data.Aeson.TH (deriveJSON) import Data.Data (Data) import Data.Default import qualified Data.Set as Set @@ -59,6 +61,13 @@ import Skylighting (SyntaxMap, defaultSyntaxMap) import Text.Pandoc.Extensions import Text.Pandoc.Highlighting (Style, pygments) +#ifdef DERIVE_JSON_VIA_TH +import Data.Aeson.TH (deriveJSON, defaultOptions) +#else +import Data.Aeson (FromJSON (..), ToJSON (..), + defaultOptions, genericToEncoding) +#endif + class HasSyntaxExtensions a where getExtensions :: a -> Extensions @@ -239,6 +248,7 @@ instance HasSyntaxExtensions WriterOptions where isEnabled :: HasSyntaxExtensions a => Extension -> a -> Bool isEnabled ext opts = ext `extensionEnabled` getExtensions opts +#ifdef DERIVE_JSON_VIA_TH $(deriveJSON defaultOptions ''ReaderOptions) $(deriveJSON defaultOptions ''HTMLMathMethod) $(deriveJSON defaultOptions ''CiteMethod) @@ -248,3 +258,40 @@ $(deriveJSON defaultOptions ''TrackChanges) $(deriveJSON defaultOptions ''WrapOption) $(deriveJSON defaultOptions ''TopLevelDivision) $(deriveJSON defaultOptions ''ReferenceLocation) +#else +instance ToJSON CiteMethod where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CiteMethod + +instance ToJSON ReaderOptions where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ReaderOptions + +instance ToJSON ObfuscationMethod where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ObfuscationMethod + +instance ToJSON WrapOption where + toEncoding = genericToEncoding defaultOptions +instance FromJSON WrapOption + +instance ToJSON HTMLMathMethod where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HTMLMathMethod + +instance ToJSON HTMLSlideVariant where + toEncoding = genericToEncoding defaultOptions +instance FromJSON HTMLSlideVariant + +instance ToJSON TopLevelDivision where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TopLevelDivision + +instance ToJSON ReferenceLocation where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ReferenceLocation + +instance ToJSON TrackChanges where + toEncoding = genericToEncoding defaultOptions +instance FromJSON TrackChanges +#endif