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
parent
722f03aa11
commit
6f4eec245e
|
@ -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"
|
||||||
}
|
}
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -1,3 +1,4 @@
|
||||||
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
module Language.Haskell.Brittany.Internal.PreludeUtils
|
module Language.Haskell.Brittany.Internal.PreludeUtils
|
||||||
where
|
where
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue