module Language.Haskell.Brittany.Internal.Config
  ( CConfig(..)
  , CDebugConfig(..)
  , CLayoutConfig(..)
  , DebugConfig
  , LayoutConfig
  , Config
  , cmdlineConfigParser
  , staticDefaultConfig
  , forwardOptionsSyntaxExtsEnabled
  , readConfig
  , userConfigPath
  , findLocalConfigPath
  , readConfigs
  , readConfigsWithUserConfig
  , writeDefaultConfig
  , showConfigYaml
  )
where



#include "prelude.inc"

import           Language.Haskell.Brittany.Internal.Types
import           Language.Haskell.Brittany.Internal.LayouterBasics

import qualified Data.Yaml
import           Data.CZipWith

import           UI.Butcher.Monadic
import           Data.Monoid                    ( (<>) )

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
                                                )
import qualified Data.List.NonEmpty            as NonEmpty

import qualified System.Directory              as Directory
import qualified System.FilePath.Posix         as FilePath

-- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft }
staticDefaultConfig :: Config
staticDefaultConfig :: Config
staticDefaultConfig = Config :: 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
  { _conf_version :: Identity (Last Int)
_conf_version                   = Int -> Identity (Last Int)
coerce (Int
1 :: Int)
  , _conf_debug :: CDebugConfig Identity
_conf_debug                     = DebugConfig :: forall (f :: * -> *).
f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> CDebugConfig f
DebugConfig
    { _dconf_dump_config :: Identity (Last Bool)
_dconf_dump_config                = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_dump_annotations :: Identity (Last Bool)
_dconf_dump_annotations           = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_dump_ast_unknown :: Identity (Last Bool)
_dconf_dump_ast_unknown           = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_dump_ast_full :: Identity (Last Bool)
_dconf_dump_ast_full              = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_dump_bridoc_raw :: Identity (Last Bool)
_dconf_dump_bridoc_raw            = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_dump_bridoc_simpl_alt :: Identity (Last Bool)
_dconf_dump_bridoc_simpl_alt      = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_dump_bridoc_simpl_floating :: Identity (Last Bool)
_dconf_dump_bridoc_simpl_floating = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_dump_bridoc_simpl_par :: Identity (Last Bool)
_dconf_dump_bridoc_simpl_par      = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_dump_bridoc_simpl_columns :: Identity (Last Bool)
_dconf_dump_bridoc_simpl_columns  = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_dump_bridoc_simpl_indent :: Identity (Last Bool)
_dconf_dump_bridoc_simpl_indent   = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_dump_bridoc_final :: Identity (Last Bool)
_dconf_dump_bridoc_final          = Bool -> Identity (Last Bool)
coerce Bool
False
    , _dconf_roundtrip_exactprint_only :: Identity (Last Bool)
_dconf_roundtrip_exactprint_only  = Bool -> Identity (Last Bool)
coerce Bool
False
    }
  , _conf_layout :: CLayoutConfig Identity
_conf_layout                    = LayoutConfig :: forall (f :: * -> *).
f (Last Int)
-> f (Last IndentPolicy)
-> f (Last Int)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Int)
-> f (Last Int)
-> f (Last AltChooser)
-> f (Last ColumnAlignMode)
-> f (Last Int)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> CLayoutConfig f
LayoutConfig
    { _lconfig_cols :: Identity (Last Int)
_lconfig_cols                          = Int -> Identity (Last Int)
coerce (Int
80 :: Int)
    , _lconfig_indentPolicy :: Identity (Last IndentPolicy)
_lconfig_indentPolicy                  = IndentPolicy -> Identity (Last IndentPolicy)
coerce IndentPolicy
IndentPolicyFree
    , _lconfig_indentAmount :: Identity (Last Int)
_lconfig_indentAmount                  = Int -> Identity (Last Int)
coerce (Int
2 :: Int)
    , _lconfig_indentWhereSpecial :: Identity (Last Bool)
_lconfig_indentWhereSpecial            = Bool -> Identity (Last Bool)
coerce Bool
True
    , _lconfig_indentListSpecial :: Identity (Last Bool)
_lconfig_indentListSpecial             = Bool -> Identity (Last Bool)
coerce Bool
True
    , _lconfig_importColumn :: Identity (Last Int)
_lconfig_importColumn                  = Int -> Identity (Last Int)
coerce (Int
50 :: Int)
    , _lconfig_importAsColumn :: Identity (Last Int)
_lconfig_importAsColumn                = Int -> Identity (Last Int)
coerce (Int
50 :: Int)
    , _lconfig_altChooser :: Identity (Last AltChooser)
_lconfig_altChooser = AltChooser -> Identity (Last AltChooser)
coerce (Int -> AltChooser
AltChooserBoundedSearch Int
3)
    , _lconfig_columnAlignMode :: Identity (Last ColumnAlignMode)
_lconfig_columnAlignMode = ColumnAlignMode -> Identity (Last ColumnAlignMode)
coerce (Float -> ColumnAlignMode
ColumnAlignModeMajority Float
0.7)
    , _lconfig_alignmentLimit :: Identity (Last Int)
_lconfig_alignmentLimit                = Int -> Identity (Last Int)
coerce (Int
30 :: Int)
    , _lconfig_alignmentBreakOnMultiline :: Identity (Last Bool)
_lconfig_alignmentBreakOnMultiline     = Bool -> Identity (Last Bool)
coerce Bool
True
    , _lconfig_hangingTypeSignature :: Identity (Last Bool)
_lconfig_hangingTypeSignature          = Bool -> Identity (Last Bool)
coerce Bool
False
    , _lconfig_reformatModulePreamble :: Identity (Last Bool)
_lconfig_reformatModulePreamble        = Bool -> Identity (Last Bool)
coerce Bool
True
    , _lconfig_allowSingleLineExportList :: Identity (Last Bool)
_lconfig_allowSingleLineExportList     = Bool -> Identity (Last Bool)
coerce Bool
False
    , _lconfig_allowHangingQuasiQuotes :: Identity (Last Bool)
_lconfig_allowHangingQuasiQuotes       = Bool -> Identity (Last Bool)
coerce Bool
True
    , _lconfig_experimentalSemicolonNewlines :: Identity (Last Bool)
_lconfig_experimentalSemicolonNewlines = Bool -> Identity (Last Bool)
coerce Bool
False
    -- , _lconfig_allowSinglelineRecord     = coerce False
    }
  , _conf_errorHandling :: CErrorHandlingConfig Identity
_conf_errorHandling             = ErrorHandlingConfig :: forall (f :: * -> *).
f (Last Bool)
-> f (Last Bool)
-> f (Last ExactPrintFallbackMode)
-> f (Last Bool)
-> CErrorHandlingConfig f
ErrorHandlingConfig
    { _econf_produceOutputOnErrors :: Identity (Last Bool)
_econf_produceOutputOnErrors   = Bool -> Identity (Last Bool)
coerce Bool
False
    , _econf_Werror :: Identity (Last Bool)
_econf_Werror                  = Bool -> Identity (Last Bool)
coerce Bool
False
    , _econf_ExactPrintFallback :: Identity (Last ExactPrintFallbackMode)
_econf_ExactPrintFallback      = ExactPrintFallbackMode -> Identity (Last ExactPrintFallbackMode)
coerce ExactPrintFallbackMode
ExactPrintFallbackModeInline
    , _econf_omit_output_valid_check :: Identity (Last Bool)
_econf_omit_output_valid_check = Bool -> Identity (Last Bool)
coerce Bool
False
    }
  , _conf_preprocessor :: CPreProcessorConfig Identity
_conf_preprocessor              = PreProcessorConfig :: forall (f :: * -> *).
f (Last CPPMode) -> f (Last Bool) -> CPreProcessorConfig f
PreProcessorConfig
    { _ppconf_CPPMode :: Identity (Last CPPMode)
_ppconf_CPPMode            = CPPMode -> Identity (Last CPPMode)
coerce CPPMode
CPPModeAbort
    , _ppconf_hackAroundIncludes :: Identity (Last Bool)
_ppconf_hackAroundIncludes = Bool -> Identity (Last Bool)
coerce Bool
False
    }
  , _conf_forward :: CForwardOptions Identity
_conf_forward = ForwardOptions :: forall (f :: * -> *). f [String] -> CForwardOptions f
ForwardOptions { _options_ghc :: Identity [String]
_options_ghc = [String] -> Identity [String]
forall a. a -> Identity a
Identity [] }
  , _conf_roundtrip_exactprint_only :: Identity (Last Bool)
_conf_roundtrip_exactprint_only = Bool -> Identity (Last Bool)
coerce Bool
False
  , _conf_disable_formatting :: Identity (Last Bool)
_conf_disable_formatting        = Bool -> Identity (Last Bool)
coerce Bool
False
  , _conf_obfuscate :: Identity (Last Bool)
_conf_obfuscate                 = Bool -> Identity (Last Bool)
coerce Bool
False
  }

forwardOptionsSyntaxExtsEnabled :: ForwardOptions
forwardOptionsSyntaxExtsEnabled :: CForwardOptions Identity
forwardOptionsSyntaxExtsEnabled = ForwardOptions :: forall (f :: * -> *). f [String] -> CForwardOptions f
ForwardOptions
  { _options_ghc :: Identity [String]
_options_ghc = [String] -> Identity [String]
forall a. a -> Identity a
Identity
                     [ String
"-XLambdaCase"
                     , String
"-XMultiWayIf"
                     , String
"-XGADTs"
                     , String
"-XPatternGuards"
                     , String
"-XViewPatterns"
                     , String
"-XTupleSections"
                     , String
"-XExplicitForAll"
                     , String
"-XImplicitParams"
                     , String
"-XQuasiQuotes"
                     , String
"-XTemplateHaskell"
                     , String
"-XBangPatterns"
                     , String
"-XTypeApplications"
                     ]
  }

-- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft, lconfig_cols: 200 }
cmdlineConfigParser :: CmdParser Identity out (CConfig Option)
cmdlineConfigParser :: CmdParser Identity out (CConfig Option)
cmdlineConfigParser = do
  -- TODO: why does the default not trigger; ind never should be []!!
  [Int]
ind                <- String
-> [String] -> String -> Flag Int -> CmdParser Identity out [Int]
forall (f :: * -> *) p out.
(Applicative f, Typeable p, Read p, Show p) =>
String -> [String] -> String -> Flag p -> CmdParser f out [p]
addFlagReadParams String
"" [String
"indent"] String
"AMOUNT" (String -> Flag Int
forall p. String -> Flag p
flagHelpStr String
"spaces per indentation level")
  [Int]
cols               <- String
-> [String] -> String -> Flag Int -> CmdParser Identity out [Int]
forall (f :: * -> *) p out.
(Applicative f, Typeable p, Read p, Show p) =>
String -> [String] -> String -> Flag p -> CmdParser f out [p]
addFlagReadParams String
"" [String
"columns"] String
"AMOUNT" (String -> Flag Int
forall p. String -> Flag p
flagHelpStr String
"target max columns (80 is an old default for this)")
  [Int]
importCol          <- String
-> [String] -> String -> Flag Int -> CmdParser Identity out [Int]
forall (f :: * -> *) p out.
(Applicative f, Typeable p, Read p, Show p) =>
String -> [String] -> String -> Flag p -> CmdParser f out [p]
addFlagReadParams String
"" [String
"import-col"] String
"N" (String -> Flag Int
forall p. String -> Flag p
flagHelpStr String
"column to align import lists at")
  [Int]
importAsCol        <- String
-> [String] -> String -> Flag Int -> CmdParser Identity out [Int]
forall (f :: * -> *) p out.
(Applicative f, Typeable p, Read p, Show p) =>
String -> [String] -> String -> Flag p -> CmdParser f out [p]
addFlagReadParams String
"" [String
"import-as-col"] String
"N" (String -> Flag Int
forall p. String -> Flag p
flagHelpStr String
"column to qualified-as module names at")

  Bool
dumpConfig         <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-config"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the programs full config (merged commandline + file + defaults)")
  Bool
dumpAnnotations    <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-annotations"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the full annotations returned by ghc-exactprint")
  Bool
dumpUnknownAST     <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-ast-unknown"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the ast for any nodes not transformed, but copied as-is by brittany")
  Bool
dumpCompleteAST    <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-ast-full"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the full ast")
  Bool
dumpBriDocRaw      <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-bridoc-raw"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the pre-transformation bridoc")
  Bool
dumpBriDocAlt      <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-bridoc-alt"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the partially transformed bridoc: after transformation: alt")
  Bool
dumpBriDocPar      <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-bridoc-par"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the partially transformed bridoc: after transformation: par")
  Bool
dumpBriDocFloating <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-bridoc-floating"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the partially transformed bridoc: after transformation: floating")
  Bool
dumpBriDocColumns  <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-bridoc-columns"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the partially transformed bridoc: after transformation: columns")
  Bool
dumpBriDocIndent   <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-bridoc-indent"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the partially transformed bridoc: after transformation: indent")
  Bool
dumpBriDocFinal    <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"dump-bridoc-final"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"dump the post-transformation bridoc")

  Bool
outputOnErrors     <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"output-on-errors"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"even when there are errors, produce output (or try to to the degree possible)")
  Bool
wError             <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"werror"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"treat warnings as errors")
  Bool
omitValidCheck     <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"omit-output-check"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"omit checking if the output is syntactically valid (debugging)")

  Bool
roundtripOnly      <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"exactprint-only"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"do not reformat, but exclusively use exactprint to roundtrip (debugging)")

  [String]
optionsGhc         <- String
-> [String]
-> String
-> Flag Void
-> CmdParser Identity out [String]
forall (f :: * -> *) out.
Applicative f =>
String
-> [String] -> String -> Flag Void -> CmdParser f out [String]
addFlagStringParams String
"" [String
"ghc-options"] String
"STRING" (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"allows to define default language extensions. The parameter is forwarded to ghc.")
  Bool
disableFormatting  <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"disable-formatting"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"parse, but don't transform the input at all. Useful for inline config for specific modules.")
  Bool
obfuscate          <- String -> [String] -> Flag Void -> CmdParser Identity out Bool
forall (f :: * -> *) out.
Applicative f =>
String -> [String] -> Flag Void -> CmdParser f out Bool
addSimpleBoolFlag String
"" [String
"obfuscate"] (Doc -> Flag Void
forall p. Doc -> Flag p
flagHelp (Doc -> Flag Void) -> Doc -> Flag Void
forall a b. (a -> b) -> a -> b
$ String -> Doc
parDoc String
"apply obfuscator to the output.")

  CConfig Option -> CmdParser Identity out (CConfig Option)
forall (m :: * -> *) a. Monad m => a -> m a
return (CConfig Option -> CmdParser Identity out (CConfig Option))
-> CConfig Option -> CmdParser Identity out (CConfig Option)
forall a b. (a -> b) -> a -> b
$ Config :: 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
    { _conf_version :: Option (Last Int)
_conf_version                   = Option (Last Int)
forall a. Monoid a => a
mempty
    , _conf_debug :: CDebugConfig Option
_conf_debug                     = DebugConfig :: forall (f :: * -> *).
f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> CDebugConfig f
DebugConfig
      { _dconf_dump_config :: Option (Last Bool)
_dconf_dump_config                = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpConfig
      , _dconf_dump_annotations :: Option (Last Bool)
_dconf_dump_annotations           = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpAnnotations
      , _dconf_dump_ast_unknown :: Option (Last Bool)
_dconf_dump_ast_unknown           = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpUnknownAST
      , _dconf_dump_ast_full :: Option (Last Bool)
_dconf_dump_ast_full              = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpCompleteAST
      , _dconf_dump_bridoc_raw :: Option (Last Bool)
_dconf_dump_bridoc_raw            = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpBriDocRaw
      , _dconf_dump_bridoc_simpl_alt :: Option (Last Bool)
_dconf_dump_bridoc_simpl_alt      = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpBriDocAlt
      , _dconf_dump_bridoc_simpl_par :: Option (Last Bool)
_dconf_dump_bridoc_simpl_par      = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpBriDocPar
      , _dconf_dump_bridoc_simpl_floating :: Option (Last Bool)
_dconf_dump_bridoc_simpl_floating = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpBriDocFloating
      , _dconf_dump_bridoc_simpl_columns :: Option (Last Bool)
_dconf_dump_bridoc_simpl_columns  = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpBriDocColumns
      , _dconf_dump_bridoc_simpl_indent :: Option (Last Bool)
_dconf_dump_bridoc_simpl_indent   = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpBriDocIndent
      , _dconf_dump_bridoc_final :: Option (Last Bool)
_dconf_dump_bridoc_final          = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
dumpBriDocFinal
      , _dconf_roundtrip_exactprint_only :: Option (Last Bool)
_dconf_roundtrip_exactprint_only  = Option (Last Bool)
forall a. Monoid a => a
mempty
      }
    , _conf_layout :: CLayoutConfig Option
_conf_layout                    = LayoutConfig :: forall (f :: * -> *).
f (Last Int)
-> f (Last IndentPolicy)
-> f (Last Int)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Int)
-> f (Last Int)
-> f (Last AltChooser)
-> f (Last ColumnAlignMode)
-> f (Last Int)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> f (Last Bool)
-> CLayoutConfig f
LayoutConfig
      { _lconfig_cols :: Option (Last Int)
_lconfig_cols                          = [Int] -> Option (Last Int)
forall (f :: * -> *) a.
(Semigroup (f a), Applicative f) =>
[a] -> Option (f a)
optionConcat [Int]
cols
      , _lconfig_indentPolicy :: Option (Last IndentPolicy)
_lconfig_indentPolicy                  = Option (Last IndentPolicy)
forall a. Monoid a => a
mempty
      , _lconfig_indentAmount :: Option (Last Int)
_lconfig_indentAmount                  = [Int] -> Option (Last Int)
forall (f :: * -> *) a.
(Semigroup (f a), Applicative f) =>
[a] -> Option (f a)
optionConcat [Int]
ind
      , _lconfig_indentWhereSpecial :: Option (Last Bool)
_lconfig_indentWhereSpecial            = Option (Last Bool)
forall a. Monoid a => a
mempty -- falseToNothing _
      , _lconfig_indentListSpecial :: Option (Last Bool)
_lconfig_indentListSpecial             = Option (Last Bool)
forall a. Monoid a => a
mempty -- falseToNothing _
      , _lconfig_importColumn :: Option (Last Int)
_lconfig_importColumn                  = [Int] -> Option (Last Int)
forall (f :: * -> *) a.
(Semigroup (f a), Applicative f) =>
[a] -> Option (f a)
optionConcat [Int]
importCol
      , _lconfig_importAsColumn :: Option (Last Int)
_lconfig_importAsColumn                = [Int] -> Option (Last Int)
forall (f :: * -> *) a.
(Semigroup (f a), Applicative f) =>
[a] -> Option (f a)
optionConcat [Int]
importAsCol
      , _lconfig_altChooser :: Option (Last AltChooser)
_lconfig_altChooser                    = Option (Last AltChooser)
forall a. Monoid a => a
mempty
      , _lconfig_columnAlignMode :: Option (Last ColumnAlignMode)
_lconfig_columnAlignMode               = Option (Last ColumnAlignMode)
forall a. Monoid a => a
mempty
      , _lconfig_alignmentLimit :: Option (Last Int)
_lconfig_alignmentLimit                = Option (Last Int)
forall a. Monoid a => a
mempty
      , _lconfig_alignmentBreakOnMultiline :: Option (Last Bool)
_lconfig_alignmentBreakOnMultiline     = Option (Last Bool)
forall a. Monoid a => a
mempty
      , _lconfig_hangingTypeSignature :: Option (Last Bool)
_lconfig_hangingTypeSignature          = Option (Last Bool)
forall a. Monoid a => a
mempty
      , _lconfig_reformatModulePreamble :: Option (Last Bool)
_lconfig_reformatModulePreamble        = Option (Last Bool)
forall a. Monoid a => a
mempty
      , _lconfig_allowSingleLineExportList :: Option (Last Bool)
_lconfig_allowSingleLineExportList     = Option (Last Bool)
forall a. Monoid a => a
mempty
      , _lconfig_allowHangingQuasiQuotes :: Option (Last Bool)
_lconfig_allowHangingQuasiQuotes       = Option (Last Bool)
forall a. Monoid a => a
mempty
      , _lconfig_experimentalSemicolonNewlines :: Option (Last Bool)
_lconfig_experimentalSemicolonNewlines = Option (Last Bool)
forall a. Monoid a => a
mempty
      -- , _lconfig_allowSinglelineRecord     = mempty
      }
    , _conf_errorHandling :: CErrorHandlingConfig Option
_conf_errorHandling             = ErrorHandlingConfig :: forall (f :: * -> *).
f (Last Bool)
-> f (Last Bool)
-> f (Last ExactPrintFallbackMode)
-> f (Last Bool)
-> CErrorHandlingConfig f
ErrorHandlingConfig
      { _econf_produceOutputOnErrors :: Option (Last Bool)
_econf_produceOutputOnErrors   = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
outputOnErrors
      , _econf_Werror :: Option (Last Bool)
_econf_Werror                  = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
wError
      , _econf_ExactPrintFallback :: Option (Last ExactPrintFallbackMode)
_econf_ExactPrintFallback      = Option (Last ExactPrintFallbackMode)
forall a. Monoid a => a
mempty
      , _econf_omit_output_valid_check :: Option (Last Bool)
_econf_omit_output_valid_check = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
omitValidCheck
      }
    , _conf_preprocessor :: CPreProcessorConfig Option
_conf_preprocessor              = PreProcessorConfig :: forall (f :: * -> *).
f (Last CPPMode) -> f (Last Bool) -> CPreProcessorConfig f
PreProcessorConfig { _ppconf_CPPMode :: Option (Last CPPMode)
_ppconf_CPPMode = Option (Last CPPMode)
forall a. Monoid a => a
mempty, _ppconf_hackAroundIncludes :: Option (Last Bool)
_ppconf_hackAroundIncludes = Option (Last Bool)
forall a. Monoid a => a
mempty }
    , _conf_forward :: CForwardOptions Option
_conf_forward                   = ForwardOptions :: forall (f :: * -> *). f [String] -> CForwardOptions f
ForwardOptions { _options_ghc :: Option [String]
_options_ghc = [ [String]
optionsGhc [String] -> ([String] -> String) -> String
forall a b. a -> (a -> b) -> b
& [String] -> String
List.unwords String -> (String -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& String -> [String]
CmdArgs.splitArgs | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
optionsGhc ] }
    , _conf_roundtrip_exactprint_only :: Option (Last Bool)
_conf_roundtrip_exactprint_only = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
roundtripOnly
    , _conf_disable_formatting :: Option (Last Bool)
_conf_disable_formatting        = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
disableFormatting
    , _conf_obfuscate :: Option (Last Bool)
_conf_obfuscate                 = Option Bool -> Option (Last Bool)
forall a. Option a -> Option (Last a)
wrapLast (Option Bool -> Option (Last Bool))
-> Option Bool -> Option (Last Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Option Bool
falseToNothing Bool
obfuscate
    }
 where
  falseToNothing :: Bool -> Option Bool
falseToNothing = Maybe Bool -> Option Bool
forall a. Maybe a -> Option a
Option (Maybe Bool -> Option Bool)
-> (Bool -> Maybe Bool) -> Bool -> Option Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bool -> Maybe Bool -> Bool -> Maybe Bool
forall a. a -> a -> Bool -> a
Bool.bool Maybe Bool
forall a. Maybe a
Nothing (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
  wrapLast :: Option a -> Option (Semigroup.Last a)
  wrapLast :: Option a -> Option (Last a)
wrapLast = (a -> Last a) -> Option a -> Option (Last a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Last a
forall a. a -> Last a
Semigroup.Last
  optionConcat :: (Semigroup.Semigroup (f a), Applicative f) => [a] -> Option (f a)
  optionConcat :: [a] -> Option (f a)
optionConcat = [Option (f a)] -> Option (f a)
forall a. Monoid a => [a] -> a
mconcat ([Option (f a)] -> Option (f a))
-> ([a] -> [Option (f a)]) -> [a] -> Option (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Option (f a)) -> [a] -> [Option (f a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (f a -> Option (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> Option (f a)) -> (a -> f a) -> a -> Option (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

-- configParser :: Parser Config
-- configParser = Config
--   <$> option (eitherReader $ maybe (Left "required <int>!") Right . readMaybe)
--         (long "indent" <> value 2 <> metavar "AMOUNT" <> help "spaces per indentation level")
--   <*> (Bar
--     <$> switch (long "bara" <> help "bara help")
--     <*> switch (long "barb")
--     <*> flag 3 5 (long "barc")
--   )
--
-- configParserInfo :: ParserInfo Config
-- configParserInfo = ParserInfo
--   { infoParser      = configParser
--   , infoFullDesc    = True
--   , infoProgDesc    = return $ PP.text "a haskell code formatting utility based on ghc-exactprint"
--   , infoHeader      = return $ PP.text "brittany"
--   , infoFooter      = empty
--   , infoFailureCode = (-55)
--   , infoIntersperse = True
--   }


-- | Reads a config from a file. If the file does not exist, returns
-- Nothing. If the file exists and parsing fails, prints to stderr and
-- aborts the MaybeT. Otherwise succeed via Just.
-- If the second parameter is True and the file does not exist, writes the
-- staticDefaultConfig to the file.
readConfig
  :: MonadIO m => System.IO.FilePath -> MaybeT m (Maybe (CConfig Option))
readConfig :: String -> MaybeT m (Maybe (CConfig Option))
readConfig String
path = do
  -- TODO: probably should catch IOErrors and then omit the existence check.
  Bool
exists <- IO Bool -> MaybeT m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT m Bool) -> IO Bool -> MaybeT m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
System.Directory.doesFileExist String
path
  if Bool
exists
    then do
      ByteString
contents <- IO ByteString -> MaybeT m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> MaybeT m ByteString)
-> IO ByteString -> MaybeT m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
ByteString.readFile String
path -- no lazy IO, tyvm.
      CConfig Option
fileConf <- case ByteString -> Either ParseException (CConfig Option)
forall a. FromJSON a => ByteString -> Either ParseException a
Data.Yaml.decodeEither' ByteString
contents of
        Left ParseException
e -> do
          IO () -> MaybeT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$  String -> IO ()
putStrErrLn
            (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$  String
"error reading in brittany config from "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
          IO () -> MaybeT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT m ()) -> IO () -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrErrLn (ParseException -> String
Data.Yaml.prettyPrintParseException ParseException
e)
          MaybeT m (CConfig Option)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
        Right CConfig Option
x -> CConfig Option -> MaybeT m (CConfig Option)
forall (m :: * -> *) a. Monad m => a -> m a
return CConfig Option
x
      Maybe (CConfig Option) -> MaybeT m (Maybe (CConfig Option))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CConfig Option) -> MaybeT m (Maybe (CConfig Option)))
-> Maybe (CConfig Option) -> MaybeT m (Maybe (CConfig Option))
forall a b. (a -> b) -> a -> b
$ CConfig Option -> Maybe (CConfig Option)
forall a. a -> Maybe a
Just CConfig Option
fileConf
    else Maybe (CConfig Option) -> MaybeT m (Maybe (CConfig Option))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CConfig Option) -> MaybeT m (Maybe (CConfig Option)))
-> Maybe (CConfig Option) -> MaybeT m (Maybe (CConfig Option))
forall a b. (a -> b) -> a -> b
$ Maybe (CConfig Option)
forall a. Maybe a
Nothing

-- | Looks for a user-global config file and return its path.
-- If there is no global config in a system, one will be created.
userConfigPath :: IO System.IO.FilePath
userConfigPath :: IO String
userConfigPath = do
  String
userBritPathSimple <- String -> IO String
Directory.getAppUserDataDirectory String
"brittany"
  String
userBritPathXdg    <- XdgDirectory -> String -> IO String
Directory.getXdgDirectory XdgDirectory
Directory.XdgConfig String
"brittany"
  let searchDirs :: [String]
searchDirs = [String
userBritPathSimple, String
userBritPathXdg]
  Maybe String
globalConfig <- (String -> IO Bool) -> [String] -> String -> IO (Maybe String)
Directory.findFileWith String -> IO Bool
Directory.doesFileExist
                                         [String]
searchDirs
                                         String
"config.yaml"
  IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO String
forall (m :: * -> *). MonadIO m => String -> m String
writeUserConfig String
userBritPathXdg) String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
globalConfig
 where
  writeUserConfig :: String -> m String
writeUserConfig String
dir = do
    let createConfPath :: String
createConfPath = String
dir String -> String -> String
FilePath.</> String
"config.yaml"
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
Directory.createDirectoryIfMissing Bool
True String
dir
    String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
writeDefaultConfig (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
createConfPath
    String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
createConfPath

-- | Searches for a local (per-project) brittany config starting from a given directory
findLocalConfigPath :: System.IO.FilePath -> IO (Maybe System.IO.FilePath)
findLocalConfigPath :: String -> IO (Maybe String)
findLocalConfigPath String
dir = do
  let dirParts :: [String]
dirParts   = String -> [String]
FilePath.splitDirectories String
dir
  -- when provided dir is "a/b/c", searchDirs is ["a/b/c", "a/b", "a", "/"]
  let searchDirs :: [String]
searchDirs = [String] -> String
FilePath.joinPath ([String] -> String) -> [[String]] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[String]] -> [[String]]
forall a. [a] -> [a]
reverse ([String] -> [[String]]
forall a. [a] -> [[a]]
List.inits [String]
dirParts)
  (String -> IO Bool) -> [String] -> String -> IO (Maybe String)
Directory.findFileWith String -> IO Bool
Directory.doesFileExist [String]
searchDirs String
"brittany.yaml"

-- | Reads specified configs.
readConfigs
  :: CConfig Option        -- ^ Explicit options, take highest priority
  -> [System.IO.FilePath]  -- ^ List of config files to load and merge, highest priority first
  -> MaybeT IO Config
readConfigs :: CConfig Option -> [String] -> MaybeT IO Config
readConfigs CConfig Option
cmdlineConfig [String]
configPaths = do
  [Maybe (CConfig Option)]
configs <- String -> MaybeT IO (Maybe (CConfig Option))
forall (m :: * -> *).
MonadIO m =>
String -> MaybeT m (Maybe (CConfig Option))
readConfig (String -> MaybeT IO (Maybe (CConfig Option)))
-> [String] -> MaybeT IO [Maybe (CConfig Option)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [String]
configPaths
  let merged :: CConfig Option
merged = NonEmpty (CConfig Option) -> CConfig Option
forall a. Semigroup a => NonEmpty a -> a
Semigroup.sconcat
        (NonEmpty (CConfig Option) -> CConfig Option)
-> NonEmpty (CConfig Option) -> CConfig Option
forall a b. (a -> b) -> a -> b
$ NonEmpty (CConfig Option) -> NonEmpty (CConfig Option)
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse (CConfig Option
cmdlineConfig CConfig Option -> [CConfig Option] -> NonEmpty (CConfig Option)
forall a. a -> [a] -> NonEmpty a
:| [Maybe (CConfig Option)] -> [CConfig Option]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (CConfig Option)]
configs)
  Config -> MaybeT IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> MaybeT IO Config) -> Config -> MaybeT IO Config
forall a b. (a -> b) -> a -> b
$ (forall a. Identity a -> Option a -> Identity a)
-> Config -> CConfig Option -> Config
forall (k :: (* -> *) -> *) (g :: * -> *) (h :: * -> *)
       (i :: * -> *).
CZipWith k =>
(forall a. g a -> h a -> i a) -> k g -> k h -> k i
cZipWith forall a. Identity a -> Option a -> Identity a
fromOptionIdentity Config
staticDefaultConfig CConfig Option
merged

-- | Reads provided configs
-- but also applies the user default configuration (with lowest priority)
readConfigsWithUserConfig
  :: CConfig Option        -- ^ Explicit options, take highest priority
  -> [System.IO.FilePath]  -- ^ List of config files to load and merge, highest priority first
  -> MaybeT IO Config
readConfigsWithUserConfig :: CConfig Option -> [String] -> MaybeT IO Config
readConfigsWithUserConfig CConfig Option
cmdlineConfig [String]
configPaths = do
  String
defaultPath <- IO String -> MaybeT IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> MaybeT IO String) -> IO String -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ IO String
userConfigPath
  CConfig Option -> [String] -> MaybeT IO Config
readConfigs CConfig Option
cmdlineConfig ([String]
configPaths [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
defaultPath])

writeDefaultConfig :: MonadIO m => System.IO.FilePath -> m ()
writeDefaultConfig :: String -> m ()
writeDefaultConfig String
path =
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
ByteString.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ CConfig Option -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Yaml.encode (CConfig Option -> ByteString) -> CConfig Option -> ByteString
forall a b. (a -> b) -> a -> b
$ (forall a. Identity a -> Option a) -> Config -> CConfig Option
forall (c :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
CFunctor c =>
(forall a. f a -> g a) -> c f -> c g
cMap
    (Maybe a -> Option a
forall a. Maybe a -> Option a
Option (Maybe a -> Option a)
-> (Identity a -> Maybe a) -> Identity a -> Option a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Identity a -> a) -> Identity a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity)
    Config
staticDefaultConfig

showConfigYaml :: Config -> String
showConfigYaml :: Config -> String
showConfigYaml = ByteString -> String
Data.ByteString.Char8.unpack (ByteString -> String)
-> (Config -> ByteString) -> Config -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CConfig Maybe -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Yaml.encode (CConfig Maybe -> ByteString)
-> (Config -> CConfig Maybe) -> Config -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Identity a -> Maybe a) -> Config -> CConfig Maybe
forall (c :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
CFunctor c =>
(forall a. f a -> g a) -> c f -> c g
cMap
  (\(Identity x) -> a -> Maybe a
forall a. a -> Maybe a
Just a
x)