Change JSON instances for Opt to TemplateHaskell (#4083)
The `Generic` JSON instances for `Text.Pandoc.App.Opt` seem to tickle a particulary bad quadratic complexity case (Generics complexity is worse than quadratic with respect to the number of fields in the datatype). This is with GHC-8.2.1, I didn't test it using 8.0 but I assume it is similar. Using `Generic`, compilation of the `Text.Pandoc.App` module takes minutes and often gets killed due to out of memory on slower machines with "only" 8GB of accessible memory. This is particularly annoying to me since it means I cannot build pandoc on Travis. TemplateHaskell is a little uglier, but the module seems to compile within a few seconds, and compilation doesn't take more than 1GB of memory. Should I also change the other JSON instances throughout the codebase for consistency?
This commit is contained in:
parent
185918ea3d
commit
30c1e53c42
1 changed files with 6 additions and 10 deletions
|
@ -1,6 +1,7 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-
|
||||
Copyright (C) 2006-2017 John MacFarlane <jgm@berkeley.edu>
|
||||
|
@ -44,8 +45,8 @@ import qualified Control.Exception as E
|
|||
import Control.Monad
|
||||
import Control.Monad.Except (catchError, throwError)
|
||||
import Control.Monad.Trans
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..), defaultOptions, eitherDecode',
|
||||
encode, genericToEncoding)
|
||||
import Data.Aeson (defaultOptions, eitherDecode', encode)
|
||||
import Data.Aeson.TH (deriveJSON)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import Data.Char (toLower, toUpper)
|
||||
|
@ -95,10 +96,6 @@ import System.Posix.Terminal (queryTerminal)
|
|||
|
||||
data LineEnding = LF | CRLF | Native deriving (Show, Generic)
|
||||
|
||||
instance ToJSON LineEnding where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
instance FromJSON LineEnding
|
||||
|
||||
parseOptions :: [OptDescr (Opt -> IO Opt)] -> Opt -> IO Opt
|
||||
parseOptions options' defaults = do
|
||||
rawArgs <- map UTF8.decodeArg <$> getArgs
|
||||
|
@ -646,10 +643,6 @@ data Opt = Opt
|
|||
, optStripComments :: Bool -- ^ Skip HTML comments
|
||||
} deriving (Generic, Show)
|
||||
|
||||
instance ToJSON Opt where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
instance FromJSON Opt
|
||||
|
||||
-- | Defaults for command-line options.
|
||||
defaultOpts :: Opt
|
||||
defaultOpts = Opt
|
||||
|
@ -1677,3 +1670,6 @@ deprecatedOption o =
|
|||
\r -> case r of
|
||||
Right () -> return ()
|
||||
Left e -> E.throwIO e
|
||||
|
||||
$(deriveJSON defaultOptions ''LineEnding)
|
||||
$(deriveJSON defaultOptions ''Opt)
|
||||
|
|
Loading…
Reference in a new issue