{-# OPTIONS_GHC -fno-warn-orphans #-}
-- These optimizations are disabled to improve compile times (and compilation
-- memory usage). When we do not disable them, the CI servers take more than
-- 10 minutes to compile this module alone.
-- Having looked into aeson and how the instances are written, I still do
-- not understand what makes GHC choke so much here. The size of the raw
-- expressions below looks fairly negligible, so there must be some expansion
-- due to inlining going on. But even disabling INLINE pragmas in aeson did
-- not seem to change anything.
-- Nonetheless, this solution works and has no downsides because the
-- instances defined here are not in any way performance-critical.
{-# OPTIONS_GHC -fno-pre-inlining #-}
{-# OPTIONS_GHC -fno-specialise #-}
{-# OPTIONS_GHC -fignore-interface-pragmas #-}

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 :: Options
aesonDecodeOptionsBrittany = Options
Aeson.defaultOptions
  { omitNothingFields :: Bool
Aeson.omitNothingFields = Bool
True
  , fieldLabelModifier :: String -> String
Aeson.fieldLabelModifier = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'_')
  }

#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 :: Value -> Parser (CConfig Maybe)
parseJSON (Object Object
v) = Maybe (Last Int)
-> CDebugConfig Maybe
-> CLayoutConfig Maybe
-> CErrorHandlingConfig Maybe
-> CForwardOptions Maybe
-> CPreProcessorConfig Maybe
-> Maybe (Last Bool)
-> Maybe (Last Bool)
-> Maybe (Last Bool)
-> CConfig Maybe
forall (f :: * -> *).
f (Last Int)
-> CDebugConfig f
-> CLayoutConfig f
-> CErrorHandlingConfig f
-> CForwardOptions f
-> CPreProcessorConfig f
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> CConfig f
Config
    (Maybe (Last Int)
 -> CDebugConfig Maybe
 -> CLayoutConfig Maybe
 -> CErrorHandlingConfig Maybe
 -> CForwardOptions Maybe
 -> CPreProcessorConfig Maybe
 -> Maybe (Last Bool)
 -> Maybe (Last Bool)
 -> Maybe (Last Bool)
 -> CConfig Maybe)
-> Parser (Maybe (Last Int))
-> Parser
     (CDebugConfig Maybe
      -> CLayoutConfig Maybe
      -> CErrorHandlingConfig Maybe
      -> CForwardOptions Maybe
      -> CPreProcessorConfig Maybe
      -> Maybe (Last Bool)
      -> Maybe (Last Bool)
      -> Maybe (Last Bool)
      -> CConfig Maybe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe (Last Int))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?  String -> Text
Text.pack String
"conf_version"
    Parser
  (CDebugConfig Maybe
   -> CLayoutConfig Maybe
   -> CErrorHandlingConfig Maybe
   -> CForwardOptions Maybe
   -> CPreProcessorConfig Maybe
   -> Maybe (Last Bool)
   -> Maybe (Last Bool)
   -> Maybe (Last Bool)
   -> CConfig Maybe)
-> Parser (CDebugConfig Maybe)
-> Parser
     (CLayoutConfig Maybe
      -> CErrorHandlingConfig Maybe
      -> CForwardOptions Maybe
      -> CPreProcessorConfig Maybe
      -> Maybe (Last Bool)
      -> Maybe (Last Bool)
      -> Maybe (Last Bool)
      -> CConfig Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (CDebugConfig Maybe)
forall a. FromJSON a => Object -> Text -> Parser a
.:?= String -> Text
Text.pack String
"conf_debug"
    Parser
  (CLayoutConfig Maybe
   -> CErrorHandlingConfig Maybe
   -> CForwardOptions Maybe
   -> CPreProcessorConfig Maybe
   -> Maybe (Last Bool)
   -> Maybe (Last Bool)
   -> Maybe (Last Bool)
   -> CConfig Maybe)
-> Parser (CLayoutConfig Maybe)
-> Parser
     (CErrorHandlingConfig Maybe
      -> CForwardOptions Maybe
      -> CPreProcessorConfig Maybe
      -> Maybe (Last Bool)
      -> Maybe (Last Bool)
      -> Maybe (Last Bool)
      -> CConfig Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (CLayoutConfig Maybe)
forall a. FromJSON a => Object -> Text -> Parser a
.:?= String -> Text
Text.pack String
"conf_layout"
    Parser
  (CErrorHandlingConfig Maybe
   -> CForwardOptions Maybe
   -> CPreProcessorConfig Maybe
   -> Maybe (Last Bool)
   -> Maybe (Last Bool)
   -> Maybe (Last Bool)
   -> CConfig Maybe)
-> Parser (CErrorHandlingConfig Maybe)
-> Parser
     (CForwardOptions Maybe
      -> CPreProcessorConfig Maybe
      -> Maybe (Last Bool)
      -> Maybe (Last Bool)
      -> Maybe (Last Bool)
      -> CConfig Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (CErrorHandlingConfig Maybe)
forall a. FromJSON a => Object -> Text -> Parser a
.:?= String -> Text
Text.pack String
"conf_errorHandling"
    Parser
  (CForwardOptions Maybe
   -> CPreProcessorConfig Maybe
   -> Maybe (Last Bool)
   -> Maybe (Last Bool)
   -> Maybe (Last Bool)
   -> CConfig Maybe)
-> Parser (CForwardOptions Maybe)
-> Parser
     (CPreProcessorConfig Maybe
      -> Maybe (Last Bool)
      -> Maybe (Last Bool)
      -> Maybe (Last Bool)
      -> CConfig Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (CForwardOptions Maybe)
forall a. FromJSON a => Object -> Text -> Parser a
.:?= String -> Text
Text.pack String
"conf_forward"
    Parser
  (CPreProcessorConfig Maybe
   -> Maybe (Last Bool)
   -> Maybe (Last Bool)
   -> Maybe (Last Bool)
   -> CConfig Maybe)
-> Parser (CPreProcessorConfig Maybe)
-> Parser
     (Maybe (Last Bool)
      -> Maybe (Last Bool) -> Maybe (Last Bool) -> CConfig Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (CPreProcessorConfig Maybe)
forall a. FromJSON a => Object -> Text -> Parser a
.:?= String -> Text
Text.pack String
"conf_preprocessor"
    Parser
  (Maybe (Last Bool)
   -> Maybe (Last Bool) -> Maybe (Last Bool) -> CConfig Maybe)
-> Parser (Maybe (Last Bool))
-> Parser (Maybe (Last Bool) -> Maybe (Last Bool) -> CConfig Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Last Bool))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?  String -> Text
Text.pack String
"conf_roundtrip_exactprint_only"
    Parser (Maybe (Last Bool) -> Maybe (Last Bool) -> CConfig Maybe)
-> Parser (Maybe (Last Bool))
-> Parser (Maybe (Last Bool) -> CConfig Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Last Bool))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?  String -> Text
Text.pack String
"conf_disable_formatting"
    Parser (Maybe (Last Bool) -> CConfig Maybe)
-> Parser (Maybe (Last Bool)) -> Parser (CConfig Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe (Last Bool))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:?  String -> Text
Text.pack String
"conf_obfuscate"
  parseJSON Value
invalid    = String -> Value -> Parser (CConfig Maybe)
forall a. String -> Value -> Parser a
Aeson.typeMismatch String
"Config" Value
invalid

-- Pretends that the value is {} when the key is not present.
(.:?=) :: FromJSON a => Object -> Text -> Parser a
Object
o .:?= :: Object -> Text -> Parser a
.:?= Text
k = Object
o Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
k Parser (Maybe a) -> (Maybe a -> Parser a) -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser a -> (a -> Parser a) -> Maybe a -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON ([Pair] -> Value
Aeson.object [])) a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure