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