aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorAlbert Krewinkel <albert@zeitkraut.de>2018-11-04 20:51:08 +0100
committerAlbert Krewinkel <albert@zeitkraut.de>2018-11-04 20:51:08 +0100
commitdc150df8e19f13e836fde05f5401b0f99288815b (patch)
tree2dc4417055f9e69bd77dc74f7aba6b339bc00259 /src/Text
parent41b8ad6dd710c747c7f2e8541b0760b731d5be0b (diff)
downloadpandoc-dc150df8e19f13e836fde05f5401b0f99288815b.tar.gz
Add cabal flag `derive_json_via_th`
Disabling the flag will cause derivation of ToJSON and FromJSON instances via GHC Generics instead of Template Haskell. The flag is enabled by default, as deriving via Generics can be slow (see #4083).
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/App/CommandLineOptions.hs22
-rw-r--r--src/Text/Pandoc/Extensions.hs26
-rw-r--r--src/Text/Pandoc/Filter.hs21
-rw-r--r--src/Text/Pandoc/Options.hs53
4 files changed, 110 insertions, 12 deletions
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 <jgm@berkeley.edu>
@@ -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 <jgm@berkeley.edu>
@@ -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 <jgm@berkeley.edu>
@@ -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 <jgm@berkeley.edu>
@@ -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