Split up Config/Types.hs

for the compilation of that module, GHC max residency
was an astounding 600MB for Config/Types.hs;
for Config/Types/Instances.hs it now "only" is 480MB.
(numbers according to "+RTS -s", the real usage
accoding to `time` is about 20% higher even.)
pull/51/head
Lennart Spitzner 2017-08-15 20:37:46 +02:00
parent 722f03aa11
commit 6f4eec245e
5 changed files with 117 additions and 91 deletions

View File

@ -59,6 +59,7 @@ library {
Language.Haskell.Brittany.Internal.Utils Language.Haskell.Brittany.Internal.Utils
Language.Haskell.Brittany.Internal.Config Language.Haskell.Brittany.Internal.Config
Language.Haskell.Brittany.Internal.Config.Types Language.Haskell.Brittany.Internal.Config.Types
Language.Haskell.Brittany.Internal.Config.Types.Instances
Paths_brittany Paths_brittany
} }
other-modules: { other-modules: {
@ -81,7 +82,6 @@ library {
-Wall -Wall
-j -j
-fno-warn-unused-imports -fno-warn-unused-imports
-fno-warn-orphans
-fno-warn-redundant-constraints -fno-warn-redundant-constraints
} }
if flag(brittany-dev) { if flag(brittany-dev) {
@ -206,7 +206,6 @@ executable brittany
-j -j
-fno-spec-constr -fno-spec-constr
-fno-warn-unused-imports -fno-warn-unused-imports
-fno-warn-orphans
-fno-warn-redundant-constraints -fno-warn-redundant-constraints
-rtsopts -rtsopts
-with-rtsopts "-M2G" -with-rtsopts "-M2G"
@ -286,7 +285,6 @@ test-suite unittests
-Wall -Wall
-j -j
-fno-warn-unused-imports -fno-warn-unused-imports
-fno-warn-orphans
-rtsopts -rtsopts
-with-rtsopts "-M2G" -with-rtsopts "-M2G"
} }
@ -360,7 +358,6 @@ test-suite littests
-Wall -Wall
-j -j
-fno-warn-unused-imports -fno-warn-unused-imports
-fno-warn-orphans
-rtsopts -rtsopts
-with-rtsopts "-M2G" -with-rtsopts "-M2G"
} }
@ -400,7 +397,6 @@ test-suite libinterfacetests
-Wall -Wall
-j -j
-fno-warn-unused-imports -fno-warn-unused-imports
-fno-warn-orphans
-rtsopts -rtsopts
-with-rtsopts "-M2G" -with-rtsopts "-M2G"
} }

View File

@ -27,6 +27,7 @@ import UI.Butcher.Monadic
import qualified System.Console.CmdArgs.Explicit as CmdArgs import qualified System.Console.CmdArgs.Explicit as CmdArgs
import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Config.Types
import Language.Haskell.Brittany.Internal.Config.Types.Instances
import Language.Haskell.Brittany.Internal.Utils import Language.Haskell.Brittany.Internal.Utils
import Data.Coerce ( Coercible, coerce ) import Data.Coerce ( Coercible, coerce )

View File

@ -185,92 +185,6 @@ instance Monoid (CConfig Option) where
mempty = gmempty mempty = gmempty
mappend = gmappend mappend = gmappend
aesonDecodeOptionsBrittany :: Aeson.Options
aesonDecodeOptionsBrittany = Aeson.defaultOptions
{ Aeson.omitNothingFields = True
, Aeson.fieldLabelModifier = dropWhile (=='_')
}
#define makeFromJSON(type)\
instance FromJSON (type) where\
parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
#define makeToJSON(type)\
instance ToJSON (type) where\
toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany;\
toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany
#define makeFromJSONMaybe(type)\
instance FromJSON (type Maybe) where\
parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
#define makeFromJSONOption(type)\
instance FromJSON (type Option) where\
parseJSON = fmap (cMap Option) . parseJSON
#define makeToJSONMaybe(type)\
instance ToJSON (type Maybe) where\
toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany;\
toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany
#define makeToJSONOption(type)\
instance ToJSON (type Option) where\
toJSON = toJSON . cMap getOption;\
toEncoding = toEncoding . cMap getOption
makeFromJSONOption(CDebugConfig)
makeFromJSONMaybe(CDebugConfig)
makeToJSONOption(CDebugConfig)
makeToJSONMaybe(CDebugConfig)
makeFromJSON(IndentPolicy)
makeToJSON(IndentPolicy)
makeFromJSON(AltChooser)
makeToJSON(AltChooser)
makeFromJSON(ColumnAlignMode)
makeToJSON(ColumnAlignMode)
makeFromJSON(CPPMode)
makeToJSON(CPPMode)
makeFromJSON(ExactPrintFallbackMode)
makeToJSON(ExactPrintFallbackMode)
makeFromJSONOption(CLayoutConfig)
makeFromJSONMaybe(CLayoutConfig)
makeToJSONOption(CLayoutConfig)
makeToJSONMaybe(CLayoutConfig)
makeFromJSONOption(CErrorHandlingConfig)
makeFromJSONMaybe(CErrorHandlingConfig)
makeToJSONOption(CErrorHandlingConfig)
makeToJSONMaybe(CErrorHandlingConfig)
makeFromJSONOption(CForwardOptions)
makeFromJSONMaybe(CForwardOptions)
makeToJSONOption(CForwardOptions)
makeToJSONMaybe(CForwardOptions)
makeFromJSONOption(CPreProcessorConfig)
makeFromJSONMaybe(CPreProcessorConfig)
makeToJSONOption(CPreProcessorConfig)
makeToJSONMaybe(CPreProcessorConfig)
makeFromJSONOption(CConfig)
makeToJSONOption(CConfig)
makeToJSONMaybe(CConfig)
-- This custom instance ensures the "omitNothingFields" behaviour not only for
-- leafs, but for nodes of the config as well. This way e.g. "{}" is valid
-- config file content.
instance FromJSON (CConfig Maybe) where
parseJSON (Object v) = Config
<$> v .:? Text.pack "conf_version"
<*> v .:?= Text.pack "conf_debug"
<*> v .:?= Text.pack "conf_layout"
<*> v .:?= Text.pack "conf_errorHandling"
<*> v .:?= Text.pack "conf_forward"
<*> v .:?= Text.pack "conf_preprocessor"
parseJSON invalid = Aeson.typeMismatch "Config" invalid
-- Pretends that the value is {} when the key is not present.
(.:?=) :: FromJSON a => Object -> Text -> Parser a
o .:?= k = o .:? k >>= maybe (parseJSON (Aeson.object [])) pure
data IndentPolicy = IndentPolicyLeft -- never create a new indentation at more data IndentPolicy = IndentPolicyLeft -- never create a new indentation at more
-- than old indentation + amount -- than old indentation + amount

View File

@ -0,0 +1,114 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.Haskell.Brittany.Internal.Config.Types.Instances
where
#include "prelude.inc"
import Data.Yaml
import qualified Data.Aeson.Types as Aeson
import Language.Haskell.Brittany.Internal.Config.Types
import GHC.Generics
aesonDecodeOptionsBrittany :: Aeson.Options
aesonDecodeOptionsBrittany = Aeson.defaultOptions
{ Aeson.omitNothingFields = True
, Aeson.fieldLabelModifier = dropWhile (=='_')
}
#define makeFromJSON(type)\
instance FromJSON (type) where\
parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany;\
{-# NOINLINE parseJSON #-}
#define makeToJSON(type)\
instance ToJSON (type) where\
toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany;\
{-# NOINLINE toJSON #-};\
toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany;\
{-# NOINLINE toEncoding #-}
#define makeFromJSONMaybe(type)\
instance FromJSON (type Maybe) where\
parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany;\
{-# NOINLINE parseJSON #-}
#define makeFromJSONOption(type)\
instance FromJSON (type Option) where\
parseJSON = fmap (cMap Option) . parseJSON;\
{-# NOINLINE parseJSON #-}
#define makeToJSONMaybe(type)\
instance ToJSON (type Maybe) where\
toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany;\
{-# NOINLINE toJSON #-};\
toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany;\
{-# NOINLINE toEncoding #-}
#define makeToJSONOption(type)\
instance ToJSON (type Option) where\
toJSON = toJSON . cMap getOption;\
{-# NOINLINE toJSON #-};\
toEncoding = toEncoding . cMap getOption;\
{-# NOINLINE toEncoding #-}
makeFromJSONOption(CDebugConfig)
makeFromJSONMaybe(CDebugConfig)
makeToJSONOption(CDebugConfig)
makeToJSONMaybe(CDebugConfig)
makeFromJSON(IndentPolicy)
makeToJSON(IndentPolicy)
makeFromJSON(AltChooser)
makeToJSON(AltChooser)
makeFromJSON(ColumnAlignMode)
makeToJSON(ColumnAlignMode)
makeFromJSON(CPPMode)
makeToJSON(CPPMode)
makeFromJSON(ExactPrintFallbackMode)
makeToJSON(ExactPrintFallbackMode)
makeFromJSONOption(CLayoutConfig)
makeFromJSONMaybe(CLayoutConfig)
makeToJSONOption(CLayoutConfig)
makeToJSONMaybe(CLayoutConfig)
makeFromJSONOption(CErrorHandlingConfig)
makeFromJSONMaybe(CErrorHandlingConfig)
makeToJSONOption(CErrorHandlingConfig)
makeToJSONMaybe(CErrorHandlingConfig)
makeFromJSONOption(CForwardOptions)
makeFromJSONMaybe(CForwardOptions)
makeToJSONOption(CForwardOptions)
makeToJSONMaybe(CForwardOptions)
makeFromJSONOption(CPreProcessorConfig)
makeFromJSONMaybe(CPreProcessorConfig)
makeToJSONOption(CPreProcessorConfig)
makeToJSONMaybe(CPreProcessorConfig)
makeFromJSONOption(CConfig)
makeToJSONOption(CConfig)
makeToJSONMaybe(CConfig)
-- This custom instance ensures the "omitNothingFields" behaviour not only for
-- leafs, but for nodes of the config as well. This way e.g. "{}" is valid
-- config file content.
instance FromJSON (CConfig Maybe) where
parseJSON (Object v) = Config
<$> v .:? Text.pack "conf_version"
<*> v .:?= Text.pack "conf_debug"
<*> v .:?= Text.pack "conf_layout"
<*> v .:?= Text.pack "conf_errorHandling"
<*> v .:?= Text.pack "conf_forward"
<*> v .:?= Text.pack "conf_preprocessor"
parseJSON invalid = Aeson.typeMismatch "Config" invalid
-- Pretends that the value is {} when the key is not present.
(.:?=) :: FromJSON a => Object -> Text -> Parser a
o .:?= k = o .:? k >>= maybe (parseJSON (Aeson.object [])) pure

View File

@ -1,3 +1,4 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.Haskell.Brittany.Internal.PreludeUtils module Language.Haskell.Brittany.Internal.PreludeUtils
where where