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

Fix inline disabling of brittany

pull/136/head
Lennart Spitzner 2018-04-19 17:03:59 +02:00
parent 17fb271694
commit 18704e403f
7 changed files with 41 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src-brittany/Main.hs
View File

@ -217,7 +217,8 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runEx
-- The flag is intentionally misspelled to prevent clashing with
-- inline-config stuff.
let hackAroundIncludes = config & _conf_preprocessor & _ppconf_hackAroundIncludes & confUnpack
let exactprintOnly = config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack
let exactprintOnly = (config & _conf_roundtrip_exactprint_only & confUnpack)
|| (config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack)
let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
then case cppMode of
CPPModeAbort -> do

15
src-literatetests/Main.hs
View File

@ -160,9 +160,9 @@ instance Show PPTextWrapper where
defaultTestConfig :: Config
defaultTestConfig = Config
{ _conf_version = _conf_version staticDefaultConfig
, _conf_debug = _conf_debug staticDefaultConfig
, _conf_layout = LayoutConfig
{ _conf_version = _conf_version staticDefaultConfig
, _conf_debug = _conf_debug staticDefaultConfig
, _conf_layout = LayoutConfig
{ _lconfig_cols = coerce (80 :: Int)
, _lconfig_indentPolicy = coerce IndentPolicyFree
, _lconfig_indentAmount = coerce (2 :: Int)
@ -178,13 +178,12 @@ defaultTestConfig = Config
, _lconfig_reformatModulePreamble = coerce True
, _lconfig_allowSingleLineExportList = coerce True
}
, _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
, _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
{ _econf_omit_output_valid_check = coerce True
}
, _conf_preprocessor = _conf_preprocessor staticDefaultConfig
, _conf_forward = ForwardOptions
{ _options_ghc = Identity []
}
, _conf_preprocessor = _conf_preprocessor staticDefaultConfig
, _conf_forward = ForwardOptions {_options_ghc = Identity []}
, _conf_roundtrip_exactprint_only = coerce True
}
contextFreeTestConfig :: Config

15
src-unittests/TestUtils.hs
View File

@ -42,9 +42,9 @@ instance Show PPTextWrapper where
defaultTestConfig :: Config
defaultTestConfig = Config
{ _conf_version = _conf_version staticDefaultConfig
, _conf_debug = _conf_debug staticDefaultConfig
, _conf_layout = LayoutConfig
{ _conf_version = _conf_version staticDefaultConfig
, _conf_debug = _conf_debug staticDefaultConfig
, _conf_layout = LayoutConfig
{ _lconfig_cols = coerce (80 :: Int)
, _lconfig_indentPolicy = coerce IndentPolicyFree
, _lconfig_indentAmount = coerce (2 :: Int)
@ -60,11 +60,10 @@ defaultTestConfig = Config
, _lconfig_reformatModulePreamble = coerce True
, _lconfig_allowSingleLineExportList = coerce True
}
, _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
, _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
{ _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever
}
, _conf_preprocessor = (_conf_preprocessor staticDefaultConfig)
, _conf_forward = ForwardOptions
{ _options_ghc = Identity []
}
, _conf_preprocessor = (_conf_preprocessor staticDefaultConfig)
, _conf_forward = ForwardOptions {_options_ghc = Identity []}
, _conf_roundtrip_exactprint_only = coerce False
}

34
src/Language/Haskell/Brittany/Internal.hs
View File

@ -136,27 +136,19 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
Butcher.addCmd "-next-binding" nextBinding
Butcher.addCmd "-Next-Binding" nextBinding
Butcher.addCmd "-NEXT-BINDING" nextBinding
let
disableNextBinding = do
Butcher.addCmdImpl
( InlineConfigTargetNextBinding
, mempty
{ _conf_debug =
mempty { _dconf_roundtrip_exactprint_only = pure $ pure True }
}
)
let disableNextBinding = do
Butcher.addCmdImpl
( InlineConfigTargetNextBinding
, mempty { _conf_roundtrip_exactprint_only = pure $ pure True }
)
Butcher.addCmd "-disable-next-binding" disableNextBinding
Butcher.addCmd "-Disable-Next-Binding" disableNextBinding
Butcher.addCmd "-DISABLE-NEXT-BINDING" disableNextBinding
let
disableNextDecl = do
Butcher.addCmdImpl
( InlineConfigTargetNextDecl
, mempty
{ _conf_debug =
mempty { _dconf_roundtrip_exactprint_only = pure $ pure True }
}
)
let disableNextDecl = do
Butcher.addCmdImpl
( InlineConfigTargetNextDecl
, mempty { _conf_roundtrip_exactprint_only = pure $ pure True }
)
Butcher.addCmd "-disable-next-declaration" disableNextDecl
Butcher.addCmd "-Disable-Next-Declaration" disableNextDecl
Butcher.addCmd "-DISABLE-NEXT-DECLARATION" disableNextDecl
@ -458,7 +450,11 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
let config' = cZipWith fromOptionIdentity config $ mconcat
(inlineModConf : (catMaybes (mBindingConfs ++ [mDeclConf])))
toLocal config' filteredAnns $ ppDecl decl
toLocal config' filteredAnns
$ if (config' & _conf_roundtrip_exactprint_only & confUnpack)
then briDocMToPPM (briDocByExactNoComment decl) >>= layoutBriDoc
else ppDecl decl
let finalComments = filter
(fst .> \case
ExactPrint.AnnComment{} -> True

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

@ -89,6 +89,7 @@ staticDefaultConfig = Config
, _conf_forward = ForwardOptions
{ _options_ghc = Identity []
}
, _conf_roundtrip_exactprint_only = coerce False
}
forwardOptionsSyntaxExtsEnabled :: ForwardOptions
@ -109,6 +110,7 @@ forwardOptionsSyntaxExtsEnabled = ForwardOptions
]
}
-- brittany-next-binding --columns=200
cmdlineConfigParser :: CmdParser Identity out (CConfig Option)
cmdlineConfigParser = do
-- TODO: why does the default not trigger; ind never should be []!!
@ -156,7 +158,7 @@ cmdlineConfigParser = do
, _dconf_dump_bridoc_simpl_columns = wrapLast $ falseToNothing dumpBriDocColumns
, _dconf_dump_bridoc_simpl_indent = wrapLast $ falseToNothing dumpBriDocIndent
, _dconf_dump_bridoc_final = wrapLast $ falseToNothing dumpBriDocFinal
, _dconf_roundtrip_exactprint_only = wrapLast $ falseToNothing roundtripOnly
, _dconf_roundtrip_exactprint_only = mempty
}
, _conf_layout = LayoutConfig
{ _lconfig_cols = optionConcat cols
@ -187,6 +189,7 @@ cmdlineConfigParser = do
, _conf_forward = ForwardOptions
{ _options_ghc = [ optionsGhc & List.unwords & CmdArgs.splitArgs | not $ null optionsGhc ]
}
, _conf_roundtrip_exactprint_only = wrapLast $ falseToNothing roundtripOnly
}
where
falseToNothing = Option . Bool.bool Nothing (Just True)

5
src/Language/Haskell/Brittany/Internal/Config/Types.hs
View File

@ -145,6 +145,11 @@ data CConfig f = Config
, _conf_errorHandling :: CErrorHandlingConfig f
, _conf_forward :: CForwardOptions f
, _conf_preprocessor :: CPreProcessorConfig f
, _conf_roundtrip_exactprint_only :: f (Semigroup.Last Bool)
-- ^ this field is somewhat of a duplicate of the one in DebugConfig.
-- It is used for per-declaration disabling by the inline config
-- implementation. Could have re-used the existing field, but felt risky
-- to use a "debug" labeled field for non-debug functionality.
}
deriving (Generic)

1
src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs
View File

@ -119,6 +119,7 @@ instance FromJSON (CConfig Maybe) where
<*> v .:?= Text.pack "conf_errorHandling"
<*> v .:?= Text.pack "conf_forward"
<*> v .:?= Text.pack "conf_preprocessor"
<*> v .:? Text.pack "conf_roundtrip_exactprint_only"
parseJSON invalid = Aeson.typeMismatch "Config" invalid
-- Pretends that the value is {} when the key is not present.