From 6f4eec245e3450703c55e96064382bb55d87a81c Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Tue, 15 Aug 2017 20:37:46 +0200
Subject: [PATCH] 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.)
---
 brittany.cabal                                |   6 +-
 .../Haskell/Brittany/Internal/Config.hs       |   1 +
 .../Haskell/Brittany/Internal/Config/Types.hs |  86 -------------
 .../Internal/Config/Types/Instances.hs        | 114 ++++++++++++++++++
 .../Haskell/Brittany/Internal/PreludeUtils.hs |   1 +
 5 files changed, 117 insertions(+), 91 deletions(-)
 create mode 100644 src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs

diff --git a/brittany.cabal b/brittany.cabal
index 83ddbe5..b95e0eb 100644
--- a/brittany.cabal
+++ b/brittany.cabal
@@ -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"
   }
diff --git a/src/Language/Haskell/Brittany/Internal/Config.hs b/src/Language/Haskell/Brittany/Internal/Config.hs
index ba6b1af..49651d7 100644
--- a/src/Language/Haskell/Brittany/Internal/Config.hs
+++ b/src/Language/Haskell/Brittany/Internal/Config.hs
@@ -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 )
diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types.hs b/src/Language/Haskell/Brittany/Internal/Config/Types.hs
index 18fc30f..4fd4765 100644
--- a/src/Language/Haskell/Brittany/Internal/Config/Types.hs
+++ b/src/Language/Haskell/Brittany/Internal/Config/Types.hs
@@ -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
diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs b/src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs
new file mode 100644
index 0000000..13019bb
--- /dev/null
+++ b/src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs
@@ -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
+
diff --git a/src/Language/Haskell/Brittany/Internal/PreludeUtils.hs b/src/Language/Haskell/Brittany/Internal/PreludeUtils.hs
index 807b0f9..d34690c 100644
--- a/src/Language/Haskell/Brittany/Internal/PreludeUtils.hs
+++ b/src/Language/Haskell/Brittany/Internal/PreludeUtils.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 module Language.Haskell.Brittany.Internal.PreludeUtils
 where