hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
brittany.cabal
View File

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

1
src/Language/Haskell/Brittany/Internal/Config.hs
View File

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

86
src/Language/Haskell/Brittany/Internal/Config/Types.hs
View File

@ -185,92 +185,6 @@ instance Monoid (CConfig Option) where
mempty = gmempty
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
-- than old indentation + amount

114
src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs Normal file
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

1
src/Language/Haskell/Brittany/Internal/PreludeUtils.hs
View File

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