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

Autoformat Config.hs

pull/279/head
Lennart Spitzner 2020-01-23 13:34:07 +01:00
parent 03e2b62c24
commit fad9db8fd8
1 changed files with 97 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -29,24 +29,28 @@ import qualified Data.Yaml
import Data.CZipWith import Data.CZipWith
import UI.Butcher.Monadic import UI.Butcher.Monadic
import Data.Monoid ((<>)) import Data.Monoid ( (<>) )
import qualified System.Console.CmdArgs.Explicit as CmdArgs import qualified System.Console.CmdArgs.Explicit
as CmdArgs
import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Config.Types
import Language.Haskell.Brittany.Internal.Config.Types.Instances import Language.Haskell.Brittany.Internal.Config.Types.Instances
import Language.Haskell.Brittany.Internal.Utils import Language.Haskell.Brittany.Internal.Utils
import Data.Coerce ( Coercible, coerce ) import Data.Coerce ( Coercible
import qualified Data.List.NonEmpty as NonEmpty , coerce
)
import qualified Data.List.NonEmpty as NonEmpty
import qualified System.Directory as Directory import qualified System.Directory as Directory
import qualified System.FilePath.Posix as FilePath import qualified System.FilePath.Posix as FilePath
-- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft }
staticDefaultConfig :: Config staticDefaultConfig :: Config
staticDefaultConfig = Config staticDefaultConfig = Config
{ _conf_version = coerce (1 :: Int) { _conf_version = coerce (1 :: Int)
, _conf_debug = DebugConfig , _conf_debug = DebugConfig
{ _dconf_dump_config = coerce False { _dconf_dump_config = coerce False
, _dconf_dump_annotations = coerce False , _dconf_dump_annotations = coerce False
, _dconf_dump_ast_unknown = coerce False , _dconf_dump_ast_unknown = coerce False
@ -60,62 +64,60 @@ staticDefaultConfig = Config
, _dconf_dump_bridoc_final = coerce False , _dconf_dump_bridoc_final = coerce False
, _dconf_roundtrip_exactprint_only = coerce False , _dconf_roundtrip_exactprint_only = coerce False
} }
, _conf_layout = LayoutConfig , _conf_layout = LayoutConfig
{ _lconfig_cols = coerce (80 :: Int) { _lconfig_cols = coerce (80 :: Int)
, _lconfig_indentPolicy = coerce IndentPolicyFree , _lconfig_indentPolicy = coerce IndentPolicyFree
, _lconfig_indentAmount = coerce (2 :: Int) , _lconfig_indentAmount = coerce (2 :: Int)
, _lconfig_indentWhereSpecial = coerce True , _lconfig_indentWhereSpecial = coerce True
, _lconfig_indentListSpecial = coerce True , _lconfig_indentListSpecial = coerce True
, _lconfig_importColumn = coerce (50 :: Int) , _lconfig_importColumn = coerce (50 :: Int)
, _lconfig_importAsColumn = coerce (50 :: Int) , _lconfig_importAsColumn = coerce (50 :: Int)
, _lconfig_altChooser = coerce (AltChooserBoundedSearch 3) , _lconfig_altChooser = coerce (AltChooserBoundedSearch 3)
, _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7) , _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7)
, _lconfig_alignmentLimit = coerce (30 :: Int) , _lconfig_alignmentLimit = coerce (30 :: Int)
, _lconfig_alignmentBreakOnMultiline = coerce True , _lconfig_alignmentBreakOnMultiline = coerce True
, _lconfig_hangingTypeSignature = coerce False , _lconfig_hangingTypeSignature = coerce False
, _lconfig_reformatModulePreamble = coerce True , _lconfig_reformatModulePreamble = coerce True
, _lconfig_allowSingleLineExportList = coerce False , _lconfig_allowSingleLineExportList = coerce False
, _lconfig_allowHangingQuasiQuotes = coerce True , _lconfig_allowHangingQuasiQuotes = coerce True
, _lconfig_experimentalSemicolonNewlines = coerce False , _lconfig_experimentalSemicolonNewlines = coerce False
-- , _lconfig_allowSinglelineRecord = coerce False -- , _lconfig_allowSinglelineRecord = coerce False
} }
, _conf_errorHandling = ErrorHandlingConfig , _conf_errorHandling = ErrorHandlingConfig
{ _econf_produceOutputOnErrors = coerce False { _econf_produceOutputOnErrors = coerce False
, _econf_Werror = coerce False , _econf_Werror = coerce False
, _econf_ExactPrintFallback = coerce ExactPrintFallbackModeInline , _econf_ExactPrintFallback = coerce ExactPrintFallbackModeInline
, _econf_omit_output_valid_check = coerce False , _econf_omit_output_valid_check = coerce False
} }
, _conf_preprocessor = PreProcessorConfig , _conf_preprocessor = PreProcessorConfig
{ _ppconf_CPPMode = coerce CPPModeAbort { _ppconf_CPPMode = coerce CPPModeAbort
, _ppconf_hackAroundIncludes = coerce False , _ppconf_hackAroundIncludes = coerce False
} }
, _conf_forward = ForwardOptions , _conf_forward = ForwardOptions { _options_ghc = Identity [] }
{ _options_ghc = Identity [] , _conf_roundtrip_exactprint_only = coerce False
} , _conf_disable_formatting = coerce False
, _conf_roundtrip_exactprint_only = coerce False , _conf_obfuscate = coerce False
, _conf_disable_formatting = coerce False
, _conf_obfuscate = coerce False
} }
forwardOptionsSyntaxExtsEnabled :: ForwardOptions forwardOptionsSyntaxExtsEnabled :: ForwardOptions
forwardOptionsSyntaxExtsEnabled = ForwardOptions forwardOptionsSyntaxExtsEnabled = ForwardOptions
{ _options_ghc = Identity { _options_ghc = Identity
[ "-XLambdaCase" [ "-XLambdaCase"
, "-XMultiWayIf" , "-XMultiWayIf"
, "-XGADTs" , "-XGADTs"
, "-XPatternGuards" , "-XPatternGuards"
, "-XViewPatterns" , "-XViewPatterns"
, "-XTupleSections" , "-XTupleSections"
, "-XExplicitForAll" , "-XExplicitForAll"
, "-XImplicitParams" , "-XImplicitParams"
, "-XQuasiQuotes" , "-XQuasiQuotes"
, "-XTemplateHaskell" , "-XTemplateHaskell"
, "-XBangPatterns" , "-XBangPatterns"
, "-XTypeApplications" , "-XTypeApplications"
] ]
} }
-- brittany-next-binding --columns=200 -- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft, lconfig_cols: 200 }
cmdlineConfigParser :: CmdParser Identity out (CConfig Option) cmdlineConfigParser :: CmdParser Identity out (CConfig Option)
cmdlineConfigParser = do cmdlineConfigParser = do
-- TODO: why does the default not trigger; ind never should be []!! -- TODO: why does the default not trigger; ind never should be []!!
@ -131,29 +133,24 @@ cmdlineConfigParser = do
dumpBriDocRaw <- addSimpleBoolFlag "" ["dump-bridoc-raw"] (flagHelp $ parDoc "dump the pre-transformation bridoc") dumpBriDocRaw <- addSimpleBoolFlag "" ["dump-bridoc-raw"] (flagHelp $ parDoc "dump the pre-transformation bridoc")
dumpBriDocAlt <- addSimpleBoolFlag "" ["dump-bridoc-alt"] (flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: alt") dumpBriDocAlt <- addSimpleBoolFlag "" ["dump-bridoc-alt"] (flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: alt")
dumpBriDocPar <- addSimpleBoolFlag "" ["dump-bridoc-par"] (flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: par") dumpBriDocPar <- addSimpleBoolFlag "" ["dump-bridoc-par"] (flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: par")
dumpBriDocFloating <- addSimpleBoolFlag "" dumpBriDocFloating <- addSimpleBoolFlag "" ["dump-bridoc-floating"] (flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: floating")
["dump-bridoc-floating"] dumpBriDocColumns <- addSimpleBoolFlag "" ["dump-bridoc-columns"] (flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: columns")
(flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: floating") dumpBriDocIndent <- addSimpleBoolFlag "" ["dump-bridoc-indent"] (flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: indent")
dumpBriDocColumns <- addSimpleBoolFlag "" ["dump-bridoc-columns"] (flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: columns") dumpBriDocFinal <- addSimpleBoolFlag "" ["dump-bridoc-final"] (flagHelp $ parDoc "dump the post-transformation bridoc")
dumpBriDocIndent <- addSimpleBoolFlag "" ["dump-bridoc-indent"] (flagHelp $ parDoc "dump the partially transformed bridoc: after transformation: indent")
dumpBriDocFinal <- addSimpleBoolFlag "" ["dump-bridoc-final"] (flagHelp $ parDoc "dump the post-transformation bridoc")
outputOnErrors <- addSimpleBoolFlag "" ["output-on-errors"] (flagHelp $ parDoc "even when there are errors, produce output (or try to to the degree possible)") outputOnErrors <- addSimpleBoolFlag "" ["output-on-errors"] (flagHelp $ parDoc "even when there are errors, produce output (or try to to the degree possible)")
wError <- addSimpleBoolFlag "" ["werror"] (flagHelp $ parDoc "treat warnings as errors") wError <- addSimpleBoolFlag "" ["werror"] (flagHelp $ parDoc "treat warnings as errors")
omitValidCheck <- addSimpleBoolFlag "" ["omit-output-check"] (flagHelp $ parDoc "omit checking if the output is syntactically valid (debugging)") omitValidCheck <- addSimpleBoolFlag "" ["omit-output-check"] (flagHelp $ parDoc "omit checking if the output is syntactically valid (debugging)")
roundtripOnly <- addSimpleBoolFlag "" ["exactprint-only"] (flagHelp $ parDoc "do not reformat, but exclusively use exactprint to roundtrip (debugging)") roundtripOnly <- addSimpleBoolFlag "" ["exactprint-only"] (flagHelp $ parDoc "do not reformat, but exclusively use exactprint to roundtrip (debugging)")
optionsGhc <- addFlagStringParams "" optionsGhc <- addFlagStringParams "" ["ghc-options"] "STRING" (flagHelp $ parDoc "allows to define default language extensions. The parameter is forwarded to ghc.")
["ghc-options"] disableFormatting <- addSimpleBoolFlag "" ["disable-formatting"] (flagHelp $ parDoc "parse, but don't transform the input at all. Useful for inline config for specific modules.")
"STRING" obfuscate <- addSimpleBoolFlag "" ["obfuscate"] (flagHelp $ parDoc "apply obfuscator to the output.")
(flagHelp $ parDoc "allows to define default language extensions. The parameter is forwarded to ghc.")
disableFormatting <- addSimpleBoolFlag "" ["disable-formatting"] (flagHelp $ parDoc "parse, but don't transform the input at all. Useful for inline config for specific modules.")
obfuscate <- addSimpleBoolFlag "" ["obfuscate"] (flagHelp $ parDoc "apply obfuscator to the output.")
return $ Config return $ Config
{ _conf_version = mempty { _conf_version = mempty
, _conf_debug = DebugConfig , _conf_debug = DebugConfig
{ _dconf_dump_config = wrapLast $ falseToNothing dumpConfig { _dconf_dump_config = wrapLast $ falseToNothing dumpConfig
, _dconf_dump_annotations = wrapLast $ falseToNothing dumpAnnotations , _dconf_dump_annotations = wrapLast $ falseToNothing dumpAnnotations
, _dconf_dump_ast_unknown = wrapLast $ falseToNothing dumpUnknownAST , _dconf_dump_ast_unknown = wrapLast $ falseToNothing dumpUnknownAST
@ -167,41 +164,36 @@ cmdlineConfigParser = do
, _dconf_dump_bridoc_final = wrapLast $ falseToNothing dumpBriDocFinal , _dconf_dump_bridoc_final = wrapLast $ falseToNothing dumpBriDocFinal
, _dconf_roundtrip_exactprint_only = mempty , _dconf_roundtrip_exactprint_only = mempty
} }
, _conf_layout = LayoutConfig , _conf_layout = LayoutConfig
{ _lconfig_cols = optionConcat cols { _lconfig_cols = optionConcat cols
, _lconfig_indentPolicy = mempty , _lconfig_indentPolicy = mempty
, _lconfig_indentAmount = optionConcat ind , _lconfig_indentAmount = optionConcat ind
, _lconfig_indentWhereSpecial = mempty -- falseToNothing _ , _lconfig_indentWhereSpecial = mempty -- falseToNothing _
, _lconfig_indentListSpecial = mempty -- falseToNothing _ , _lconfig_indentListSpecial = mempty -- falseToNothing _
, _lconfig_importColumn = optionConcat importCol , _lconfig_importColumn = optionConcat importCol
, _lconfig_importAsColumn = optionConcat importAsCol , _lconfig_importAsColumn = optionConcat importAsCol
, _lconfig_altChooser = mempty , _lconfig_altChooser = mempty
, _lconfig_columnAlignMode = mempty , _lconfig_columnAlignMode = mempty
, _lconfig_alignmentLimit = mempty , _lconfig_alignmentLimit = mempty
, _lconfig_alignmentBreakOnMultiline = mempty , _lconfig_alignmentBreakOnMultiline = mempty
, _lconfig_hangingTypeSignature = mempty , _lconfig_hangingTypeSignature = mempty
, _lconfig_reformatModulePreamble = mempty , _lconfig_reformatModulePreamble = mempty
, _lconfig_allowSingleLineExportList = mempty , _lconfig_allowSingleLineExportList = mempty
, _lconfig_allowHangingQuasiQuotes = mempty , _lconfig_allowHangingQuasiQuotes = mempty
, _lconfig_experimentalSemicolonNewlines = mempty , _lconfig_experimentalSemicolonNewlines = mempty
-- , _lconfig_allowSinglelineRecord = mempty -- , _lconfig_allowSinglelineRecord = mempty
} }
, _conf_errorHandling = ErrorHandlingConfig , _conf_errorHandling = ErrorHandlingConfig
{ _econf_produceOutputOnErrors = wrapLast $ falseToNothing outputOnErrors { _econf_produceOutputOnErrors = wrapLast $ falseToNothing outputOnErrors
, _econf_Werror = wrapLast $ falseToNothing wError , _econf_Werror = wrapLast $ falseToNothing wError
, _econf_ExactPrintFallback = mempty , _econf_ExactPrintFallback = mempty
, _econf_omit_output_valid_check = wrapLast $ falseToNothing omitValidCheck , _econf_omit_output_valid_check = wrapLast $ falseToNothing omitValidCheck
} }
, _conf_preprocessor = PreProcessorConfig , _conf_preprocessor = PreProcessorConfig { _ppconf_CPPMode = mempty, _ppconf_hackAroundIncludes = mempty }
{ _ppconf_CPPMode = mempty , _conf_forward = ForwardOptions { _options_ghc = [ optionsGhc & List.unwords & CmdArgs.splitArgs | not $ null optionsGhc ] }
, _ppconf_hackAroundIncludes = mempty , _conf_roundtrip_exactprint_only = wrapLast $ falseToNothing roundtripOnly
} , _conf_disable_formatting = wrapLast $ falseToNothing disableFormatting
, _conf_forward = ForwardOptions , _conf_obfuscate = wrapLast $ falseToNothing obfuscate
{ _options_ghc = [ optionsGhc & List.unwords & CmdArgs.splitArgs | not $ null optionsGhc ]
}
, _conf_roundtrip_exactprint_only = wrapLast $ falseToNothing roundtripOnly
, _conf_disable_formatting = wrapLast $ falseToNothing disableFormatting
, _conf_obfuscate = wrapLast $ falseToNothing obfuscate
} }
where where
falseToNothing = Option . Bool.bool Nothing (Just True) falseToNothing = Option . Bool.bool Nothing (Just True)
@ -265,19 +257,21 @@ userConfigPath = do
userBritPathSimple <- Directory.getAppUserDataDirectory "brittany" userBritPathSimple <- Directory.getAppUserDataDirectory "brittany"
userBritPathXdg <- Directory.getXdgDirectory Directory.XdgConfig "brittany" userBritPathXdg <- Directory.getXdgDirectory Directory.XdgConfig "brittany"
let searchDirs = [userBritPathSimple, userBritPathXdg] let searchDirs = [userBritPathSimple, userBritPathXdg]
globalConfig <- Directory.findFileWith Directory.doesFileExist searchDirs "config.yaml" globalConfig <- Directory.findFileWith Directory.doesFileExist
searchDirs
"config.yaml"
maybe (writeUserConfig userBritPathXdg) pure globalConfig maybe (writeUserConfig userBritPathXdg) pure globalConfig
where where
writeUserConfig dir = do writeUserConfig dir = do
let createConfPath = dir FilePath.</> "config.yaml" let createConfPath = dir FilePath.</> "config.yaml"
liftIO $ Directory.createDirectoryIfMissing True dir liftIO $ Directory.createDirectoryIfMissing True dir
writeDefaultConfig $ createConfPath writeDefaultConfig $ createConfPath
pure createConfPath pure createConfPath
-- | Searches for a local (per-project) brittany config starting from a given directory -- | Searches for a local (per-project) brittany config starting from a given directory
findLocalConfigPath :: System.IO.FilePath -> IO (Maybe System.IO.FilePath) findLocalConfigPath :: System.IO.FilePath -> IO (Maybe System.IO.FilePath)
findLocalConfigPath dir = do findLocalConfigPath dir = do
let dirParts = FilePath.splitDirectories dir let dirParts = FilePath.splitDirectories dir
-- when provided dir is "a/b/c", searchDirs is ["a/b/c", "a/b", "a", "/"] -- when provided dir is "a/b/c", searchDirs is ["a/b/c", "a/b", "a", "/"]
let searchDirs = FilePath.joinPath <$> reverse (List.inits dirParts) let searchDirs = FilePath.joinPath <$> reverse (List.inits dirParts)
Directory.findFileWith Directory.doesFileExist searchDirs "brittany.yaml" Directory.findFileWith Directory.doesFileExist searchDirs "brittany.yaml"
@ -289,7 +283,8 @@ readConfigs
-> MaybeT IO Config -> MaybeT IO Config
readConfigs cmdlineConfig configPaths = do readConfigs cmdlineConfig configPaths = do
configs <- readConfig `mapM` configPaths configs <- readConfig `mapM` configPaths
let merged = Semigroup.sconcat $ NonEmpty.reverse (cmdlineConfig :| catMaybes configs) let merged = Semigroup.sconcat
$ NonEmpty.reverse (cmdlineConfig :| catMaybes configs)
return $ cZipWith fromOptionIdentity staticDefaultConfig merged return $ cZipWith fromOptionIdentity staticDefaultConfig merged
-- | Reads provided configs -- | Reads provided configs
@ -309,7 +304,6 @@ writeDefaultConfig path =
staticDefaultConfig staticDefaultConfig
showConfigYaml :: Config -> String showConfigYaml :: Config -> String
showConfigYaml = Data.ByteString.Char8.unpack showConfigYaml = Data.ByteString.Char8.unpack . Data.Yaml.encode . cMap
. Data.Yaml.encode (\(Identity x) -> Just x)
. cMap (\(Identity x) -> Just x)