Implement fixity-aware-ops feature
parent
75d17b961c
commit
676695a609
|
|
@ -129,6 +129,7 @@ library
|
|||
Language.Haskell.Brittany.Internal.ToBriDoc.DataDecl
|
||||
Language.Haskell.Brittany.Internal.ToBriDoc.Decl
|
||||
Language.Haskell.Brittany.Internal.ToBriDoc.Expr
|
||||
Language.Haskell.Brittany.Internal.ToBriDoc.OpTree
|
||||
Language.Haskell.Brittany.Internal.ToBriDoc.IE
|
||||
Language.Haskell.Brittany.Internal.ToBriDoc.Import
|
||||
Language.Haskell.Brittany.Internal.ToBriDoc.Module
|
||||
|
|
@ -137,6 +138,7 @@ library
|
|||
Language.Haskell.Brittany.Internal.ToBriDoc.Type
|
||||
Language.Haskell.Brittany.Internal.Components.BriDoc
|
||||
Language.Haskell.Brittany.Internal.Components.Obfuscation
|
||||
Language.Haskell.Brittany.Internal.Components.OpTree
|
||||
Language.Haskell.Brittany.Internal.S1_Parsing
|
||||
Language.Haskell.Brittany.Internal.S2_SplitModule
|
||||
Language.Haskell.Brittany.Internal.S3_ToBriDocTools
|
||||
|
|
|
|||
|
|
@ -0,0 +1,232 @@
|
|||
#group expression/op-precedence
|
||||
|
||||
|
||||
|
||||
#test basic precedence-aware layouting
|
||||
operatorExpr1 =
|
||||
( foo1 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr1
|
||||
+ foo2 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr2
|
||||
+ foo3 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr3
|
||||
+ foo4 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr4
|
||||
+ foo5 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr5
|
||||
+ foo6 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr6
|
||||
+ foo7 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr7
|
||||
+ foo8 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr8
|
||||
+ foo9 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr9
|
||||
)
|
||||
|
||||
#test nested different precedences
|
||||
operatorExpr2 =
|
||||
( foo1 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr1
|
||||
+ foo2 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr2
|
||||
+ foo3 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr3
|
||||
+ foo4 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr4
|
||||
== foo5 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr5
|
||||
+ foo6 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr6
|
||||
+ foo7 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr7
|
||||
+ foo8 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr8
|
||||
+ foo9 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr9
|
||||
)
|
||||
|
||||
#test simple comment respecting
|
||||
alternatives = -- a
|
||||
( -- b
|
||||
alternativeOne -- c
|
||||
<|> alterantiveTwo -- d
|
||||
<|> alternativeThree -- e
|
||||
) -- f
|
||||
|
||||
#golden retaining comments while minimizing duplicated parens
|
||||
#pending
|
||||
-- brittany { lconfig_operatorParenthesisRefactorMode: PRMMinimize }
|
||||
alternatives = -- a
|
||||
x
|
||||
+ ( -- b
|
||||
( -- c
|
||||
alternativeOne -- c
|
||||
<|> alterantiveTwo -- d
|
||||
<|> alternativeThree -- e
|
||||
) -- f
|
||||
) -- g
|
||||
#expected
|
||||
-- brittany { lconfig_operatorParenthesisRefactorMode: PRMMinimize }
|
||||
alternatives = -- a
|
||||
x
|
||||
+ -- b
|
||||
( -- c
|
||||
alternativeOne -- c
|
||||
<|> alterantiveTwo -- d
|
||||
<|> alternativeThree -- e
|
||||
) -- f -- g
|
||||
|
||||
#golden refactoring unnecessary parens basic example
|
||||
-- brittany { lconfig_operatorParenthesisRefactorMode: PRMMinimize }
|
||||
operatorExpr1 =
|
||||
( (goo1 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr1)
|
||||
+ goo2 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr2
|
||||
+ goo3 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr3
|
||||
+ goo4 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr4
|
||||
)
|
||||
#expected
|
||||
-- brittany { lconfig_operatorParenthesisRefactorMode: PRMMinimize }
|
||||
operatorExpr1 =
|
||||
( goo1 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr1
|
||||
+ goo2 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr2
|
||||
+ goo3 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr3
|
||||
+ goo4 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr4
|
||||
)
|
||||
|
||||
#test feature flag fixityAwareOps works
|
||||
-- brittany { lconfig_fixityAwareOps: False }
|
||||
operatorExpr1 =
|
||||
( goo1
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr1
|
||||
+ goo2
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr2
|
||||
+ goo3
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr3
|
||||
+ goo4
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr4
|
||||
+ goo5
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr5
|
||||
+ goo6
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr6
|
||||
+ goo7
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr7
|
||||
+ goo8
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr8
|
||||
+ goo9
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr9
|
||||
)
|
||||
|
||||
#golden op-app simple golden test
|
||||
operatorExpr1 =
|
||||
( goo1
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr1
|
||||
+ goo2
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr2
|
||||
+ goo3
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr3
|
||||
+ goo4
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr4
|
||||
+ goo5
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr5
|
||||
+ goo6
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr6
|
||||
+ goo7
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr7
|
||||
+ goo8
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr8
|
||||
+ goo9
|
||||
* barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr9
|
||||
)
|
||||
#expected
|
||||
operatorExpr1 =
|
||||
( goo1 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr1
|
||||
+ goo2 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr2
|
||||
+ goo3 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr3
|
||||
+ goo4 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr4
|
||||
+ goo5 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr5
|
||||
+ goo6 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr6
|
||||
+ goo7 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr7
|
||||
+ goo8 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr8
|
||||
+ goo9 * barrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr9
|
||||
)
|
||||
|
||||
#golden op-app mixed golden
|
||||
doop =
|
||||
some long invocation ==
|
||||
loooooooooongman + (third nested expression)
|
||||
- 4 && {- meow -} 5
|
||||
- 6
|
||||
> 7
|
||||
`mod` loooooooooongwoman || ill just invoke a function with these args
|
||||
|| foo && dooasdoiaosdoi ** oaisdoioasido <= asduiuaisduiasdu + asdahjsd + ahsjdhjhasd
|
||||
#expected
|
||||
doop =
|
||||
some long invocation == loooooooooongman + (third nested expression) - 4
|
||||
&& {- meow -} 5 - 6 > 7 `mod` loooooooooongwoman
|
||||
|| ill just invoke a function with these args
|
||||
|| foo
|
||||
&& dooasdoiaosdoi ** oaisdoioasido
|
||||
<= asduiuaisduiasdu + asdahjsd + ahsjdhjhasd
|
||||
|
||||
#golden op-app mixed golden with added parens
|
||||
-- brittany { lconfig_fixityBasedAddAlignParens: True }
|
||||
doop =
|
||||
some long invocation ==
|
||||
loooooooooongman + (third nested expression)
|
||||
- 4 && {- meow -} 5
|
||||
- 6
|
||||
> 7
|
||||
`mod` loooooooooongwoman || ill just invoke a function with these args
|
||||
|| foo && dooasdoiaosdoi ** oaisdoioasido <= asduiuaisduiasdu + asdahjsd + ahsjdhjhasd
|
||||
#expected
|
||||
-- brittany { lconfig_fixityBasedAddAlignParens: True }
|
||||
doop =
|
||||
( some long invocation == loooooooooongman + (third nested expression) - 4
|
||||
&& {- meow -} 5 - 6 > 7 `mod` loooooooooongwoman
|
||||
|| ill just invoke a function with these args
|
||||
|| ( foo
|
||||
&& dooasdoiaosdoi ** oaisdoioasido
|
||||
<= asduiuaisduiasdu + asdahjsd + ahsjdhjhasd
|
||||
)
|
||||
)
|
||||
|
||||
#golden multiline mixed op expression 1
|
||||
-- brittany { lconfig_fixityBasedAddAlignParens: True }
|
||||
meow =
|
||||
[docSeparator, docForceSL od1, docSeparator, docForceSL ed1]
|
||||
++ join
|
||||
[ [docSeparator, docForceSingleline od, docSeparator, docForceSingleline ed]
|
||||
| (od, ed) <- ems
|
||||
]
|
||||
++ [docSeparator, docForceSingleline odN, docSeparator, lastWrap edN]
|
||||
#expected
|
||||
-- brittany { lconfig_fixityBasedAddAlignParens: True }
|
||||
meow =
|
||||
( [docSeparator, docForceSL od1, docSeparator, docForceSL ed1]
|
||||
++ join
|
||||
[ [ docSeparator
|
||||
, docForceSingleline od
|
||||
, docSeparator
|
||||
, docForceSingleline ed
|
||||
]
|
||||
| (od, ed) <- ems
|
||||
]
|
||||
++ [docSeparator, docForceSingleline odN, docSeparator, lastWrap edN]
|
||||
)
|
||||
|
||||
#golden multiline mixed op expression 2
|
||||
-- brittany { lconfig_fixityBasedAddAlignParens: True }
|
||||
meow =
|
||||
[docSeparator, docForceSingleline od1, docSeparator, docForceSingleline ed1, something]
|
||||
++ join
|
||||
[ [docSeparator, docForceSingleline od, docSeparator, docForceSingleline ed]
|
||||
| (od, ed) <- ems
|
||||
]
|
||||
++ [docSeparator, docForceSingleline odN, docSeparator, lastWrap edN, something]
|
||||
#expected
|
||||
-- brittany { lconfig_fixityBasedAddAlignParens: True }
|
||||
meow =
|
||||
( [ docSeparator
|
||||
, docForceSingleline od1
|
||||
, docSeparator
|
||||
, docForceSingleline ed1
|
||||
, something
|
||||
]
|
||||
++ join
|
||||
[ [ docSeparator
|
||||
, docForceSingleline od
|
||||
, docSeparator
|
||||
, docForceSingleline ed
|
||||
]
|
||||
| (od, ed) <- ems
|
||||
]
|
||||
++ [ docSeparator
|
||||
, docForceSingleline odN
|
||||
, docSeparator
|
||||
, lastWrap edN
|
||||
, something
|
||||
]
|
||||
)
|
||||
|
|
@ -161,10 +161,8 @@ readMergePersConfig path shouldCreate conf = do
|
|||
fileConf <- case Data.Yaml.decodeEither contents of
|
||||
Left e -> do
|
||||
liftIO
|
||||
$ putStrErrLn
|
||||
$ "error reading in brittany config from "
|
||||
++ path
|
||||
++ ":"
|
||||
$ putStrErrLn
|
||||
$ "error reading in brittany config from " ++ path ++ ":"
|
||||
liftIO $ putStrErrLn e
|
||||
mzero
|
||||
Right x -> return x
|
||||
|
|
|
|||
|
|
@ -1032,7 +1032,7 @@ func
|
|||
|
||||
#test some indentation thingy
|
||||
func =
|
||||
(lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj
|
||||
( lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj
|
||||
$ abc
|
||||
$ def
|
||||
$ ghi
|
||||
|
|
@ -1100,9 +1100,7 @@ readMergePersConfig path shouldCreate conf = do
|
|||
Left e -> do
|
||||
liftIO
|
||||
$ putStrErrLn
|
||||
$ "error reading in brittany config from "
|
||||
++ path
|
||||
++ ":"
|
||||
$ "error reading in brittany config from " ++ path ++ ":"
|
||||
liftIO $ putStrErrLn e
|
||||
mzero
|
||||
Right x -> return x
|
||||
|
|
|
|||
|
|
@ -55,9 +55,9 @@ parsePrintModule traceFunc configWithDebugs inputText = runExceptT $ do
|
|||
configWithDebugs { _conf_debug = _conf_debug staticDefaultConfig }
|
||||
let ghcOptions = config & _conf_forward & _options_ghc & runIdentity
|
||||
let config_pp = config & _conf_preprocessor
|
||||
let cppMode = config_pp & _ppconf_CPPMode & confUnpack @CPPMode
|
||||
let cppMode = config_pp & _ppconf_CPPMode & confUnpack
|
||||
let hackAroundIncludes =
|
||||
config_pp & _ppconf_hackAroundIncludes & confUnpack @Bool
|
||||
config_pp & _ppconf_hackAroundIncludes & confUnpack
|
||||
(parsedSource, hasCPP) <- do
|
||||
let hackF s = if "#include" `isPrefixOf` s
|
||||
then "-- BRITANY_INCLUDE_HACK " ++ s
|
||||
|
|
@ -84,7 +84,7 @@ parsePrintModule traceFunc configWithDebugs inputText = runExceptT $ do
|
|||
$ extractCommentConfigs (useTraceFunc traceFunc) parsedSource
|
||||
let moduleConfig = cZipWith fromOptionIdentity config inlineConf
|
||||
let disableFormatting =
|
||||
moduleConfig & _conf_disable_formatting & confUnpack @Bool
|
||||
moduleConfig & _conf_disable_formatting & confUnpack
|
||||
if disableFormatting
|
||||
then do
|
||||
return inputText
|
||||
|
|
|
|||
|
|
@ -87,11 +87,7 @@ data BriDocW (w :: IsWrapped)
|
|||
-- the following constructors are only relevant for the alt transformation
|
||||
-- and are removed afterwards. They should never occur in any (BriDocRec w)
|
||||
-- after the alt transformation.
|
||||
| BDForceMultiline (BriDocRec w)
|
||||
| BDForceSingleline (BriDocRec w)
|
||||
| BDNonBottomSpacing Bool (BriDocRec w)
|
||||
| BDSetParSpacing (BriDocRec w)
|
||||
| BDForceParSpacing (BriDocRec w)
|
||||
| BDForceAlt ForceAlt (BriDocRec w)
|
||||
-- pseudo-deprecated
|
||||
| BDDebug String (BriDocRec w)
|
||||
|
||||
|
|
@ -102,8 +98,19 @@ type BriDoc = BriDocW 'Unwrapped
|
|||
type BriDocWrapped = BriDocW 'Wrapped
|
||||
type BriDocNumbered = (Int, BriDocWrapped)
|
||||
|
||||
data ForceAlt
|
||||
= ForceMultiline
|
||||
| ForceSingleline
|
||||
| NonBottomSpacing Bool
|
||||
| SetParSpacing
|
||||
| ForceParSpacing
|
||||
| ForceZeroAdd
|
||||
deriving (Eq, Ord, Data.Data.Data, Show)
|
||||
|
||||
|
||||
data BrIndent = BrIndentNone
|
||||
| BrIndentRegular
|
||||
| BrIndentRegularForce
|
||||
| BrIndentSpecial Int
|
||||
deriving (Eq, Ord, Data.Data.Data, Show)
|
||||
|
||||
|
|
@ -131,11 +138,7 @@ instance Uniplate.Uniplate BriDoc where
|
|||
uniplate (BDEntryDelta dp bd ) = plate BDEntryDelta |- dp |* bd
|
||||
uniplate (BDLines lines ) = plate BDLines ||* lines
|
||||
uniplate (BDEnsureIndent ind bd ) = plate BDEnsureIndent |- ind |* bd
|
||||
uniplate (BDForceMultiline bd ) = plate BDForceMultiline |* bd
|
||||
uniplate (BDForceSingleline bd ) = plate BDForceSingleline |* bd
|
||||
uniplate (BDNonBottomSpacing b bd) = plate BDNonBottomSpacing |- b |* bd
|
||||
uniplate (BDSetParSpacing bd ) = plate BDSetParSpacing |* bd
|
||||
uniplate (BDForceParSpacing bd ) = plate BDForceParSpacing |* bd
|
||||
uniplate (BDForceAlt forceFlag bd) = plate BDForceAlt |- forceFlag |* bd
|
||||
uniplate (BDDebug s bd ) = plate BDDebug |- s |* bd
|
||||
|
||||
-- this might not work. is not used anywhere either.
|
||||
|
|
@ -161,11 +164,7 @@ briDocSeqSpine = \case
|
|||
BDEntryDelta _dp bd -> briDocSeqSpine bd
|
||||
BDLines lines -> foldl' (\() -> briDocSeqSpine) () lines
|
||||
BDEnsureIndent _ind bd -> briDocSeqSpine bd
|
||||
BDForceMultiline bd -> briDocSeqSpine bd
|
||||
BDForceSingleline bd -> briDocSeqSpine bd
|
||||
BDNonBottomSpacing _ bd -> briDocSeqSpine bd
|
||||
BDSetParSpacing bd -> briDocSeqSpine bd
|
||||
BDForceParSpacing bd -> briDocSeqSpine bd
|
||||
BDForceAlt _ bd -> briDocSeqSpine bd
|
||||
BDDebug _s bd -> briDocSeqSpine bd
|
||||
|
||||
briDocForceSpine :: BriDoc -> BriDoc
|
||||
|
|
@ -198,11 +197,7 @@ unwrapBriDocNumbered tpl = case snd tpl of
|
|||
BDEntryDelta dp bd -> BDEntryDelta dp $ rec bd
|
||||
BDLines lines -> BDLines $ rec <$> lines
|
||||
BDEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd
|
||||
BDForceMultiline bd -> BDForceMultiline $ rec bd
|
||||
BDForceSingleline bd -> BDForceSingleline $ rec bd
|
||||
BDNonBottomSpacing b bd -> BDNonBottomSpacing b $ rec bd
|
||||
BDSetParSpacing bd -> BDSetParSpacing $ rec bd
|
||||
BDForceParSpacing bd -> BDForceParSpacing $ rec bd
|
||||
BDForceAlt forceFlag bd -> BDForceAlt forceFlag $ rec bd
|
||||
BDDebug s bd -> BDDebug (s ++ "@" ++ show (fst tpl)) $ rec bd
|
||||
where rec = unwrapBriDocNumbered
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,289 @@
|
|||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
module Language.Haskell.Brittany.Internal.Components.OpTree where
|
||||
|
||||
import Language.Haskell.Brittany.Internal.Prelude
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import GHC ( RealSrcLoc )
|
||||
import GHC.Types.Fixity ( Fixity(Fixity)
|
||||
, FixityDirection
|
||||
( InfixL
|
||||
, InfixN
|
||||
, InfixR
|
||||
)
|
||||
)
|
||||
import GHC.Types.SourceText ( SourceText(NoSourceText) )
|
||||
import qualified Safe
|
||||
import qualified Data.Char
|
||||
|
||||
import Language.Haskell.Brittany.Internal.Components.BriDoc
|
||||
import Language.Haskell.Brittany.Internal.Utils
|
||||
import Language.Haskell.Brittany.Internal.Types
|
||||
|
||||
|
||||
|
||||
data OpTree
|
||||
= OpUnknown Bool -- Z paren?
|
||||
(Maybe RealSrcLoc) -- paren open loc
|
||||
(Maybe RealSrcLoc) -- paren close loc
|
||||
OpTree -- left operand
|
||||
[(BriDocNumbered, BriDocNumbered)] -- list of (next operand, symbol)
|
||||
| OpKnown Bool -- with paren?
|
||||
(Maybe RealSrcLoc) -- paren open loc
|
||||
(Maybe RealSrcLoc) -- paren close loc
|
||||
Fixity -- only Just after (successful!) lookup phase
|
||||
OpTree
|
||||
[(BriDocNumbered, OpTree)]
|
||||
| OpLeaf BriDocNumbered
|
||||
|
||||
displayOpTree :: OpTree -> String
|
||||
displayOpTree = \case
|
||||
OpUnknown p _ _ leftTree rs ->
|
||||
( "(OpUnknown "
|
||||
++ show p
|
||||
++ " "
|
||||
++ displayOpTree leftTree
|
||||
++ " ["
|
||||
++ intercalate
|
||||
","
|
||||
[ ("(" ++ showOp op ++ "," ++ show x ++ ")") | (op, (x, _)) <- rs ]
|
||||
++ "]"
|
||||
)
|
||||
OpKnown p _ _ fixity tree ops ->
|
||||
( "OpKnown "
|
||||
++ show p
|
||||
++ " "
|
||||
++ showOutputable fixity
|
||||
++ " ("
|
||||
++ displayOpTree tree
|
||||
++ ")"
|
||||
++ join [ (showOp op ++ "(" ++ displayOpTree t ++ ")") | (op, t) <- ops ]
|
||||
)
|
||||
OpLeaf (x, _) -> show x
|
||||
where
|
||||
showOp :: BriDocNumbered -> String
|
||||
showOp = \case
|
||||
(_, BDFlushCommentsPrior _ x) -> showOp x
|
||||
(_, BDQueueComments _ x ) -> showOp x
|
||||
(_, BDLit x ) -> Text.unpack x
|
||||
-- (_, BDFlushCommentsPrior _ (_, BDFlushCommentsPrior _ (_, x)))
|
||||
-- | trace (show $ toConstr x) False -> "meow"
|
||||
(i, _ ) -> show i
|
||||
|
||||
|
||||
-- lookupFixities :: Monad m => OpTree -> m OpTree
|
||||
-- lookupFixities = \case
|
||||
-- OpNode par Nothing opDoc chldrn -> do
|
||||
-- pure $ OpNode par (hardcodedFixity (Text.unpack opDoc)) opDoc chldrn
|
||||
-- x@OpNode{} -> pure x
|
||||
-- x@OpLeaf{} -> pure x
|
||||
|
||||
data ReformatParenMode
|
||||
= ReformatParenModeKeep -- don't modify parens at all
|
||||
| ReformatParenModeClean -- remove unnecessary parens
|
||||
| ReformatParenModeAll -- add superfluous parens everywhere
|
||||
|
||||
-- [(Bool, Fixity, Text, [OpTree])]
|
||||
|
||||
-- a == b + c || d * e /= f
|
||||
-- _ a
|
||||
-- == a, _ b
|
||||
-- == a, + b, _ c
|
||||
-- == a, + b c
|
||||
-- == a (+ b c)
|
||||
-- || (== a (+ b c)), _ d
|
||||
-- || (== a (+ b c)), * d, _ e
|
||||
-- || (== a (+ b c)), * d e
|
||||
-- || (== a (+ b c)), /= (* d e), _ f
|
||||
-- || (== a (+ b c)), /= (* d e) f
|
||||
-- || (== a (+ b c)) (/= (* d e) f)
|
||||
|
||||
data StackElem = StackElem Fixity [(OpTree, BriDocNumbered)]
|
||||
type Stack = [StackElem]
|
||||
|
||||
balanceOpTree :: Bool -> OpTree -> ([BrittanyError], OpTree)
|
||||
balanceOpTree allowUnqualify = \case
|
||||
x@OpLeaf{} -> ([], x)
|
||||
x@OpKnown{} -> ([], x)
|
||||
x@(OpUnknown paren locO locC left rest) ->
|
||||
let (warns, balancedLeft) = balanceOpTree allowUnqualify left
|
||||
in case go [] rest balancedLeft of
|
||||
Right (leaf@OpLeaf{}) -> (warns, leaf)
|
||||
Right (OpKnown _paren _ _ fixity c cs) ->
|
||||
(warns, OpKnown paren locO locC fixity c cs)
|
||||
Right t -> (warns, t)
|
||||
Left moreWarns ->
|
||||
( warns
|
||||
++ [ LayoutWarning ("Fixity of operator not known: " ++ w)
|
||||
| w <- moreWarns
|
||||
]
|
||||
, x
|
||||
)
|
||||
where
|
||||
-- singleton :: BriDocNumbered -> StackElem
|
||||
-- singleton x = StackElem (Fixity NoSourceText 99 InfixN) (OpLeaf x) []
|
||||
go
|
||||
:: Stack
|
||||
-> [(BriDocNumbered, BriDocNumbered)]
|
||||
-> OpTree
|
||||
-> Either [String] OpTree
|
||||
go [] [] _ = Left []
|
||||
go [StackElem fxty cs] [] c =
|
||||
let (e1, eops) = shiftOps cs c in Right (known fxty e1 eops)
|
||||
go (StackElem fxty cs : StackElem fixity cs2 : rest) [] c =
|
||||
-- go (StackElem fixity (OpKnown False fxty (reverse cs) : cs2) : rest) []
|
||||
let (e1, eops) = shiftOps cs c
|
||||
in go (StackElem fixity cs2 : rest) [] (known fxty e1 eops)
|
||||
go stack input@((opDoc, val) : inputR) c = case stack of
|
||||
[] -> do
|
||||
fxty <- docFixity opDoc
|
||||
go [StackElem fxty [(c, opDoc)]] inputR (OpLeaf val)
|
||||
(StackElem fixityS cs : stackR) -> do
|
||||
let Fixity _ precS dirS = fixityS
|
||||
fxty@(Fixity _ prec dir) <- docFixity opDoc
|
||||
case compare prec precS of
|
||||
GT -> go (StackElem fxty [(c, opDoc)] : stack) inputR (OpLeaf val)
|
||||
LT -> do
|
||||
let (e1, eops) = shiftOps cs c
|
||||
go stackR input (known fixityS e1 eops)
|
||||
EQ -> case (dir, dirS) of
|
||||
(InfixR, InfixR) ->
|
||||
go (StackElem fixityS ((c, opDoc) : cs) : stackR)
|
||||
inputR
|
||||
(OpLeaf val)
|
||||
(InfixL, InfixL) ->
|
||||
go (StackElem fixityS ((c, opDoc) : cs) : stackR)
|
||||
inputR
|
||||
(OpLeaf val)
|
||||
_ -> Left []
|
||||
docFixity :: BriDocNumbered -> Either [String] Fixity
|
||||
docFixity (_, x) = case x of
|
||||
BDLit (Text.unpack -> s) -> case hardcodedFixity allowUnqualify s of
|
||||
Just f -> Right f
|
||||
Nothing -> Left [s]
|
||||
BDFlushCommentsPrior _ d -> docFixity d
|
||||
BDQueueComments _ d -> docFixity d
|
||||
_ -> Left []
|
||||
shiftOps
|
||||
:: [(OpTree, BriDocNumbered)]
|
||||
-> OpTree
|
||||
-> (OpTree, [(BriDocNumbered, OpTree)])
|
||||
shiftOps ops final = case reverse ops of
|
||||
[] -> (final, [])
|
||||
((e1, o1) : rest) ->
|
||||
( e1
|
||||
, let (finalOp, list) =
|
||||
mapAccumL (\op (nextE, nextOp) -> (nextOp, (op, nextE))) o1 rest
|
||||
in list ++ [(finalOp, final)]
|
||||
)
|
||||
known = OpKnown False Nothing Nothing
|
||||
|
||||
addAllParens :: Bool -> OpTree -> OpTree
|
||||
addAllParens topLevelParen = \case
|
||||
x@OpLeaf{} -> x
|
||||
x@OpUnknown{} -> x
|
||||
OpKnown _paren locO locC fixity c cs ->
|
||||
OpKnown topLevelParen
|
||||
locO
|
||||
locC
|
||||
fixity
|
||||
(addAllParens True c)
|
||||
[ (op, addAllParens True tree) | (op, tree) <- cs ]
|
||||
|
||||
remSuperfluousParens :: Int -> OpTree -> OpTree
|
||||
remSuperfluousParens outerFixity = \case
|
||||
x@OpLeaf{} -> x
|
||||
x@OpUnknown{} -> x
|
||||
OpKnown paren locO locC fixity c cs ->
|
||||
OpKnown
|
||||
(paren && outerFixity > fixLevel fixity)
|
||||
locO
|
||||
locC
|
||||
fixity
|
||||
(remSuperfluousParens (fixLevel fixity) c)
|
||||
[ (op, remSuperfluousParens (fixLevel fixity) tree) | (op, tree) <- cs ]
|
||||
where fixLevel (Fixity _ i _) = i
|
||||
|
||||
hardcodedFixity :: Bool -> String -> Maybe Fixity
|
||||
hardcodedFixity allowUnqualify = \case
|
||||
"." -> Just $ Fixity NoSourceText 9 InfixR
|
||||
"!!" -> Just $ Fixity NoSourceText 9 InfixL
|
||||
"**" -> Just $ Fixity NoSourceText 8 InfixR
|
||||
"^" -> Just $ Fixity NoSourceText 8 InfixR
|
||||
"^^" -> Just $ Fixity NoSourceText 8 InfixR
|
||||
"*" -> Just $ Fixity NoSourceText 7 InfixL
|
||||
"/" -> Just $ Fixity NoSourceText 7 InfixL
|
||||
"`quot`" -> Just $ Fixity NoSourceText 7 InfixL
|
||||
"`rem`" -> Just $ Fixity NoSourceText 7 InfixL
|
||||
"`div`" -> Just $ Fixity NoSourceText 7 InfixL
|
||||
"`mod`" -> Just $ Fixity NoSourceText 7 InfixL
|
||||
"+" -> Just $ Fixity NoSourceText 6 InfixL
|
||||
"-" -> Just $ Fixity NoSourceText 6 InfixL
|
||||
":" -> Just $ Fixity NoSourceText 5 InfixR
|
||||
"==" -> Just $ Fixity NoSourceText 4 InfixN
|
||||
"/=" -> Just $ Fixity NoSourceText 4 InfixN
|
||||
"<" -> Just $ Fixity NoSourceText 4 InfixN
|
||||
"<=" -> Just $ Fixity NoSourceText 4 InfixN
|
||||
">" -> Just $ Fixity NoSourceText 4 InfixN
|
||||
">=" -> Just $ Fixity NoSourceText 4 InfixN
|
||||
"&&" -> Just $ Fixity NoSourceText 3 InfixR
|
||||
"||" -> Just $ Fixity NoSourceText 2 InfixR
|
||||
">>=" -> Just $ Fixity NoSourceText 1 InfixL
|
||||
">>" -> Just $ Fixity NoSourceText 1 InfixL
|
||||
"=<<" -> Just $ Fixity NoSourceText 1 InfixR
|
||||
"$" -> Just $ Fixity NoSourceText 0 InfixR
|
||||
"`seq`" -> Just $ Fixity NoSourceText 0 InfixR
|
||||
"$!" -> Just $ Fixity NoSourceText 0 InfixR
|
||||
"!" -> Just $ Fixity NoSourceText 9 InfixL
|
||||
"//" -> Just $ Fixity NoSourceText 9 InfixL
|
||||
"<>" -> Just $ Fixity NoSourceText 6 InfixR
|
||||
"<$" -> Just $ Fixity NoSourceText 4 InfixL
|
||||
"<$>" -> Just $ Fixity NoSourceText 4 InfixL
|
||||
"<&>" -> Just $ Fixity NoSourceText 1 InfixL
|
||||
"&" -> Just $ Fixity NoSourceText 1 InfixL
|
||||
"<*>" -> Just $ Fixity NoSourceText 4 InfixL
|
||||
"<**>" -> Just $ Fixity NoSourceText 4 InfixL
|
||||
"*>" -> Just $ Fixity NoSourceText 4 InfixL
|
||||
"<*" -> Just $ Fixity NoSourceText 4 InfixL
|
||||
"`elem`" -> Just $ Fixity NoSourceText 4 InfixN
|
||||
"`notElem`" -> Just $ Fixity NoSourceText 4 InfixN
|
||||
"++" -> Just $ Fixity NoSourceText 5 InfixR
|
||||
"%" -> Just $ Fixity NoSourceText 7 InfixL
|
||||
"<|>" -> Just $ Fixity NoSourceText 3 InfixL
|
||||
".&." -> Just $ Fixity NoSourceText 7 InfixL
|
||||
".|." -> Just $ Fixity NoSourceText 5 InfixL
|
||||
"`xor`" -> Just $ Fixity NoSourceText 6 InfixL
|
||||
"`shift`" -> Just $ Fixity NoSourceText 8 InfixL
|
||||
"`rotate`" -> Just $ Fixity NoSourceText 8 InfixL
|
||||
"`shiftL`" -> Just $ Fixity NoSourceText 8 InfixL
|
||||
"`shiftR`" -> Just $ Fixity NoSourceText 8 InfixL
|
||||
"`rotateL`" -> Just $ Fixity NoSourceText 8 InfixL
|
||||
"`rotateR`" -> Just $ Fixity NoSourceText 8 InfixL
|
||||
".^." -> Just $ Fixity NoSourceText 6 InfixL
|
||||
".>>." -> Just $ Fixity NoSourceText 8 InfixL
|
||||
".<<." -> Just $ Fixity NoSourceText 8 InfixL
|
||||
"!>>." -> Just $ Fixity NoSourceText 8 InfixL
|
||||
"!<<." -> Just $ Fixity NoSourceText 8 InfixL
|
||||
">=>" -> Just $ Fixity NoSourceText 1 InfixR
|
||||
"<=<" -> Just $ Fixity NoSourceText 1 InfixR
|
||||
|
||||
":~:" -> Just $ Fixity NoSourceText 4 InfixN
|
||||
":~~:" -> Just $ Fixity NoSourceText 4 InfixN
|
||||
|
||||
-- non-base from random sources.
|
||||
"<|" -> Just $ Fixity NoSourceText 5 InfixR
|
||||
"|>" -> Just $ Fixity NoSourceText 5 InfixL
|
||||
"><" -> Just $ Fixity NoSourceText 5 InfixR
|
||||
"$+$" -> Just $ Fixity NoSourceText 5 InfixL
|
||||
"\\\\" -> Just $ Fixity NoSourceText 5 InfixN
|
||||
".>" -> Just $ Fixity NoSourceText 9 InfixL
|
||||
":?" -> Just $ Fixity NoSourceText 7 InfixN
|
||||
":-" -> Just $ Fixity NoSourceText 9 InfixR
|
||||
|
||||
str -> case (Safe.headMay str, Safe.lastMay str) of
|
||||
(Just '\'', _) -> hardcodedFixity False (drop 1 str)
|
||||
(Just '`', Just '`') -> Just $ Fixity NoSourceText 9 InfixL
|
||||
(Just c, _) | Data.Char.isAlpha c && allowUnqualify -> hardcodedFixity False
|
||||
$ dropWhile (\x -> (Data.Char.isAlpha x || x == '.')) str
|
||||
_ -> Nothing
|
||||
|
|
@ -59,6 +59,11 @@ staticDefaultConfig = Config
|
|||
, _lconfig_allowHangingQuasiQuotes = coerce True
|
||||
, _lconfig_experimentalSemicolonNewlines = coerce False
|
||||
-- , _lconfig_allowSinglelineRecord = coerce False
|
||||
, _lconfig_fixityAwareOps = coerce True
|
||||
, _lconfig_fixityAwareTypeOps = coerce False
|
||||
, _lconfig_fixityBasedAddAlignParens = coerce False
|
||||
, _lconfig_operatorParenthesisRefactorMode = coerce PRMKeep
|
||||
, _lconfig_operatorAllowUnqualify = coerce True
|
||||
}
|
||||
, _conf_errorHandling = ErrorHandlingConfig
|
||||
{ _econf_produceOutputOnErrors = coerce False
|
||||
|
|
@ -159,6 +164,11 @@ cmdlineConfigParser = do
|
|||
, _lconfig_allowHangingQuasiQuotes = mempty
|
||||
, _lconfig_experimentalSemicolonNewlines = mempty
|
||||
-- , _lconfig_allowSinglelineRecord = mempty
|
||||
, _lconfig_fixityAwareOps = mempty
|
||||
, _lconfig_fixityAwareTypeOps = mempty
|
||||
, _lconfig_fixityBasedAddAlignParens = mempty
|
||||
, _lconfig_operatorParenthesisRefactorMode = mempty
|
||||
, _lconfig_operatorAllowUnqualify = mempty
|
||||
}
|
||||
, _conf_errorHandling = ErrorHandlingConfig
|
||||
{ _econf_produceOutputOnErrors = wrapLast $ falseToNothing outputOnErrors
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Language.Haskell.Brittany.Internal.Config.Types where
|
||||
|
||||
|
|
@ -16,9 +17,14 @@ import Language.Haskell.Brittany.Internal.Prelude
|
|||
|
||||
|
||||
|
||||
confUnpack :: forall b a . Coercible a b => Identity a -> b
|
||||
confUnpack
|
||||
:: forall a . Coercible a (ConfUnpacked a) => Identity a -> ConfUnpacked a
|
||||
confUnpack (Identity x) = coerce x
|
||||
|
||||
type family ConfUnpacked a where
|
||||
ConfUnpacked (Last a) = a
|
||||
ConfUnpacked a = a
|
||||
|
||||
data CDebugConfig f = DebugConfig
|
||||
{ _dconf_dump_config :: f (Semigroup.Last Bool)
|
||||
, _dconf_dump_annotations :: f (Semigroup.Last Bool)
|
||||
|
|
@ -137,6 +143,38 @@ data CLayoutConfig f = LayoutConfig
|
|||
-- -- > { x :: Double
|
||||
-- -- > , y :: Double
|
||||
-- -- > }
|
||||
, _lconfig_fixityAwareOps :: f (Last Bool)
|
||||
-- enables fixity-based layouting, e.g.
|
||||
-- > foo =
|
||||
-- > ( aaaaaaaaaaaaaa * bbbbbbbbbbbbbbbbbbb
|
||||
-- > + ccccccccccc * ddddddddddddddddd
|
||||
-- > )
|
||||
-- Note how the layout puts multiplication in a line because brittany
|
||||
-- is aware that there are implicit parens around the lines.
|
||||
-- The fixities are currently taken from a static (baked-in) lookup table
|
||||
-- that was derived from the base library.
|
||||
-- Operator applications with unknown fixities will be treated as if
|
||||
-- this feature was turned off. In other words, such applications will be
|
||||
-- treated as if all operators had the same fixity without changing
|
||||
-- parentheses in any way.
|
||||
, _lconfig_fixityAwareTypeOps :: f (Last Bool)
|
||||
-- Same as above, but for type-level operators. Not yet implemented, but
|
||||
-- reserved for future use.
|
||||
, _lconfig_fixityBasedAddAlignParens :: f (Last Bool)
|
||||
-- Layouts multiple-line operator applications with parentheses if
|
||||
-- permitted by layout. Note how the arguments are properly aligned:
|
||||
-- > ( aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
|
||||
-- > <> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
|
||||
-- > <> ccccccccccccccccccccccc
|
||||
-- > )
|
||||
-- while this has operands at different indentations:
|
||||
-- > aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
|
||||
-- > <> bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
|
||||
-- > <> ccccccccccccccccccccccc
|
||||
-- But this _does_ waste a line for the closing paren, so no clear winner.
|
||||
-- Only has an effect in combination with fixityAware(Type)Ops.
|
||||
, _lconfig_operatorParenthesisRefactorMode :: f (Last ParenRefactorMode)
|
||||
, _lconfig_operatorAllowUnqualify :: f (Last Bool)
|
||||
}
|
||||
deriving Generic
|
||||
|
||||
|
|
@ -255,3 +293,13 @@ data ExactPrintFallbackMode
|
|||
-- THIS MAY THEORETICALLY CHANGE SEMANTICS OF
|
||||
-- A PROGRAM BY TRANSFORMING IT.
|
||||
deriving (Show, Generic, Data)
|
||||
|
||||
data ParenRefactorMode
|
||||
= PRMKeep
|
||||
-- ^ neither add parens (beyond _lconfig_fixityBasedAddAlignParens)
|
||||
-- Unknown operators will force Keep behaviour.
|
||||
| PRMMinimize
|
||||
-- ^ remove superfluous parens
|
||||
| PRMMaximize
|
||||
-- ^ insert parens around all operator applications.
|
||||
deriving (Show, Generic, Data)
|
||||
|
|
|
|||
|
|
@ -75,6 +75,13 @@ instance ToJSON ExactPrintFallbackMode where
|
|||
toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
|
||||
toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany
|
||||
|
||||
instance FromJSON ParenRefactorMode where
|
||||
parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
|
||||
|
||||
instance ToJSON ParenRefactorMode where
|
||||
toJSON = Aeson.genericToJSON aesonDecodeOptionsBrittany
|
||||
toEncoding = Aeson.genericToEncoding aesonDecodeOptionsBrittany
|
||||
|
||||
instance FromJSON (CLayoutConfig Maybe) where
|
||||
parseJSON = Aeson.genericParseJSON aesonDecodeOptionsBrittany
|
||||
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@ import GHC.Types.Name.Occurrence ( occNameString )
|
|||
import GHC.Types.Name.Reader ( RdrName(..) )
|
||||
import qualified GHC.Types.SrcLoc as GHC
|
||||
import GHC.Utils.Outputable ( Outputable )
|
||||
import Data.Coerce ( Coercible )
|
||||
import Language.Haskell.Brittany.Internal.Components.BriDoc
|
||||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
import Language.Haskell.Brittany.Internal.Prelude
|
||||
|
|
@ -137,6 +138,7 @@ instance PrintRdrNameWithAnns GHC.SrcSpanAnnN where
|
|||
EpAnn _ (GHC.NameAnn GHC.NameParensHash _ _ _ _) _ -> f "(#" name "#)"
|
||||
EpAnn _ (GHC.NameAnn GHC.NameBackquotes _ _ _ _) _ -> f "`" name "`"
|
||||
EpAnn _ (GHC.NameAnn GHC.NameSquare _ _ _ _) _ -> f "[" name "]"
|
||||
EpAnn _ (GHC.NameAnnQuote _ _ _) _ -> f "'" name ""
|
||||
-- TODO92 There are way more possible constructors here
|
||||
-- see https://hackage.haskell.org/package/ghc-9.2.5/docs/GHC-Parser-Annotation.html#t:NameAnn
|
||||
EpAnn _ _ _ -> rdrNameToText name
|
||||
|
|
@ -397,16 +399,19 @@ docSeparator :: ToBriDocM BriDocNumbered
|
|||
docSeparator = allocateNode BDSeparator
|
||||
|
||||
docNonBottomSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docNonBottomSpacing bdm = allocateNode . BDNonBottomSpacing False =<< bdm
|
||||
docNonBottomSpacing bdm = allocateNode . BDForceAlt (NonBottomSpacing False) =<< bdm
|
||||
|
||||
docNonBottomSpacingS :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docNonBottomSpacingS bdm = allocateNode . BDNonBottomSpacing True =<< bdm
|
||||
docNonBottomSpacingS bdm = allocateNode . BDForceAlt (NonBottomSpacing True) =<< bdm
|
||||
|
||||
docSetParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docSetParSpacing bdm = allocateNode . BDSetParSpacing =<< bdm
|
||||
docSetParSpacing bdm = allocateNode . BDForceAlt SetParSpacing =<< bdm
|
||||
|
||||
docForceParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docForceParSpacing bdm = allocateNode . BDForceParSpacing =<< bdm
|
||||
docForceParSpacing bdm = allocateNode . BDForceAlt ForceParSpacing =<< bdm
|
||||
|
||||
docForceZeroAdd :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docForceZeroAdd bdm = allocateNode . BDForceAlt ForceZeroAdd =<< bdm
|
||||
|
||||
docDebug :: String -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docDebug s bdm = allocateNode . BDDebug s =<< bdm
|
||||
|
|
@ -459,10 +464,10 @@ docPar lineM indentedM = do
|
|||
allocateNode $ BDPar BrIndentNone line indented
|
||||
|
||||
docForceSingleline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docForceSingleline bdm = allocateNode . BDForceSingleline =<< bdm
|
||||
docForceSingleline bdm = allocateNode . BDForceAlt ForceSingleline =<< bdm
|
||||
|
||||
docForceMultiline :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
docForceMultiline bdm = allocateNode . BDForceMultiline =<< bdm
|
||||
docForceMultiline bdm = allocateNode . BDForceAlt ForceMultiline =<< bdm
|
||||
|
||||
docEnsureIndent
|
||||
:: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
|
||||
|
|
@ -774,3 +779,9 @@ docHandleListElemCommsProperPost layouter es = case es of
|
|||
|
||||
epaLocationRealSrcSpanStart :: GHC.EpaLocation -> GHC.RealSrcLoc
|
||||
epaLocationRealSrcSpanStart = GHC.realSrcSpanStart . GHC.epaLocationRealSrcSpan
|
||||
|
||||
askLayoutConf
|
||||
:: Coercible a (ConfUnpacked a)
|
||||
=> (CLayoutConfig Identity -> Identity a)
|
||||
-> ToBriDocM (ConfUnpacked a)
|
||||
askLayoutConf f = mAsk <&> _conf_layout .> f .> confUnpack
|
||||
|
|
|
|||
|
|
@ -142,9 +142,10 @@ layoutBriDocM = \case
|
|||
layoutAddSepSpace
|
||||
BDAddBaseY indent bd -> do
|
||||
let indentF = case indent of
|
||||
BrIndentNone -> id
|
||||
BrIndentRegular -> layoutWithAddBaseCol
|
||||
BrIndentSpecial i -> layoutWithAddBaseColN i
|
||||
BrIndentNone -> id
|
||||
BrIndentRegular -> layoutWithAddBaseCol
|
||||
BrIndentRegularForce -> layoutWithAddBaseCol
|
||||
BrIndentSpecial i -> layoutWithAddBaseColN i
|
||||
indentF $ layoutBriDocM bd
|
||||
BDBaseYPushCur bd -> do
|
||||
layoutBaseYPushCur
|
||||
|
|
@ -158,18 +159,20 @@ layoutBriDocM = \case
|
|||
layoutIndentLevelPop
|
||||
BDEnsureIndent indent bd -> do
|
||||
let indentF = case indent of
|
||||
BrIndentNone -> id
|
||||
BrIndentRegular -> layoutWithAddBaseCol
|
||||
BrIndentSpecial i -> layoutWithAddBaseColN i
|
||||
BrIndentNone -> id
|
||||
BrIndentRegular -> layoutWithAddBaseCol
|
||||
BrIndentRegularForce -> layoutWithAddBaseCol
|
||||
BrIndentSpecial i -> layoutWithAddBaseColN i
|
||||
indentF $ do
|
||||
layoutWriteEnsureBlock
|
||||
layoutBriDocM bd
|
||||
BDPar indent sameLine indented -> do
|
||||
layoutBriDocM sameLine
|
||||
let indentF = case indent of
|
||||
BrIndentNone -> id
|
||||
BrIndentRegular -> layoutWithAddBaseCol
|
||||
BrIndentSpecial i -> layoutWithAddBaseColN i
|
||||
BrIndentNone -> id
|
||||
BrIndentRegular -> layoutWithAddBaseCol
|
||||
BrIndentRegularForce -> layoutWithAddBaseCol
|
||||
BrIndentSpecial i -> layoutWithAddBaseColN i
|
||||
indentF $ do
|
||||
layoutWriteNewline
|
||||
layoutBriDocM indented
|
||||
|
|
@ -183,8 +186,7 @@ layoutBriDocM = \case
|
|||
BDLines lines -> alignColsLines layoutBriDocM lines
|
||||
BDAlt [] -> error "empty BDAlt"
|
||||
BDAlt (alt : _) -> layoutBriDocM alt
|
||||
BDForceMultiline bd -> layoutBriDocM bd
|
||||
BDForceSingleline bd -> layoutBriDocM bd
|
||||
BDForceAlt _ bd -> layoutBriDocM bd
|
||||
BDForwardLineMode bd -> layoutBriDocM bd
|
||||
BDExternal shouldAddComment t -> do
|
||||
let tlines = Text.lines $ t <> Text.pack "\n"
|
||||
|
|
@ -276,17 +278,23 @@ layoutBriDocM = \case
|
|||
printComments comms
|
||||
mModify (\s -> s + CommentCounter (length comms))
|
||||
do
|
||||
marker <- mGet <&> _lstate_markerForDelta
|
||||
state <- mGet
|
||||
mModify $ \s -> s { _lstate_markerForDelta = Nothing }
|
||||
case marker of
|
||||
Nothing -> pure ()
|
||||
case _lstate_markerForDelta state of
|
||||
Just m -> do
|
||||
let p1 = (srcLocLine m, srcLocCol m)
|
||||
let p2 = (srcLocLine loc, srcLocCol loc)
|
||||
let newlinePlanned = case _lstate_plannedSpace state of
|
||||
PlannedNone -> False
|
||||
PlannedSameline{} -> False
|
||||
PlannedNewline{} -> True
|
||||
PlannedDelta{} -> True
|
||||
-- traceShow (ExactPrint.pos2delta p1 p2) $ pure ()
|
||||
case ExactPrint.pos2delta p1 p2 of
|
||||
SameLine{} -> pure ()
|
||||
DifferentLine n _ -> layoutWriteNewlines n
|
||||
DifferentLine n _ | newlinePlanned -> layoutWriteNewlines n
|
||||
| otherwise -> pure ()
|
||||
_ -> pure ()
|
||||
layoutBriDocM bd
|
||||
BDFlushCommentsPost loc shouldMark bd -> do
|
||||
layoutBriDocM bd
|
||||
|
|
@ -297,20 +305,10 @@ layoutBriDocM = \case
|
|||
comms <- takeBefore loc
|
||||
mModify (\s -> s + CommentCounter (length comms))
|
||||
printComments comms
|
||||
BDNonBottomSpacing _ bd -> layoutBriDocM bd
|
||||
BDSetParSpacing bd -> layoutBriDocM bd
|
||||
BDForceParSpacing bd -> layoutBriDocM bd
|
||||
BDDebug s bd -> do
|
||||
mTell $ TextL.Builder.fromText $ Text.pack $ "{-" ++ s ++ "-}"
|
||||
layoutBriDocM bd
|
||||
|
||||
mergeOn :: Ord b => (a -> b) -> [a] -> [a] -> [a]
|
||||
mergeOn _f xs [] = xs
|
||||
mergeOn _f [] ys = ys
|
||||
mergeOn f xs@(x:xr) ys@(y:yr)
|
||||
| f x <= f y = x : mergeOn f xr ys
|
||||
| otherwise = y : mergeOn f xs yr
|
||||
|
||||
takeBefore
|
||||
:: MonadMultiState [LEpaComment] m => RealSrcLoc -> m [LEpaComment]
|
||||
takeBefore loc = do
|
||||
|
|
|
|||
|
|
@ -60,7 +60,7 @@ processModule
|
|||
-> IO ([BrittanyError], TextL.Text)
|
||||
processModule traceFunc conf inlineConf parsedModule = do
|
||||
let shouldReformatHead =
|
||||
conf & _conf_layout & _lconfig_reformatModulePreamble & confUnpack @Bool
|
||||
conf & _conf_layout & _lconfig_reformatModulePreamble & confUnpack
|
||||
let
|
||||
wrapNonDeclToBriDoc = MultiRWSS.withMultiReader conf
|
||||
. MultiRWSS.withMultiState_ (CommentCounter 0)
|
||||
|
|
@ -143,18 +143,18 @@ processModule traceFunc conf inlineConf parsedModule = do
|
|||
-- trace ("---- DEBUGMESSAGES ---- ")
|
||||
-- . foldr (seq . join trace) id debugStrings
|
||||
debugStrings `forM_` \s -> useTraceFunc traceFunc s
|
||||
moduleElementsStream
|
||||
(\el rest -> do
|
||||
case el of
|
||||
MEExactModuleHead{} -> useTraceFunc traceFunc "MEExactModuleHead"
|
||||
MEPrettyModuleHead{} -> useTraceFunc traceFunc "MEPrettyModuleHead"
|
||||
MEImportDecl{} -> useTraceFunc traceFunc "MEImportDecl"
|
||||
MEDecl{} -> useTraceFunc traceFunc "MEDecl"
|
||||
MEComment{} -> useTraceFunc traceFunc "MEComment"
|
||||
MEWhitespace dp -> useTraceFunc traceFunc ("MEWhitespace " ++ show dp)
|
||||
rest
|
||||
)
|
||||
(\_ -> pure ())
|
||||
-- moduleElementsStream
|
||||
-- (\el rest -> do
|
||||
-- case el of
|
||||
-- MEExactModuleHead{} -> useTraceFunc traceFunc "MEExactModuleHead"
|
||||
-- MEPrettyModuleHead{} -> useTraceFunc traceFunc "MEPrettyModuleHead"
|
||||
-- MEImportDecl{} -> useTraceFunc traceFunc "MEImportDecl"
|
||||
-- MEDecl{} -> useTraceFunc traceFunc "MEDecl"
|
||||
-- MEComment{} -> useTraceFunc traceFunc "MEComment"
|
||||
-- MEWhitespace dp -> useTraceFunc traceFunc ("MEWhitespace " ++ show dp)
|
||||
-- rest
|
||||
-- )
|
||||
-- (\_ -> pure ())
|
||||
pure (errs, TextL.Builder.toLazyText out)
|
||||
|
||||
commentToDoc :: (Int, EpaCommentTok) -> ToBriDocM BriDocNumbered
|
||||
|
|
@ -213,7 +213,7 @@ getDeclConfig config inlineConf decl = cZipWith fromOptionIdentity config
|
|||
ppToplevelDecl :: LHsDecl GhcPs -> [(Int, EpaCommentTok)] -> PPMLocal ()
|
||||
ppToplevelDecl decl immediateAfterComms = do
|
||||
exactprintOnly <- mAsk <&> \declConfig ->
|
||||
declConfig & _conf_roundtrip_exactprint_only & confUnpack @Bool
|
||||
declConfig & _conf_roundtrip_exactprint_only & confUnpack
|
||||
bd <- fmap fst $ if exactprintOnly
|
||||
then briDocMToPPM
|
||||
$ docSeq (briDocByExact decl : map commentToDoc immediateAfterComms)
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,311 @@
|
|||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
module Language.Haskell.Brittany.Internal.ToBriDoc.OpTree where
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import GHC ( GenLocated(L) )
|
||||
import GHC.Hs
|
||||
import GHC.Types.Fixity ( Fixity(Fixity) )
|
||||
import qualified GHC.Types.SrcLoc as GHC
|
||||
|
||||
import Language.Haskell.Brittany.Internal.Components.BriDoc
|
||||
import Language.Haskell.Brittany.Internal.Components.OpTree
|
||||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
import Language.Haskell.Brittany.Internal.Prelude
|
||||
import Language.Haskell.Brittany.Internal.S3_ToBriDocTools
|
||||
import Language.Haskell.Brittany.Internal.Types
|
||||
import Language.Haskell.Brittany.Internal.Utils
|
||||
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.ToBriDoc.Expr
|
||||
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.ToBriDoc.Type
|
||||
|
||||
|
||||
gatherOpTreeE
|
||||
:: Bool
|
||||
-> Bool
|
||||
-> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
|
||||
-> Maybe GHC.RealSrcLoc
|
||||
-> Maybe GHC.RealSrcLoc
|
||||
-> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)]
|
||||
-> LHsExpr GhcPs
|
||||
-> ToBriDocM (OpTree, Bool)
|
||||
gatherOpTreeE hasParen hasComms commWrap locOpen locClose opExprList = \case
|
||||
(L _ (OpApp epAnn l1 op1 r1)) ->
|
||||
gatherOpTreeE
|
||||
hasParen
|
||||
(hasComms || hasAnyCommentsBelow epAnn)
|
||||
commWrap
|
||||
locOpen
|
||||
locClose
|
||||
((docHandleComms epAnn $ layoutExpr op1, layoutExpr r1) : opExprList)
|
||||
l1
|
||||
(L _ (HsPar epAnn inner)) -> do
|
||||
let AnnParen _ spanOpen spanClose = anns epAnn
|
||||
let mergePoses locMay span = case locMay of
|
||||
Nothing -> Just (epaLocationRealSrcSpanStart span)
|
||||
Just loc -> Just (min (epaLocationRealSrcSpanStart span) loc)
|
||||
(innerTree, innerHasComms) <-
|
||||
gatherOpTreeE True
|
||||
(hasComms || hasAnyCommentsBelow epAnn)
|
||||
(commWrap . docHandleComms epAnn)
|
||||
(mergePoses locOpen spanOpen)
|
||||
(mergePoses locClose spanClose)
|
||||
[]
|
||||
inner
|
||||
if null opExprList
|
||||
then pure (innerTree, innerHasComms)
|
||||
else do
|
||||
numberedRights <- opExprList `forM` \(x, y) -> do
|
||||
x' <- x
|
||||
y' <- y
|
||||
pure (x', y')
|
||||
pure
|
||||
$ ( OpUnknown hasParen locOpen locClose innerTree numberedRights
|
||||
, innerHasComms
|
||||
)
|
||||
final -> do
|
||||
numberedLeft <- commWrap $ layoutExpr final
|
||||
numberedRights <- opExprList `forM` \(x, y) -> do
|
||||
x' <- x
|
||||
y' <- y
|
||||
pure (x', y')
|
||||
pure
|
||||
$ ( OpUnknown hasParen
|
||||
locOpen
|
||||
locClose
|
||||
(OpLeaf $ numberedLeft)
|
||||
numberedRights
|
||||
, hasComms
|
||||
)
|
||||
|
||||
gatherOpTreeT
|
||||
:: Bool
|
||||
-> Bool
|
||||
-> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
|
||||
-> Maybe GHC.RealSrcLoc
|
||||
-> Maybe GHC.RealSrcLoc
|
||||
-> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)]
|
||||
-> LHsType GhcPs
|
||||
-> ToBriDocM (OpTree, Bool)
|
||||
gatherOpTreeT hasParen hasComms commWrap locOpen locClose opExprList = \case
|
||||
(L _ (HsOpTy NoExtField l1 op1 r1)) ->
|
||||
gatherOpTreeT
|
||||
hasParen
|
||||
hasComms
|
||||
commWrap
|
||||
locOpen
|
||||
locClose
|
||||
((docLit $ printRdrNameWithAnns op1, layoutType r1) : opExprList)
|
||||
l1
|
||||
(L _ (HsParTy epAnn inner)) -> do
|
||||
let AnnParen _ spanOpen spanClose = anns epAnn
|
||||
let mergePoses locMay span = case locMay of
|
||||
Nothing -> Just (epaLocationRealSrcSpanStart span)
|
||||
Just loc -> Just (min (epaLocationRealSrcSpanStart span) loc)
|
||||
(innerTree, innerHasComms) <-
|
||||
gatherOpTreeT True
|
||||
(hasComms || hasAnyCommentsBelow epAnn)
|
||||
(commWrap . docHandleComms epAnn)
|
||||
(mergePoses locOpen spanOpen)
|
||||
(mergePoses locClose spanClose)
|
||||
[]
|
||||
inner
|
||||
if null opExprList
|
||||
then pure (innerTree, innerHasComms)
|
||||
else do
|
||||
numberedRights <- opExprList `forM` \(x, y) -> do
|
||||
x' <- x
|
||||
y' <- y
|
||||
pure (x', y')
|
||||
pure
|
||||
$ ( OpUnknown hasParen locOpen locClose innerTree numberedRights
|
||||
, innerHasComms
|
||||
)
|
||||
final -> do
|
||||
numberedLeft <- commWrap $ layoutType final
|
||||
numberedRights <- opExprList `forM` \(x, y) -> do
|
||||
x' <- x
|
||||
y' <- y
|
||||
pure (x', y')
|
||||
pure
|
||||
$ ( OpUnknown hasParen
|
||||
locOpen
|
||||
locClose
|
||||
(OpLeaf $ numberedLeft)
|
||||
numberedRights
|
||||
, hasComms
|
||||
)
|
||||
|
||||
processOpTree :: (OpTree, Bool) -> ToBriDocM BriDocNumbered
|
||||
processOpTree (unknownTree, hasComments) = do
|
||||
enabled <- askLayoutConf _lconfig_fixityAwareOps
|
||||
refactorMode <- askLayoutConf _lconfig_operatorParenthesisRefactorMode
|
||||
allowOpUnqualify <- askLayoutConf _lconfig_operatorAllowUnqualify
|
||||
let (warns, balancedTree) = if enabled
|
||||
then balanceOpTree allowOpUnqualify unknownTree
|
||||
else ([], unknownTree)
|
||||
mTell warns
|
||||
let processedTree = case refactorMode of
|
||||
PRMKeep -> balancedTree
|
||||
PRMMinimize -> remSuperfluousParens 11 balancedTree
|
||||
PRMMaximize -> addAllParens False balancedTree
|
||||
-- tellDebugMess $ displayOpTree balancedTree
|
||||
-- tellDebugMess $ displayOpTree processedTree
|
||||
layoutOpTree (not hasComments) processedTree
|
||||
|
||||
layoutOpTree :: Bool -> OpTree -> ToBriDocM BriDocNumbered
|
||||
layoutOpTree allowSinglelinePar = \case
|
||||
OpUnknown hasParen locO locC leftTree docOps -> do
|
||||
let sharedOps = fmap (\(a, b) -> (pure a, pure b)) docOps
|
||||
leftDoc <- layoutOpTree True leftTree
|
||||
coreAlternative hasParen
|
||||
locO
|
||||
locC
|
||||
Nothing
|
||||
(pure leftDoc)
|
||||
sharedOps
|
||||
sharedOps
|
||||
docForceSingleline
|
||||
OpKnown hasParen locO locC fixity treeL docOps -> do
|
||||
let Fixity _ _prec _ = fixity
|
||||
docL <- shareDoc $ layoutOpTree True treeL
|
||||
let flattenList ops = case ops of
|
||||
[] -> pure []
|
||||
[(op, tree)] -> case treeL of
|
||||
OpLeaf{} -> flattenInner op tree
|
||||
_ -> do
|
||||
treeDoc <- shareDoc $ layoutOpTree True tree
|
||||
pure [(pure op, treeDoc)]
|
||||
((op1, tree1@OpLeaf{}) : tR) -> do
|
||||
tree1Doc <- shareDoc $ layoutOpTree True tree1
|
||||
flattenRest <- flattenList tR
|
||||
pure $ (pure op1, tree1Doc) : flattenRest
|
||||
_ -> simpleTransform ops
|
||||
flattenInner op = \case
|
||||
OpKnown False _ _ _ innerL innerOps | isPrec0 fixity -> do
|
||||
flattenList ((op, innerL) : innerOps)
|
||||
tree -> do
|
||||
treeDoc <- shareDoc $ layoutOpTree True tree
|
||||
pure [(pure op, treeDoc)]
|
||||
simpleTransform
|
||||
:: [(BriDocNumbered, OpTree)]
|
||||
-> ToBriDocM [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)]
|
||||
simpleTransform = mapM $ \(op, subTree) -> do
|
||||
subDoc <- shareDoc $ layoutOpTree True subTree
|
||||
pure (pure op, subDoc)
|
||||
sharedOpsFlat <- flattenList docOps
|
||||
sharedOps <- simpleTransform docOps
|
||||
coreAlternative hasParen
|
||||
locO
|
||||
locC
|
||||
(Just fixity)
|
||||
docL
|
||||
sharedOps
|
||||
sharedOpsFlat
|
||||
docForceParSpacing
|
||||
OpLeaf l -> pure l
|
||||
where
|
||||
isPrec0 = \case
|
||||
Fixity _ prec _ -> prec == 0
|
||||
coreAlternative
|
||||
:: Bool
|
||||
-> Maybe GHC.RealSrcLoc
|
||||
-> Maybe GHC.RealSrcLoc
|
||||
-> Maybe Fixity
|
||||
-> ToBriDocM BriDocNumbered
|
||||
-> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)]
|
||||
-> [(ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)]
|
||||
-> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
|
||||
-> ToBriDocM BriDocNumbered
|
||||
coreAlternative hasParen locO locC fixity docL sharedOps sharedOpsFlat lastWrap
|
||||
= do
|
||||
let wrapParenIfSl x inner = if x then wrapParenSl inner else inner
|
||||
wrapParenSl inner = docAlt
|
||||
[ docSeq
|
||||
[ docLit $ Text.pack "("
|
||||
, docHandleComms locO $ docForceSingleline inner
|
||||
, docHandleComms locC $ docLit $ Text.pack ")"
|
||||
]
|
||||
, docLines
|
||||
[ docSeq [docLitS "(", docHandleComms locO inner]
|
||||
, docHandleComms locC $ docLit $ Text.pack ")"
|
||||
]
|
||||
]
|
||||
wrapParenMlIf x innerHead innerLines = if x
|
||||
then wrapParenMl innerHead innerLines
|
||||
else docPar innerHead (docLines innerLines)
|
||||
wrapParenMl innerHead innerLines = docSetBaseY $ docLines
|
||||
( [ docCols
|
||||
ColOpPrefix
|
||||
[ appSep $ docLit $ Text.pack "("
|
||||
, docHandleComms locO $ innerHead
|
||||
]
|
||||
]
|
||||
++ innerLines
|
||||
++ [docHandleComms locC $ docLit $ Text.pack ")"]
|
||||
)
|
||||
|
||||
configAllowsParInsert <- askLayoutConf _lconfig_fixityBasedAddAlignParens
|
||||
let allowParIns = configAllowsParInsert && case fixity of
|
||||
Nothing -> False
|
||||
Just (Fixity _ prec _) -> prec > 0
|
||||
|
||||
runFilteredAlternative $ do
|
||||
-- > one + two + three
|
||||
-- or
|
||||
-- > one + two + case x of
|
||||
-- > _ -> three
|
||||
addAlternativeCond allowSinglelinePar $ wrapParenIfSl hasParen $ docSeq
|
||||
([docForceSingleline docL] ++ case splitFirstLast sharedOps of
|
||||
FirstLastEmpty -> []
|
||||
FirstLastSingleton (od, ed) ->
|
||||
[docSeparator, docForceSingleline od, docSeparator, lastWrap ed]
|
||||
FirstLast (od1, ed1) ems (odN, edN) ->
|
||||
( [ docSeparator
|
||||
, docForceSingleline od1
|
||||
, docSeparator
|
||||
, docForceSingleline ed1
|
||||
]
|
||||
++ join
|
||||
[ [ docSeparator
|
||||
, docForceSingleline od
|
||||
, docSeparator
|
||||
, docForceSingleline ed
|
||||
]
|
||||
| (od, ed) <- ems
|
||||
]
|
||||
++ [ docSeparator
|
||||
, docForceSingleline odN
|
||||
, docSeparator
|
||||
, lastWrap edN
|
||||
]
|
||||
)
|
||||
)
|
||||
-- this case rather leads to some unfortunate layouting than to anything
|
||||
-- useful; disabling for now. (it interfers with cols stuff.)
|
||||
addAlternativeCond (not hasParen) $ docPar
|
||||
(docHandleComms locO $ docForceSingleline $ docL)
|
||||
(docFlushCommsPost False locC $ docLines $ sharedOps <&> \(od, ed) ->
|
||||
docCols ColOpPrefix [appSep od, docForceSingleline ed]
|
||||
)
|
||||
-- > ( one
|
||||
-- > + two
|
||||
-- > + three
|
||||
-- > )
|
||||
addAlternativeCond (allowParIns && not hasParen)
|
||||
$ docForceZeroAdd
|
||||
$ wrapParenMl
|
||||
(docSetBaseY docL)
|
||||
(sharedOpsFlat <&> \(od, ed) ->
|
||||
docCols ColOpPrefix [appSep od, docSetBaseY ed]
|
||||
)
|
||||
-- > one
|
||||
-- > + two
|
||||
-- > + three
|
||||
addAlternative
|
||||
$ wrapParenMlIf
|
||||
hasParen
|
||||
-- ((if not hasParen then docAddBaseY BrIndentRegular else id) docL)
|
||||
(if hasParen then docSetBaseY docL else docL)
|
||||
(sharedOpsFlat <&> \(od, ed) ->
|
||||
docCols ColOpPrefix [appSep od, docSetBaseY ed]
|
||||
)
|
||||
|
|
@ -17,6 +17,7 @@ import Language.Haskell.Brittany.Internal.Types
|
|||
import Language.Haskell.Brittany.Internal.Components.BriDoc
|
||||
import Language.Haskell.Brittany.Internal.Utils
|
||||
(FirstLastView(..), splitFirstLast)
|
||||
import Language.Haskell.Brittany.Internal.ToBriDoc.OpTree
|
||||
|
||||
|
||||
|
||||
|
|
@ -262,8 +263,9 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
|
|||
(docAddBaseY (BrIndentSpecial 2) line1)
|
||||
(docLines $ lines ++ [wrapEnd end])
|
||||
]
|
||||
HsOpTy{} -> -- TODO
|
||||
briDocByExactInlineOnly "HsOpTy{}" ltype
|
||||
HsOpTy{} -> do
|
||||
treeAndHasComms <- gatherOpTreeT False False id Nothing Nothing [] ltype
|
||||
processOpTree treeAndHasComms
|
||||
-- HsOpTy typ1 opName typ2 -> do
|
||||
-- -- TODO: these need some proper fixing. precedences don't add up.
|
||||
-- -- maybe the parser just returns some trivial right recursion
|
||||
|
|
|
|||
|
|
@ -0,0 +1,10 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
module Language.Haskell.Brittany.Internal.ToBriDoc.Type where
|
||||
|
||||
import GHC.Hs
|
||||
|
||||
import Language.Haskell.Brittany.Internal.Types
|
||||
|
||||
layoutType :: ToBriDoc HsType
|
||||
|
|
@ -36,9 +36,10 @@ data VerticalSpacingPar
|
|||
|
||||
data VerticalSpacing
|
||||
= VerticalSpacing
|
||||
{ _vs_sameLine :: !Int
|
||||
, _vs_paragraph :: !VerticalSpacingPar
|
||||
, _vs_parFlag :: !Bool
|
||||
{ _vs_sameLine :: !Int
|
||||
, _vs_paragraph :: !VerticalSpacingPar
|
||||
, _vs_parFlag :: !Bool
|
||||
, _vs_onlyZeroAddInd :: !Bool
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
|
@ -54,6 +55,7 @@ data AltCurPos = AltCurPos
|
|||
{ _acp_line :: Int -- chars in the current line
|
||||
, _acp_indent :: Int -- current indentation level
|
||||
, _acp_indentPrep :: Int -- indentChange affecting the next Par
|
||||
, _acp_indentPrepForced :: Bool
|
||||
, _acp_forceMLFlag :: AltLineModeState
|
||||
}
|
||||
deriving Show
|
||||
|
|
@ -99,7 +101,7 @@ transformAlts
|
|||
=> BriDocNumbered
|
||||
-> MultiRWSS.MultiRWS r w s BriDoc
|
||||
transformAlts =
|
||||
MultiRWSS.withMultiStateA (AltCurPos 0 0 0 AltLineModeStateNone)
|
||||
MultiRWSS.withMultiStateA (AltCurPos 0 0 0 False AltLineModeStateNone)
|
||||
. Memo.startEvalMemoT
|
||||
. fmap unwrapBriDocNumbered
|
||||
. rec
|
||||
|
|
@ -163,14 +165,18 @@ transformAlts =
|
|||
BDSeparator -> processSpacingSimple bdX $> bdX
|
||||
BDAddBaseY indent bd -> do
|
||||
acp <- mGet
|
||||
indAdd <- fixIndentationForMultiple acp indent
|
||||
mSet $ acp { _acp_indentPrep = max (_acp_indentPrep acp) indAdd }
|
||||
(indAdd, forced) <- fixIndentationForMultiple acp indent
|
||||
mSet $ acp
|
||||
{ _acp_indentPrep = max (_acp_indentPrep acp) indAdd
|
||||
, _acp_indentPrepForced = forced || _acp_indentPrepForced acp
|
||||
}
|
||||
r <- rec bd
|
||||
acp' <- mGet
|
||||
mSet $ acp' { _acp_indent = _acp_indent acp }
|
||||
return $ case indent of
|
||||
BrIndentNone -> r
|
||||
BrIndentRegular -> reWrap $ BDAddBaseY (BrIndentSpecial indAdd) r
|
||||
BrIndentRegularForce -> reWrap $ BDAddBaseY (BrIndentSpecial indAdd) r
|
||||
BrIndentSpecial i -> reWrap $ BDAddBaseY (BrIndentSpecial i) r
|
||||
BDBaseYPushCur bd -> do
|
||||
acp <- mGet
|
||||
|
|
@ -188,16 +194,24 @@ transformAlts =
|
|||
BDPar indent sameLine indented -> do
|
||||
indAmount <-
|
||||
mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
|
||||
let
|
||||
indAdd = case indent of
|
||||
BrIndentNone -> 0
|
||||
BrIndentRegular -> indAmount
|
||||
BrIndentSpecial i -> i
|
||||
acp <- mGet
|
||||
let parentForced = _acp_indentPrepForced acp
|
||||
let
|
||||
(indAdd, forced) = case indent of
|
||||
BrIndentNone -> (0 , parentForced)
|
||||
BrIndentRegular -> (indAmount, parentForced)
|
||||
BrIndentRegularForce -> (indAmount, True )
|
||||
BrIndentSpecial i -> (i , parentForced)
|
||||
let ind = _acp_indent acp + _acp_indentPrep acp + indAdd
|
||||
mSet $ acp { _acp_indent = ind, _acp_indentPrep = 0 }
|
||||
mSet $ acp
|
||||
{ _acp_indent = ind, _acp_indentPrep = 0
|
||||
, _acp_indentPrepForced = False
|
||||
}
|
||||
sameLine' <- rec sameLine
|
||||
mModify $ \acp' -> acp' { _acp_line = ind, _acp_indent = ind }
|
||||
mModify $ \acp' -> acp'
|
||||
{ _acp_line = ind, _acp_indent = ind
|
||||
, _acp_indentPrepForced = forced
|
||||
}
|
||||
indented' <- rec indented
|
||||
return $ reWrap $ BDPar indent sameLine' indented'
|
||||
BDAlt [] -> error "empty BDAlt" -- returning BDEmpty instead is a
|
||||
|
|
@ -214,12 +228,14 @@ transformAlts =
|
|||
acp <- mGet
|
||||
let
|
||||
lineCheck LineModeInvalid = False
|
||||
lineCheck (LineModeValid (VerticalSpacing _ p _)) =
|
||||
case _acp_forceMLFlag acp of
|
||||
AltLineModeStateNone -> True
|
||||
AltLineModeStateForceSL{} -> p == VerticalSpacingParNone
|
||||
AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
|
||||
AltLineModeStateContradiction -> False
|
||||
lineCheck (LineModeValid (VerticalSpacing _ p _ z)) =
|
||||
let pRes = case _acp_forceMLFlag acp of
|
||||
AltLineModeStateNone -> True
|
||||
AltLineModeStateForceSL{} -> p == VerticalSpacingParNone
|
||||
AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
|
||||
AltLineModeStateContradiction -> False
|
||||
zRes = not z || not (_acp_indentPrepForced acp)
|
||||
in pRes && zRes
|
||||
-- TODO: use COMPLETE pragma instead?
|
||||
lineCheck _ = error "ghc exhaustive check is insufficient"
|
||||
lconf <- _conf_layout <$> mAsk
|
||||
|
|
@ -244,11 +260,14 @@ transformAlts =
|
|||
spacings <- alts `forM` getSpacings limit
|
||||
acp <- mGet
|
||||
let
|
||||
lineCheck (VerticalSpacing _ p _) = case _acp_forceMLFlag acp of
|
||||
AltLineModeStateNone -> True
|
||||
AltLineModeStateForceSL{} -> p == VerticalSpacingParNone
|
||||
AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
|
||||
AltLineModeStateContradiction -> False
|
||||
lineCheck (VerticalSpacing _ p _ z) =
|
||||
let pRes = case _acp_forceMLFlag acp of
|
||||
AltLineModeStateNone -> True
|
||||
AltLineModeStateForceSL{} -> p == VerticalSpacingParNone
|
||||
AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
|
||||
AltLineModeStateContradiction -> False
|
||||
zRes = not z || not (_acp_indentPrepForced acp)
|
||||
in pRes && zRes
|
||||
lconf <- _conf_layout <$> mAsk
|
||||
let
|
||||
options = -- trace ("considering options:" ++ show (length alts, acp)) $
|
||||
|
|
@ -263,32 +282,27 @@ transformAlts =
|
|||
$ fromMaybe (-- trace ("choosing last") $
|
||||
List.last alts)
|
||||
$ Data.List.Extra.firstJust (fmap snd) checkedOptions
|
||||
BDForceMultiline bd -> do
|
||||
BDForceAlt ForceMultiline bd -> do
|
||||
acp <- mGet
|
||||
x <- do
|
||||
mSet $ mergeLineMode acp (AltLineModeStateForceML False)
|
||||
rec bd
|
||||
acp' <- mGet
|
||||
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
||||
return $ x
|
||||
BDForceSingleline bd -> do
|
||||
mSet $ mergeLineMode acp (AltLineModeStateForceML False)
|
||||
x <- rec bd
|
||||
mModify $ \acp' -> acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
||||
pure $ x
|
||||
BDForceAlt ForceSingleline bd -> do
|
||||
acp <- mGet
|
||||
x <- do
|
||||
mSet $ mergeLineMode acp AltLineModeStateForceSL
|
||||
rec bd
|
||||
acp' <- mGet
|
||||
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
||||
return $ x
|
||||
mSet $ mergeLineMode acp AltLineModeStateForceSL
|
||||
x <- rec bd
|
||||
mModify $ \acp' -> acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
||||
pure $ x
|
||||
BDForwardLineMode bd -> do
|
||||
acp <- mGet
|
||||
x <- do
|
||||
mSet $ acp
|
||||
{ _acp_forceMLFlag = altLineModeRefresh $ _acp_forceMLFlag acp
|
||||
}
|
||||
rec bd
|
||||
acp' <- mGet
|
||||
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
||||
return $ x
|
||||
mSet $ acp
|
||||
{ _acp_forceMLFlag = altLineModeRefresh $ _acp_forceMLFlag acp
|
||||
}
|
||||
x <- rec bd
|
||||
mModify $ \acp' -> acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
||||
pure $ x
|
||||
BDForceAlt ForceZeroAdd bd -> rec bd
|
||||
BDExternal{} -> processSpacingSimple bdX $> bdX
|
||||
BDPlain{} -> processSpacingSimple bdX $> bdX
|
||||
BDQueueComments comms bd ->
|
||||
|
|
@ -305,18 +319,23 @@ transformAlts =
|
|||
reWrap . BDFlushCommentsPost loc shouldMark <$> rec bd
|
||||
BDLines [] -> return $ reWrap BDEmpty -- evil transformation. or harmless.
|
||||
BDLines (l : lr) -> do
|
||||
ind <- _acp_indent <$> mGet
|
||||
initialAcp <- mGet
|
||||
l' <- rec l
|
||||
lr' <- lr `forM` \x -> do
|
||||
mModify $ \acp -> acp { _acp_line = ind, _acp_indent = ind }
|
||||
mModify $ \acp -> acp
|
||||
{ _acp_line = _acp_indent initialAcp
|
||||
, _acp_indent = _acp_indent initialAcp
|
||||
, _acp_indentPrepForced = _acp_indentPrepForced initialAcp
|
||||
}
|
||||
rec x
|
||||
return $ reWrap $ BDLines (l' : lr')
|
||||
BDEnsureIndent indent bd -> do
|
||||
acp <- mGet
|
||||
indAdd <- fixIndentationForMultiple acp indent
|
||||
(indAdd, forced) <- fixIndentationForMultiple acp indent
|
||||
mSet $ acp
|
||||
{ _acp_indentPrep = 0
|
||||
-- TODO: i am not sure this is valid, in general.
|
||||
, _acp_indentPrepForced = forced
|
||||
, _acp_indent = _acp_indent acp + indAdd
|
||||
, _acp_line = max (_acp_line acp) (_acp_indent acp + indAdd)
|
||||
-- we cannot use just _acp_line acp + indAdd because of the case
|
||||
|
|
@ -331,10 +350,12 @@ transformAlts =
|
|||
BrIndentNone -> r
|
||||
BrIndentRegular ->
|
||||
reWrap $ BDEnsureIndent (BrIndentSpecial indAdd) r
|
||||
BrIndentRegularForce ->
|
||||
reWrap $ BDEnsureIndent (BrIndentSpecial indAdd) r
|
||||
BrIndentSpecial i -> reWrap $ BDEnsureIndent (BrIndentSpecial i) r
|
||||
BDNonBottomSpacing _ bd -> rec bd
|
||||
BDSetParSpacing bd -> rec bd
|
||||
BDForceParSpacing bd -> rec bd
|
||||
BDForceAlt (NonBottomSpacing _) bd -> rec bd
|
||||
BDForceAlt SetParSpacing bd -> rec bd
|
||||
BDForceAlt ForceParSpacing bd -> rec bd
|
||||
BDDebug s bd -> do
|
||||
acp :: AltCurPos <- mGet
|
||||
tellDebugMess
|
||||
|
|
@ -354,7 +375,7 @@ transformAlts =
|
|||
-> m ()
|
||||
processSpacingSimple bd = getSpacing bd >>= \case
|
||||
LineModeInvalid -> error "processSpacingSimple inv"
|
||||
LineModeValid (VerticalSpacing i VerticalSpacingParNone _) -> do
|
||||
LineModeValid (VerticalSpacing i VerticalSpacingParNone _ _) -> do
|
||||
acp <- mGet
|
||||
mSet $ acp { _acp_line = _acp_line acp + i }
|
||||
LineModeValid VerticalSpacing{} -> error "processSpacingSimple par"
|
||||
|
|
@ -365,9 +386,9 @@ transformAlts =
|
|||
hasSpace1 lconf acp (LineModeValid vs) = hasSpace2 lconf acp vs
|
||||
hasSpace1 _ _ _ = error "ghc exhaustive check is insufficient"
|
||||
hasSpace2 :: LayoutConfig -> AltCurPos -> VerticalSpacing -> Bool
|
||||
hasSpace2 lconf (AltCurPos line _indent _ _) (VerticalSpacing sameLine VerticalSpacingParNone _)
|
||||
hasSpace2 lconf (AltCurPos line _indent _ _ _) (VerticalSpacing sameLine VerticalSpacingParNone _ _)
|
||||
= line + sameLine <= confUnpack (_lconfig_cols lconf)
|
||||
hasSpace2 lconf (AltCurPos line indent indentPrep _) (VerticalSpacing sameLine (VerticalSpacingParSome par) _)
|
||||
hasSpace2 lconf (AltCurPos line indent indentPrep _ _) (VerticalSpacing sameLine (VerticalSpacingParSome par) _ _)
|
||||
= line
|
||||
+ sameLine
|
||||
<= confUnpack (_lconfig_cols lconf)
|
||||
|
|
@ -375,7 +396,7 @@ transformAlts =
|
|||
+ indentPrep
|
||||
+ par
|
||||
<= confUnpack (_lconfig_cols lconf)
|
||||
hasSpace2 lconf (AltCurPos line _indent _ _) (VerticalSpacing sameLine VerticalSpacingParAlways{} _)
|
||||
hasSpace2 lconf (AltCurPos line _indent _ _ _) (VerticalSpacing sameLine VerticalSpacingParAlways{} _ _)
|
||||
= line + sameLine <= confUnpack (_lconfig_cols lconf)
|
||||
|
||||
getSpacing
|
||||
|
|
@ -389,40 +410,45 @@ getSpacing !bridoc = rec bridoc
|
|||
rec (brDcId, brDc) = do
|
||||
config <- mAsk
|
||||
let colMax = config & _conf_layout & _lconfig_cols & confUnpack
|
||||
result <- case brDc of
|
||||
let indAmount = confUnpack $ _lconfig_indentAmount $ _conf_layout $ config
|
||||
result :: LineModeValidity VerticalSpacing <- case brDc of
|
||||
-- BDWrapAnnKey _annKey bd -> rec bd
|
||||
BDEmpty ->
|
||||
return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
|
||||
BDLit t -> return $ LineModeValid $ VerticalSpacing
|
||||
(Text.length t)
|
||||
VerticalSpacingParNone
|
||||
False
|
||||
pure
|
||||
$ LineModeValid
|
||||
$ VerticalSpacing 0 VerticalSpacingParNone False False
|
||||
BDLit t ->
|
||||
pure
|
||||
$ LineModeValid
|
||||
$ VerticalSpacing (Text.length t) VerticalSpacingParNone False False
|
||||
BDSeq list -> sumVs <$> rec `mapM` list
|
||||
BDCols _sig list -> sumVs <$> rec `mapM` list
|
||||
BDSeparator ->
|
||||
return $ LineModeValid $ VerticalSpacing 1 VerticalSpacingParNone False
|
||||
pure
|
||||
$ LineModeValid
|
||||
$ VerticalSpacing 1 VerticalSpacingParNone False False
|
||||
BDAddBaseY indent bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs
|
||||
{ _vs_paragraph = case _vs_paragraph vs of
|
||||
VerticalSpacingParNone -> VerticalSpacingParNone
|
||||
VerticalSpacingParAlways i ->
|
||||
VerticalSpacingParAlways $ case indent of
|
||||
BrIndentNone -> i
|
||||
BrIndentRegular ->
|
||||
i
|
||||
+ (confUnpack
|
||||
$ _lconfig_indentAmount
|
||||
$ _conf_layout
|
||||
$ config
|
||||
)
|
||||
BrIndentSpecial j -> i + j
|
||||
VerticalSpacingParSome i -> VerticalSpacingParSome $ case indent of
|
||||
BrIndentNone -> i
|
||||
BrIndentRegular ->
|
||||
i + (confUnpack $ _lconfig_indentAmount $ _conf_layout $ config)
|
||||
BrIndentSpecial j -> i + j
|
||||
}
|
||||
pure
|
||||
[ vs
|
||||
{ _vs_paragraph = case _vs_paragraph vs of
|
||||
VerticalSpacingParNone -> VerticalSpacingParNone
|
||||
VerticalSpacingParAlways i ->
|
||||
VerticalSpacingParAlways $ case indent of
|
||||
BrIndentNone -> i
|
||||
BrIndentRegular -> i + indAmount
|
||||
BrIndentRegularForce -> i + indAmount
|
||||
BrIndentSpecial j -> i + j
|
||||
VerticalSpacingParSome i ->
|
||||
VerticalSpacingParSome $ case indent of
|
||||
BrIndentNone -> i
|
||||
BrIndentRegular -> i + indAmount
|
||||
BrIndentRegularForce -> i + indAmount
|
||||
BrIndentSpecial j -> i + j
|
||||
}
|
||||
| vs <- mVs
|
||||
, indent == BrIndentNone || _vs_onlyZeroAddInd vs == False
|
||||
]
|
||||
BDBaseYPushCur bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs
|
||||
|
|
@ -446,8 +472,8 @@ getSpacing !bridoc = rec bridoc
|
|||
mVs <- rec sameLine
|
||||
mIndSp <- rec indented
|
||||
return
|
||||
$ [ VerticalSpacing lsp pspResult parFlagResult
|
||||
| VerticalSpacing lsp mPsp _ <- mVs
|
||||
$ [ VerticalSpacing lsp pspResult parFlagResult False -- TODO92 should we turn this on?
|
||||
| VerticalSpacing lsp mPsp _ _ <- mVs
|
||||
, indSp <- mIndSp
|
||||
, lineMax <- getMaxVS $ mIndSp
|
||||
, let
|
||||
|
|
@ -468,49 +494,59 @@ getSpacing !bridoc = rec bridoc
|
|||
BDPar{} -> error "BDPar with indent in getSpacing"
|
||||
BDAlt [] -> error "empty BDAlt"
|
||||
BDAlt (alt : _) -> rec alt
|
||||
BDForceMultiline bd -> do
|
||||
BDForceAlt ForceMultiline bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs >>= _vs_paragraph .> \case
|
||||
VerticalSpacingParNone -> LineModeInvalid
|
||||
_ -> mVs
|
||||
BDForceSingleline bd -> do
|
||||
BDForceAlt ForceSingleline bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs >>= _vs_paragraph .> \case
|
||||
VerticalSpacingParNone -> mVs
|
||||
_ -> LineModeInvalid
|
||||
BDForceAlt ForceZeroAdd bd -> do
|
||||
mVs <- rec bd
|
||||
pure $ [ vs { _vs_onlyZeroAddInd = True } | vs <- mVs ]
|
||||
BDForwardLineMode bd -> rec bd
|
||||
BDExternal _ txt -> return $ LineModeValid $ case Text.lines txt of
|
||||
[t] -> VerticalSpacing (Text.length t) VerticalSpacingParNone False
|
||||
_ -> VerticalSpacing 999 VerticalSpacingParNone False
|
||||
[t] ->
|
||||
VerticalSpacing (Text.length t) VerticalSpacingParNone False False
|
||||
_ -> VerticalSpacing 999 VerticalSpacingParNone False False
|
||||
BDPlain txt -> return $ LineModeValid $ case Text.lines txt of
|
||||
[t] -> VerticalSpacing (Text.length t) VerticalSpacingParNone False
|
||||
_ -> VerticalSpacing 999 VerticalSpacingParNone False
|
||||
[t] ->
|
||||
VerticalSpacing (Text.length t) VerticalSpacingParNone False False
|
||||
_ -> VerticalSpacing 999 VerticalSpacingParNone False False
|
||||
BDQueueComments _comms bd -> rec bd
|
||||
BDFlushCommentsPrior _loc bd -> rec bd
|
||||
BDFlushCommentsPost _loc _shouldMark bd -> rec bd
|
||||
BDEntryDelta _dp bd -> rec bd
|
||||
BDLines [] ->
|
||||
return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
|
||||
pure
|
||||
$ LineModeValid
|
||||
$ VerticalSpacing 0 VerticalSpacingParNone False False
|
||||
-- TODO92 should we set _vs_onlyZeroAddInd here too?
|
||||
-- did not do that before, but it makes sense for lines..
|
||||
BDLines (l1 : lR) -> do
|
||||
mVs <- rec l1
|
||||
mVRs <- rec `mapM` lR
|
||||
let lSps = mVs : mVRs
|
||||
return
|
||||
$ [ VerticalSpacing lsp (VerticalSpacingParSome $ lineMax) False
|
||||
| VerticalSpacing lsp _ _ <- mVs
|
||||
$ [ VerticalSpacing lsp (VerticalSpacingParSome $ lineMax) False False
|
||||
-- TODO92 should we set _vs_onlyZeroAddInd here too?
|
||||
-- did not do that before, but it makes sense for lines..
|
||||
| VerticalSpacing lsp _ _ _ <- mVs
|
||||
, lineMax <- getMaxVS $ maxVs $ lSps
|
||||
]
|
||||
BDEnsureIndent indent bd -> do
|
||||
mVs <- rec bd
|
||||
let
|
||||
addInd = case indent of
|
||||
BrIndentNone -> 0
|
||||
BrIndentRegular ->
|
||||
confUnpack $ _lconfig_indentAmount $ _conf_layout $ config
|
||||
BrIndentSpecial i -> i
|
||||
return $ mVs <&> \(VerticalSpacing lsp psp pf) ->
|
||||
VerticalSpacing (lsp + addInd) psp pf
|
||||
BDNonBottomSpacing b bd -> do
|
||||
let addInd = case indent of
|
||||
BrIndentNone -> 0
|
||||
BrIndentRegular -> indAmount
|
||||
BrIndentRegularForce -> indAmount
|
||||
BrIndentSpecial i -> i
|
||||
return $ mVs <&> \(VerticalSpacing lsp psp pf _) ->
|
||||
VerticalSpacing (lsp + addInd) psp pf False
|
||||
BDForceAlt (NonBottomSpacing b) bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <|> LineModeValid
|
||||
(VerticalSpacing
|
||||
|
|
@ -520,11 +556,12 @@ getSpacing !bridoc = rec bridoc
|
|||
else VerticalSpacingParAlways colMax
|
||||
)
|
||||
False
|
||||
False
|
||||
)
|
||||
BDSetParSpacing bd -> do
|
||||
BDForceAlt SetParSpacing bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs { _vs_parFlag = True }
|
||||
BDForceParSpacing bd -> do
|
||||
BDForceAlt ForceParSpacing bd -> do
|
||||
mVs <- rec bd
|
||||
return
|
||||
$ [ vs
|
||||
|
|
@ -541,12 +578,12 @@ getSpacing !bridoc = rec bridoc
|
|||
++ "): mVs="
|
||||
++ show r
|
||||
return r
|
||||
return result
|
||||
pure result
|
||||
maxVs
|
||||
:: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
|
||||
maxVs = foldl'
|
||||
(liftM2
|
||||
(\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) -> VerticalSpacing
|
||||
(\(VerticalSpacing x1 x2 _ _) (VerticalSpacing y1 y2 _ _) -> VerticalSpacing
|
||||
(max x1 y1)
|
||||
(case (x2, y2) of
|
||||
(x, VerticalSpacingParNone) -> x
|
||||
|
|
@ -561,28 +598,31 @@ getSpacing !bridoc = rec bridoc
|
|||
VerticalSpacingParSome $ max x y
|
||||
)
|
||||
False
|
||||
False
|
||||
)
|
||||
)
|
||||
(LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False)
|
||||
(LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False False)
|
||||
sumVs
|
||||
:: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
|
||||
sumVs sps = foldl' (liftM2 go) initial sps
|
||||
where
|
||||
go (VerticalSpacing x1 x2 x3) (VerticalSpacing y1 y2 _) = VerticalSpacing
|
||||
(x1 + y1)
|
||||
(case (x2, y2) of
|
||||
(x, VerticalSpacingParNone) -> x
|
||||
(VerticalSpacingParNone, x) -> x
|
||||
(VerticalSpacingParAlways i, VerticalSpacingParAlways j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParAlways i, VerticalSpacingParSome j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParSome i, VerticalSpacingParAlways j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParSome x, VerticalSpacingParSome y) ->
|
||||
VerticalSpacingParSome $ x + y
|
||||
)
|
||||
x3
|
||||
go (VerticalSpacing x1 x2 x3 x4) (VerticalSpacing y1 y2 _ y4) =
|
||||
VerticalSpacing
|
||||
(x1 + y1)
|
||||
(case (x2, y2) of
|
||||
(x, VerticalSpacingParNone) -> x
|
||||
(VerticalSpacingParNone, x) -> x
|
||||
(VerticalSpacingParAlways i, VerticalSpacingParAlways j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParAlways i, VerticalSpacingParSome j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParSome i, VerticalSpacingParAlways j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParSome x, VerticalSpacingParSome y) ->
|
||||
VerticalSpacingParSome $ x + y
|
||||
)
|
||||
x3
|
||||
(x4 || y4)
|
||||
singleline (LineModeValid x) = _vs_paragraph x == VerticalSpacingParNone
|
||||
singleline _ = False
|
||||
isPar (LineModeValid x) = _vs_parFlag x
|
||||
|
|
@ -590,9 +630,10 @@ getSpacing !bridoc = rec bridoc
|
|||
parFlag = case sps of
|
||||
[] -> True
|
||||
_ -> all singleline (List.init sps) && isPar (List.last sps)
|
||||
initial = LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone parFlag
|
||||
initial =
|
||||
LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone parFlag False
|
||||
getMaxVS :: LineModeValidity VerticalSpacing -> LineModeValidity Int
|
||||
getMaxVS = fmap $ \(VerticalSpacing x1 x2 _) -> x1 `max` case x2 of
|
||||
getMaxVS = fmap $ \(VerticalSpacing x1 x2 _ _) -> x1 `max` case x2 of
|
||||
VerticalSpacingParSome i -> i
|
||||
VerticalSpacingParNone -> 0
|
||||
VerticalSpacingParAlways i -> i
|
||||
|
|
@ -621,7 +662,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
config <- mAsk
|
||||
let colMax = config & _conf_layout & _lconfig_cols & confUnpack
|
||||
let
|
||||
hasOkColCount (VerticalSpacing lsp psp _) = lsp <= colMax && case psp of
|
||||
hasOkColCount (VerticalSpacing lsp psp _ _) = lsp <= colMax && case psp of
|
||||
VerticalSpacingParNone -> True
|
||||
VerticalSpacingParSome i -> i <= colMax
|
||||
VerticalSpacingParAlways{} -> True
|
||||
|
|
@ -638,6 +679,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
let
|
||||
allowHangingQuasiQuotes =
|
||||
config & _conf_layout & _lconfig_allowHangingQuasiQuotes & confUnpack
|
||||
let indAmount = confUnpack $ _lconfig_indentAmount $ _conf_layout $ config
|
||||
let -- this is like List.nub, with one difference: if two elements
|
||||
-- are unequal only in _vs_paragraph, with both ParAlways, we
|
||||
-- treat them like equals and replace the first occurence with the
|
||||
|
|
@ -690,12 +732,14 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
. preFilterLimit
|
||||
result <- case brdc of
|
||||
-- BDWrapAnnKey _annKey bd -> rec bd
|
||||
BDEmpty -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
|
||||
BDLit t ->
|
||||
return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
|
||||
BDEmpty -> return $ [VerticalSpacing 0 VerticalSpacingParNone False False]
|
||||
BDLit t -> do
|
||||
let l = Text.length t
|
||||
pure $ [VerticalSpacing l VerticalSpacingParNone False False]
|
||||
BDSeq list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
|
||||
BDCols _sig list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
|
||||
BDSeparator -> return $ [VerticalSpacing 1 VerticalSpacingParNone False]
|
||||
BDSeparator ->
|
||||
pure $ [VerticalSpacing 1 VerticalSpacingParNone False False]
|
||||
BDAddBaseY indent bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs
|
||||
|
|
@ -704,18 +748,13 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
VerticalSpacingParAlways i ->
|
||||
VerticalSpacingParAlways $ case indent of
|
||||
BrIndentNone -> i
|
||||
BrIndentRegular ->
|
||||
i
|
||||
+ (confUnpack
|
||||
$ _lconfig_indentAmount
|
||||
$ _conf_layout
|
||||
$ config
|
||||
)
|
||||
BrIndentRegular -> i + indAmount
|
||||
BrIndentRegularForce -> i + indAmount
|
||||
BrIndentSpecial j -> i + j
|
||||
VerticalSpacingParSome i -> VerticalSpacingParSome $ case indent of
|
||||
BrIndentNone -> i
|
||||
BrIndentRegular ->
|
||||
i + (confUnpack $ _lconfig_indentAmount $ _conf_layout $ config)
|
||||
BrIndentRegular -> i + indAmount
|
||||
BrIndentRegularForce -> i + indAmount
|
||||
BrIndentSpecial j -> i + j
|
||||
}
|
||||
BDBaseYPushCur bd -> do
|
||||
|
|
@ -744,7 +783,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
mVss <- filterAndLimit <$> rec sameLine
|
||||
indSps <- filterAndLimit <$> rec indented
|
||||
let mVsIndSp = take limit $ [ (x, y) | x <- mVss, y <- indSps ]
|
||||
return $ mVsIndSp <&> \(VerticalSpacing lsp mPsp _, indSp) ->
|
||||
return $ mVsIndSp <&> \(VerticalSpacing lsp mPsp _ _, indSp) ->
|
||||
VerticalSpacing
|
||||
lsp
|
||||
(case mPsp of
|
||||
|
|
@ -760,6 +799,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
== VerticalSpacingParNone
|
||||
&& _vs_parFlag indSp
|
||||
)
|
||||
False -- TODO92 should we turn this on?
|
||||
|
||||
BDPar{} -> error "BDPar with indent in getSpacing"
|
||||
BDAlt [] -> error "empty BDAlt"
|
||||
|
|
@ -767,31 +807,35 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
BDAlt alts -> do
|
||||
r <- rec `mapM` alts
|
||||
return $ filterAndLimit =<< r
|
||||
BDForceMultiline bd -> do
|
||||
BDForceAlt ForceMultiline bd -> do
|
||||
mVs <- filterAndLimit <$> rec bd
|
||||
return $ filter ((/= VerticalSpacingParNone) . _vs_paragraph) mVs
|
||||
BDForceSingleline bd -> do
|
||||
BDForceAlt ForceSingleline bd -> do
|
||||
mVs <- filterAndLimit <$> rec bd
|
||||
return $ filter ((== VerticalSpacingParNone) . _vs_paragraph) mVs
|
||||
BDForwardLineMode bd -> rec bd
|
||||
BDExternal _ txt | [t] <- Text.lines txt ->
|
||||
return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
|
||||
BDExternal _ txt | [t] <- Text.lines txt -> do
|
||||
let l = Text.length t
|
||||
pure $ [VerticalSpacing l VerticalSpacingParNone False False]
|
||||
BDExternal{} -> return $ [] -- yes, we just assume that we cannot properly layout
|
||||
-- this.
|
||||
BDPlain t -> return
|
||||
[ case Text.lines t of
|
||||
[] -> VerticalSpacing 0 VerticalSpacingParNone False
|
||||
[t1] ->
|
||||
VerticalSpacing (Text.length t1) VerticalSpacingParNone False
|
||||
(t1 : _) ->
|
||||
VerticalSpacing (Text.length t1) (VerticalSpacingParAlways 0) True
|
||||
| allowHangingQuasiQuotes
|
||||
]
|
||||
BDPlain t -> do
|
||||
let tl = Text.length
|
||||
pure
|
||||
[ case Text.lines t of
|
||||
[] -> VerticalSpacing 0 VerticalSpacingParNone False False
|
||||
[t1] ->
|
||||
VerticalSpacing (tl t1) VerticalSpacingParNone False False
|
||||
(t1 : _) ->
|
||||
VerticalSpacing (tl t1) (VerticalSpacingParAlways 0) True False
|
||||
| allowHangingQuasiQuotes
|
||||
]
|
||||
BDQueueComments _comms bd -> rec bd
|
||||
BDFlushCommentsPrior _loc bd -> rec bd
|
||||
BDFlushCommentsPost _loc _shouldMark bd -> rec bd
|
||||
BDEntryDelta _dp bd -> rec bd
|
||||
BDLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
|
||||
BDLines [] ->
|
||||
pure $ [VerticalSpacing 0 VerticalSpacingParNone False False]
|
||||
BDLines ls@(_ : _) -> do
|
||||
-- we simply assume that lines is only used "properly", i.e. in
|
||||
-- such a way that the first line can be treated "as a part of the
|
||||
|
|
@ -802,7 +846,10 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
let
|
||||
worbled = fmap reverse $ sequence $ reverse $ lSpss
|
||||
sumF lSps@(lSp1 : _) =
|
||||
VerticalSpacing (_vs_sameLine lSp1) (spMakePar $ maxVs lSps) False
|
||||
VerticalSpacing (_vs_sameLine lSp1)
|
||||
(spMakePar $ maxVs lSps)
|
||||
False
|
||||
False -- TODO92
|
||||
sumF [] =
|
||||
error
|
||||
$ "should not happen. if my logic does not fail"
|
||||
|
|
@ -824,12 +871,12 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
let
|
||||
addInd = case indent of
|
||||
BrIndentNone -> 0
|
||||
BrIndentRegular ->
|
||||
confUnpack $ _lconfig_indentAmount $ _conf_layout $ config
|
||||
BrIndentRegular -> indAmount
|
||||
BrIndentRegularForce -> indAmount
|
||||
BrIndentSpecial i -> i
|
||||
return $ mVs <&> \(VerticalSpacing lsp psp parFlag) ->
|
||||
VerticalSpacing (lsp + addInd) psp parFlag
|
||||
BDNonBottomSpacing b bd -> do
|
||||
return $ mVs <&> \(VerticalSpacing lsp psp parFlag _) ->
|
||||
VerticalSpacing (lsp + addInd) psp parFlag False
|
||||
BDForceAlt (NonBottomSpacing b) bd -> do
|
||||
-- TODO: the `b` flag is an ugly hack, but I was not able to make
|
||||
-- all tests work without it. It should be possible to have
|
||||
-- `spMakePar` map VSPAlways{} to VSPSome x1, which fixes this
|
||||
|
|
@ -844,6 +891,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
else VerticalSpacingParAlways colMax
|
||||
)
|
||||
False
|
||||
False
|
||||
]
|
||||
else mVs <&> \vs -> vs
|
||||
{ _vs_sameLine = min colMax (_vs_sameLine vs)
|
||||
|
|
@ -884,16 +932,19 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
-- False)
|
||||
-- mVs
|
||||
-- ]
|
||||
BDSetParSpacing bd -> do
|
||||
BDForceAlt SetParSpacing bd -> do
|
||||
mVs <- rec bd
|
||||
return $ mVs <&> \vs -> vs { _vs_parFlag = True }
|
||||
BDForceParSpacing bd -> do
|
||||
BDForceAlt ForceParSpacing bd -> do
|
||||
mVs <- preFilterLimit <$> rec bd
|
||||
return
|
||||
$ [ vs
|
||||
| vs <- mVs
|
||||
, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone
|
||||
]
|
||||
BDForceAlt ForceZeroAdd bd -> do
|
||||
mVs <- preFilterLimit <$> rec bd
|
||||
pure [ vs { _vs_onlyZeroAddInd = True } | vs <- mVs ]
|
||||
BDDebug s bd -> do
|
||||
r <- rec bd
|
||||
tellDebugMess
|
||||
|
|
@ -907,7 +958,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
return result
|
||||
maxVs :: [VerticalSpacing] -> VerticalSpacing
|
||||
maxVs = foldl'
|
||||
(\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) -> VerticalSpacing
|
||||
(\(VerticalSpacing x1 x2 _ _) (VerticalSpacing y1 y2 _ _) -> VerticalSpacing
|
||||
(max x1 y1)
|
||||
(case (x2, y2) of
|
||||
(x, VerticalSpacingParNone) -> x
|
||||
|
|
@ -922,63 +973,73 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
VerticalSpacingParSome $ max x y
|
||||
)
|
||||
False
|
||||
False
|
||||
)
|
||||
(VerticalSpacing 0 VerticalSpacingParNone False)
|
||||
(VerticalSpacing 0 VerticalSpacingParNone False False)
|
||||
sumVs :: [VerticalSpacing] -> VerticalSpacing
|
||||
sumVs sps = foldl' go initial sps
|
||||
where
|
||||
go (VerticalSpacing x1 x2 x3) (VerticalSpacing y1 y2 _) = VerticalSpacing
|
||||
(x1 + y1)
|
||||
(case (x2, y2) of
|
||||
(x, VerticalSpacingParNone) -> x
|
||||
(VerticalSpacingParNone, x) -> x
|
||||
(VerticalSpacingParAlways i, VerticalSpacingParAlways j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParAlways i, VerticalSpacingParSome j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParSome i, VerticalSpacingParAlways j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParSome x, VerticalSpacingParSome y) ->
|
||||
VerticalSpacingParSome $ x + y
|
||||
)
|
||||
x3
|
||||
go (VerticalSpacing x1 x2 x3 x4) (VerticalSpacing y1 y2 _ y4) =
|
||||
VerticalSpacing
|
||||
(x1 + y1)
|
||||
(case (x2, y2) of
|
||||
(x, VerticalSpacingParNone) -> x
|
||||
(VerticalSpacingParNone, x) -> x
|
||||
(VerticalSpacingParAlways i, VerticalSpacingParAlways j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParAlways i, VerticalSpacingParSome j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParSome i, VerticalSpacingParAlways j) ->
|
||||
VerticalSpacingParAlways $ i + j
|
||||
(VerticalSpacingParSome x, VerticalSpacingParSome y) ->
|
||||
VerticalSpacingParSome $ x + y
|
||||
)
|
||||
x3
|
||||
(x4 || y4)
|
||||
singleline x = _vs_paragraph x == VerticalSpacingParNone
|
||||
isPar x = _vs_parFlag x
|
||||
parFlag = case sps of
|
||||
[] -> True
|
||||
_ -> all singleline (List.init sps) && isPar (List.last sps)
|
||||
initial = VerticalSpacing 0 VerticalSpacingParNone parFlag
|
||||
initial = VerticalSpacing 0 VerticalSpacingParNone parFlag False
|
||||
getMaxVS :: VerticalSpacing -> Int
|
||||
getMaxVS (VerticalSpacing x1 x2 _) = x1 `max` case x2 of
|
||||
getMaxVS (VerticalSpacing x1 x2 _ _) = x1 `max` case x2 of
|
||||
VerticalSpacingParSome i -> i
|
||||
VerticalSpacingParNone -> 0
|
||||
VerticalSpacingParAlways i -> i
|
||||
spMakePar :: VerticalSpacing -> VerticalSpacingPar
|
||||
spMakePar (VerticalSpacing x1 x2 _) = case x2 of
|
||||
spMakePar (VerticalSpacing x1 x2 _ _) = case x2 of
|
||||
VerticalSpacingParSome i -> VerticalSpacingParSome $ x1 `max` i
|
||||
VerticalSpacingParNone -> VerticalSpacingParSome $ x1
|
||||
VerticalSpacingParAlways i -> VerticalSpacingParAlways $ x1 `max` i
|
||||
|
||||
fixIndentationForMultiple
|
||||
:: (MonadMultiReader (CConfig Identity) m) => AltCurPos -> BrIndent -> m Int
|
||||
:: (MonadMultiReader (CConfig Identity) m)
|
||||
=> AltCurPos
|
||||
-> BrIndent
|
||||
-> m (Int, Bool)
|
||||
fixIndentationForMultiple acp indent = do
|
||||
indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
|
||||
let
|
||||
indAddRaw = case indent of
|
||||
BrIndentNone -> 0
|
||||
BrIndentRegular -> indAmount
|
||||
BrIndentSpecial i -> i
|
||||
(indAddRaw, strongFlag) = case indent of
|
||||
BrIndentNone -> (0, False)
|
||||
BrIndentRegular -> (indAmount, False)
|
||||
BrIndentRegularForce -> (indAmount, True)
|
||||
BrIndentSpecial i -> (i, False)
|
||||
-- for IndentPolicyMultiple, we restrict the amount of added
|
||||
-- indentation in such a manner that we end up on a multiple of the
|
||||
-- base indentation.
|
||||
indPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
|
||||
pure $ if indPolicy == IndentPolicyMultiple
|
||||
then
|
||||
let
|
||||
indAddMultiple1 =
|
||||
indAddRaw - ((_acp_indent acp + indAddRaw) `mod` indAmount)
|
||||
indAddMultiple2 = if indAddMultiple1 <= 0
|
||||
then indAddMultiple1 + indAmount
|
||||
else indAddMultiple1
|
||||
in indAddMultiple2
|
||||
else indAddRaw
|
||||
pure
|
||||
$ ( if indPolicy == IndentPolicyMultiple
|
||||
then
|
||||
let
|
||||
indAddMultiple1 =
|
||||
indAddRaw - ((_acp_indent acp + indAddRaw) `mod` indAmount)
|
||||
indAddMultiple2 = if indAddMultiple1 <= 0
|
||||
then indAddMultiple1 + indAmount
|
||||
else indAddMultiple1
|
||||
in indAddMultiple2
|
||||
else indAddRaw
|
||||
, strongFlag
|
||||
)
|
||||
|
|
|
|||
|
|
@ -5,8 +5,11 @@ module Language.Haskell.Brittany.Internal.Transformations.T2_Floating where
|
|||
|
||||
import qualified Data.Generics.Uniplate.Direct as Uniplate
|
||||
import qualified GHC.OldList as List
|
||||
import Language.Haskell.Brittany.Internal.Prelude
|
||||
import Language.Haskell.Brittany.Internal.Components.BriDoc
|
||||
import GHC ( GenLocated(L) )
|
||||
|
||||
import Language.Haskell.Brittany.Internal.Components.BriDoc
|
||||
import Language.Haskell.Brittany.Internal.Prelude
|
||||
import Language.Haskell.Brittany.Internal.Utils
|
||||
|
||||
|
||||
|
||||
|
|
@ -83,7 +86,7 @@ transformSimplifyFloating = stepBO .> stepFull
|
|||
descendQueueComments = transformDownMay $ \case
|
||||
-- queue comments floating in
|
||||
BDQueueComments comms1 (BDQueueComments comms2 x) ->
|
||||
Just $ BDQueueComments (comms1 ++ comms2) x
|
||||
Just $ BDQueueComments (mergeOn (\(L l _) -> l) comms1 comms2) x
|
||||
BDQueueComments comms1 (BDPar ind line indented) ->
|
||||
Just $ BDPar ind (BDQueueComments comms1 line) indented
|
||||
BDQueueComments comms1 (BDSeq (l : lr)) ->
|
||||
|
|
@ -131,11 +134,11 @@ transformSimplifyFloating = stepBO .> stepFull
|
|||
descendAddB = transformDownMay $ \case
|
||||
BDAddBaseY BrIndentNone x -> Just x
|
||||
-- AddIndent floats into Lines.
|
||||
BDAddBaseY indent (BDLines lines) ->
|
||||
Just $ BDLines $ BDAddBaseY indent <$> lines
|
||||
BDAddBaseY _ind (BDLines lines) ->
|
||||
Just $ BDLines $ lines
|
||||
-- AddIndent floats into last column
|
||||
BDAddBaseY indent (BDCols sig cols) ->
|
||||
Just $ BDCols sig $ List.init cols ++ [BDAddBaseY indent $ List.last cols]
|
||||
BDAddBaseY ind (BDCols sig cols) ->
|
||||
Just $ BDCols sig $ List.init cols ++ [BDAddBaseY ind $ List.last cols]
|
||||
-- merge AddIndent and Par
|
||||
BDAddBaseY ind1 (BDPar ind2 line indented) ->
|
||||
Just $ BDPar (mergeIndents ind1 ind2) line indented
|
||||
|
|
@ -148,8 +151,8 @@ transformSimplifyFloating = stepBO .> stepFull
|
|||
BDAddBaseY ind (BDSeq list) ->
|
||||
Just $ BDSeq $ List.init list ++ [BDAddBaseY ind (List.last list)]
|
||||
BDAddBaseY _ lit@BDLit{} -> Just $ lit
|
||||
BDAddBaseY ind (BDBaseYPushCur x) ->
|
||||
Just $ BDBaseYPushCur (BDAddBaseY ind x)
|
||||
BDAddBaseY _ind (BDBaseYPushCur x) ->
|
||||
Just $ BDBaseYPushCur x
|
||||
-- TODO92 We have several rules here in conflict with each other.
|
||||
-- Unless I forget some detail related to some elements being able
|
||||
-- to float in further, we probably should define some
|
||||
|
|
@ -193,19 +196,19 @@ transformSimplifyFloating = stepBO .> stepFull
|
|||
-- copying them here (incompletely).
|
||||
BDAddBaseY BrIndentNone x -> Just $ x
|
||||
-- AddIndent floats into Lines.
|
||||
BDAddBaseY indent (BDLines lines) ->
|
||||
Just $ BDLines $ BDAddBaseY indent <$> lines
|
||||
BDAddBaseY _ind (BDLines lines) ->
|
||||
Just $ BDLines lines
|
||||
-- AddIndent floats into last column
|
||||
BDAddBaseY indent (BDCols sig cols) ->
|
||||
Just $ BDCols sig $ List.init cols ++ [BDAddBaseY indent $ List.last cols]
|
||||
BDAddBaseY ind (BDCols sig cols) ->
|
||||
Just $ BDCols sig $ List.init cols ++ [BDAddBaseY ind $ List.last cols]
|
||||
BDAddBaseY ind (BDSeq list) ->
|
||||
Just $ BDSeq $ List.init list ++ [BDAddBaseY ind (List.last list)]
|
||||
-- merge AddIndent and Par
|
||||
BDAddBaseY ind1 (BDPar ind2 line indented) ->
|
||||
Just $ BDPar (mergeIndents ind1 ind2) line indented
|
||||
BDAddBaseY _ lit@BDLit{} -> Just $ lit
|
||||
BDAddBaseY ind (BDBaseYPushCur x) ->
|
||||
Just $ BDBaseYPushCur (BDAddBaseY ind x)
|
||||
BDAddBaseY _ind (BDBaseYPushCur x) ->
|
||||
Just $ BDBaseYPushCur x
|
||||
-- EnsureIndent float-in
|
||||
-- BDEnsureIndent indent (BDCols sig (col:colr)) ->
|
||||
-- Just $ BDCols sig (BDEnsureIndent indent col : (BDAddBaseY indent <$> colr))
|
||||
|
|
|
|||
|
|
@ -129,8 +129,7 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
|
|||
BDIndentLevelPop{} -> Nothing
|
||||
BDPar{} -> Nothing
|
||||
BDAlt{} -> Nothing
|
||||
BDForceMultiline{} -> Nothing
|
||||
BDForceSingleline{} -> Nothing
|
||||
BDForceAlt{} -> Nothing
|
||||
BDForwardLineMode{} -> Nothing
|
||||
BDExternal{} -> Nothing
|
||||
BDPlain{} -> Nothing
|
||||
|
|
@ -140,7 +139,4 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
|
|||
BDFlushCommentsPost{} -> Nothing
|
||||
BDEntryDelta{} -> Nothing
|
||||
BDEnsureIndent{} -> Nothing
|
||||
BDSetParSpacing{} -> Nothing
|
||||
BDForceParSpacing{} -> Nothing
|
||||
BDDebug{} -> Nothing
|
||||
BDNonBottomSpacing _ x -> Just x
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@ import qualified GHC.Types.Name.Reader as RdrName (rdrNameOcc)
|
|||
import qualified GHC.Types.SrcLoc as GHC
|
||||
import qualified GHC.Utils.Outputable as GHC
|
||||
import qualified GHC.Parser.Annotation as GHC
|
||||
import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint.Utils
|
||||
-- import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint.Utils
|
||||
import qualified Text.PrettyPrint as PP
|
||||
import qualified Data.Semigroup as Semigroup
|
||||
import qualified System.IO.Unsafe as Unsafe
|
||||
|
|
@ -108,7 +108,6 @@ customLayouterNoSrcSpansF layoutF =
|
|||
`extQ` internalLayouterSrcSpan
|
||||
`extQ` internalLayouterRdrName
|
||||
`extQ` realSrcSpan
|
||||
`extQ` deltaComment
|
||||
`extQ` anchored
|
||||
`ext1Q` srcSpanAnn
|
||||
-- `ext2Q` located
|
||||
|
|
@ -122,9 +121,9 @@ customLayouterNoSrcSpansF layoutF =
|
|||
anchored (GHC.Anchor _ op) = f op
|
||||
srcSpanAnn :: forall a . Data a => GHC.SrcSpanAnn' a -> NodeLayouter
|
||||
srcSpanAnn (GHC.SrcSpanAnn ann _loc) = f ann
|
||||
deltaComment :: GHC.LEpaComment -> NodeLayouter
|
||||
deltaComment (GHC.L anchor (GHC.EpaComment token prior)) =
|
||||
f (GHC.L (ExactPrint.Utils.ss2deltaEnd prior (GHC.anchor anchor)) token)
|
||||
-- deltaComment :: GHC.LEpaComment -> NodeLayouter
|
||||
-- deltaComment (GHC.L anchor (GHC.EpaComment token prior)) =
|
||||
-- f (GHC.L (ExactPrint.Utils.ss2deltaEnd prior (GHC.anchor anchor)) token)
|
||||
-- located :: (Data b, Data loc) => GHC.GenLocated loc b -> NodeLayouter
|
||||
-- located (GHC.L ss a) = runDataToLayouter layoutF $ A annStr a
|
||||
-- where
|
||||
|
|
@ -143,11 +142,34 @@ customLayouterNoAnnsF layoutF =
|
|||
`extQ` internalLayouterOccName
|
||||
`extQ` internalLayouterSrcSpan
|
||||
`extQ` internalLayouterRdrName
|
||||
`extQ` realSrcSpan
|
||||
`extQ` realSrcLoc
|
||||
`ext2Q` located
|
||||
`extQ` lepaComment
|
||||
where
|
||||
DataToLayouter f = defaultLayouterF layoutF
|
||||
located :: (Data b) => GHC.GenLocated loc b -> NodeLayouter
|
||||
located (GHC.L _ss a) = runDataToLayouter layoutF a
|
||||
lepaComment :: GHC.LEpaComment -> NodeLayouter
|
||||
lepaComment (GHC.L anchor (GHC.EpaComment token _)) = f
|
||||
( token
|
||||
, GHC.srcSpanStartLine (GHC.anchor anchor)
|
||||
, GHC.srcSpanStartCol (GHC.anchor anchor)
|
||||
, GHC.srcSpanEndLine (GHC.anchor anchor)
|
||||
, GHC.srcSpanEndCol (GHC.anchor anchor)
|
||||
)
|
||||
realSrcSpan :: GHC.RealSrcSpan -> NodeLayouter
|
||||
realSrcSpan span = internalLayouterSimple
|
||||
(show
|
||||
( GHC.srcSpanStartLine span
|
||||
, GHC.srcSpanStartCol span
|
||||
, GHC.srcSpanEndLine span
|
||||
, GHC.srcSpanEndCol span
|
||||
)
|
||||
)
|
||||
realSrcLoc :: GHC.RealSrcLoc -> NodeLayouter
|
||||
realSrcLoc loc =
|
||||
internalLayouterSimple (show (GHC.srcLocLine loc, GHC.srcLocCol loc))
|
||||
|
||||
internalLayouterSimple :: String -> NodeLayouter
|
||||
internalLayouterSimple s = NodeLayouter (length s) False (const $ PP.text s)
|
||||
|
|
@ -248,9 +270,9 @@ briDocToDoc :: BriDoc -> PP.Doc
|
|||
briDocToDoc = astToDoc . removeAnnotations
|
||||
where
|
||||
removeAnnotations = Uniplate.transform $ \case
|
||||
BDFlushCommentsPrior _ x -> x
|
||||
BDFlushCommentsPost _ _ x -> x
|
||||
BDQueueComments _ x -> x
|
||||
-- BDFlushCommentsPrior _ x -> x
|
||||
-- BDFlushCommentsPost _ _ x -> x
|
||||
-- BDQueueComments _ x -> x
|
||||
x -> x
|
||||
|
||||
briDocToDocWithAnns :: BriDoc -> PP.Doc
|
||||
|
|
@ -305,3 +327,11 @@ traceIfDumpConf s accessor val = do
|
|||
Unsafe.unsafePerformIO $ do
|
||||
f ("---- " ++ s ++ " ----\n" ++ show val)
|
||||
pure $ pure ()
|
||||
|
||||
mergeOn :: Ord b => (a -> b) -> [a] -> [a] -> [a]
|
||||
mergeOn _f xs [] = xs
|
||||
mergeOn _f [] ys = ys
|
||||
mergeOn f xs@(x:xr) ys@(y:yr)
|
||||
| f x <= f y = x : mergeOn f xr ys
|
||||
| otherwise = y : mergeOn f xs yr
|
||||
|
||||
|
|
|
|||
|
|
@ -402,8 +402,7 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
|
|||
BDIndentLevelPop bd -> rec bd
|
||||
BDPar _ line _ -> rec line
|
||||
BDAlt{} -> error "briDocLineLength BDAlt"
|
||||
BDForceMultiline bd -> rec bd
|
||||
BDForceSingleline bd -> rec bd
|
||||
BDForceAlt _ bd -> rec bd
|
||||
BDForwardLineMode bd -> rec bd
|
||||
BDExternal _ t -> return $ Text.length t
|
||||
BDPlain t -> return $ Text.length t
|
||||
|
|
@ -416,9 +415,6 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
|
|||
BDEntryDelta _dp bd -> rec bd
|
||||
BDLines [] -> error "briDocLineLength BDLines []"
|
||||
BDEnsureIndent _ bd -> rec bd
|
||||
BDSetParSpacing bd -> rec bd
|
||||
BDForceParSpacing bd -> rec bd
|
||||
BDNonBottomSpacing _ bd -> rec bd
|
||||
BDDebug _ bd -> rec bd
|
||||
|
||||
briDocIsMultiLine :: BriDoc -> Bool
|
||||
|
|
@ -437,8 +433,7 @@ briDocIsMultiLine briDoc = rec briDoc
|
|||
BDIndentLevelPop bd -> rec bd
|
||||
BDPar{} -> True
|
||||
BDAlt{} -> error "briDocIsMultiLine BDAlt"
|
||||
BDForceMultiline _ -> True
|
||||
BDForceSingleline bd -> rec bd
|
||||
BDForceAlt _ bd -> rec bd
|
||||
BDForwardLineMode bd -> rec bd
|
||||
BDExternal _ t | [_] <- Text.lines t -> False
|
||||
BDExternal{} -> True
|
||||
|
|
@ -452,9 +447,6 @@ briDocIsMultiLine briDoc = rec briDoc
|
|||
BDLines [_] -> False
|
||||
BDLines [] -> error "briDocIsMultiLine BDLines []"
|
||||
BDEnsureIndent _ bd -> rec bd
|
||||
BDSetParSpacing bd -> rec bd
|
||||
BDForceParSpacing bd -> rec bd
|
||||
BDNonBottomSpacing _ bd -> rec bd
|
||||
BDDebug _ bd -> rec bd
|
||||
|
||||
briDocToColInfo :: Bool -> BriDoc -> StateS.State ColBuildState ColInfo
|
||||
|
|
|
|||
|
|
@ -285,7 +285,7 @@ layoutBaseYPushCur = do
|
|||
, _lstate_plannedSpace state
|
||||
)
|
||||
layoutBaseYPushInternal $ case _lstate_plannedSpace state of
|
||||
PlannedNone -> _lstate_curY state
|
||||
PlannedNone -> _lstate_curY state
|
||||
PlannedSameline i -> _lstate_curY state + i
|
||||
PlannedNewline _l -> lstate_baseY state
|
||||
PlannedDelta _l i -> i
|
||||
|
|
|
|||
|
|
@ -5,12 +5,12 @@
|
|||
import Data.Coerce (coerce)
|
||||
import Data.List (groupBy)
|
||||
import qualified Data.Maybe
|
||||
import qualified Data.Semigroup as Semigroup
|
||||
-- import qualified Data.Semigroup as Semigroup
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.IO as Text.IO
|
||||
import qualified GHC.OldList as List
|
||||
-- import qualified GHC.OldList as List
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.These
|
||||
-- import Data.These
|
||||
import Language.Haskell.Brittany.Internal
|
||||
import Language.Haskell.Brittany.Internal.Config.Config
|
||||
import Language.Haskell.Brittany.Internal.Config.Types
|
||||
|
|
@ -21,6 +21,7 @@ import System.Timeout (timeout)
|
|||
import Test.Hspec
|
||||
import qualified Text.Parsec as Parsec
|
||||
import Text.Parsec.Text (Parser)
|
||||
import qualified Data.List.Extra
|
||||
|
||||
hush :: Either a b -> Maybe b
|
||||
hush = either (const Nothing) Just
|
||||
|
|
@ -61,7 +62,9 @@ roundTripEqualWithTimeout time t =
|
|||
data InputLine
|
||||
= GroupLine Text
|
||||
| HeaderLine Text
|
||||
| HeaderLineGolden Text
|
||||
| PendingLine
|
||||
| HeaderLineGoldenOutput
|
||||
| NormalLine Text
|
||||
| CommentLine
|
||||
deriving Show
|
||||
|
|
@ -70,6 +73,7 @@ data TestCase = TestCase
|
|||
{ testName :: Text
|
||||
, isPending :: Bool
|
||||
, content :: Text
|
||||
, expectedOutput :: Maybe Text -- Nothing if input is expected not to change
|
||||
}
|
||||
|
||||
main :: IO ()
|
||||
|
|
@ -146,8 +150,9 @@ main = do
|
|||
(tests `forM_` \test -> do
|
||||
(if isPending test then before_ pending else id)
|
||||
$ it (Text.unpack $ testName test)
|
||||
$ roundTripEqual conf
|
||||
$ content test
|
||||
$ case expectedOutput test of
|
||||
Nothing -> roundTripEqual conf (content test)
|
||||
Just expctd -> goldenTest conf (content test) expctd
|
||||
)
|
||||
ks
|
||||
)
|
||||
|
|
@ -187,13 +192,30 @@ main = do
|
|||
{ testName = n
|
||||
, isPending = any isPendingLine rest
|
||||
, content = Text.unlines normalLines
|
||||
, expectedOutput = Nothing
|
||||
}
|
||||
HeaderLineGolden n : rest ->
|
||||
case Data.List.Extra.wordsBy isGoldenOutputLine rest of
|
||||
[inputLines, outputLines] ->
|
||||
let
|
||||
inputs = Data.Maybe.mapMaybe extractNormal inputLines
|
||||
outputs = Data.Maybe.mapMaybe extractNormal outputLines
|
||||
in TestCase
|
||||
{ testName = n
|
||||
, isPending = any isPendingLine rest
|
||||
, content = Text.unlines inputs
|
||||
, expectedOutput = Just (Text.unlines outputs)
|
||||
}
|
||||
_ -> error $ "malformed golden test at " ++ show n
|
||||
l ->
|
||||
error $ "first non-empty line must start with #test footest\n" ++ show l
|
||||
extractNormal (NormalLine l) = Just l
|
||||
extractNormal _ = Nothing
|
||||
isPendingLine PendingLine{} = True
|
||||
isPendingLine _ = False
|
||||
isGoldenOutputLine = \case
|
||||
HeaderLineGoldenOutput -> True
|
||||
_ -> False
|
||||
specialLineParser :: Parser InputLine
|
||||
specialLineParser = Parsec.choice
|
||||
[ [ GroupLine $ Text.pack name
|
||||
|
|
@ -208,11 +230,21 @@ main = do
|
|||
, name <- Parsec.many1 $ Parsec.noneOf "\r\n:"
|
||||
, _ <- Parsec.eof
|
||||
]
|
||||
, [ HeaderLineGolden $ Text.pack name
|
||||
| _ <- Parsec.try $ Parsec.string "#golden"
|
||||
, _ <- Parsec.many1 $ Parsec.oneOf " \t"
|
||||
, name <- Parsec.many1 $ Parsec.noneOf "\r\n:"
|
||||
, _ <- Parsec.eof
|
||||
]
|
||||
, [ PendingLine
|
||||
| _ <- Parsec.try $ Parsec.string "#pending"
|
||||
, _ <- Parsec.optional $ many (Parsec.noneOf "\r\n")
|
||||
, _ <- Parsec.eof
|
||||
]
|
||||
, [ HeaderLineGoldenOutput
|
||||
| _ <- Parsec.try $ Parsec.string "#expected"
|
||||
, _ <- Parsec.eof
|
||||
]
|
||||
, [ CommentLine
|
||||
| _ <- Parsec.many $ Parsec.oneOf " \t"
|
||||
, _ <- Parsec.optional $ Parsec.string "##" <* many
|
||||
|
|
@ -235,8 +267,9 @@ main = do
|
|||
grouperG _ GroupLine{} = False
|
||||
grouperG _ _ = True
|
||||
grouperT :: InputLine -> InputLine -> Bool
|
||||
grouperT _ HeaderLine{} = False
|
||||
grouperT _ _ = True
|
||||
grouperT _ HeaderLine{} = False
|
||||
grouperT _ HeaderLineGolden{} = False
|
||||
grouperT _ _ = True
|
||||
|
||||
|
||||
--------------------
|
||||
|
|
@ -247,6 +280,11 @@ roundTripEqual c t =
|
|||
fmap (fmap PPTextWrapper) (parsePrintModuleTests c "TestFakeFileName.hs" t)
|
||||
`shouldReturn` Right (PPTextWrapper t)
|
||||
|
||||
goldenTest :: Config -> Text -> Text -> Expectation
|
||||
goldenTest c input expected =
|
||||
fmap (fmap PPTextWrapper) (parsePrintModuleTests c "TestFakeFileName.hs" input)
|
||||
`shouldReturn` Right (PPTextWrapper expected)
|
||||
|
||||
newtype PPTextWrapper = PPTextWrapper Text
|
||||
deriving Eq
|
||||
|
||||
|
|
@ -260,23 +298,28 @@ defaultTestConfig = Config
|
|||
{ _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)
|
||||
, _lconfig_indentWhereSpecial = coerce True
|
||||
, _lconfig_indentListSpecial = coerce True
|
||||
, _lconfig_importColumn = coerce (60 :: Int)
|
||||
, _lconfig_importAsColumn = coerce (60 :: Int)
|
||||
, _lconfig_altChooser = coerce $ AltChooserBoundedSearch 3
|
||||
, _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7)
|
||||
, _lconfig_alignmentLimit = coerce (30 :: Int)
|
||||
, _lconfig_alignmentBreakOnMultiline = coerce True
|
||||
, _lconfig_hangingTypeSignature = coerce False
|
||||
, _lconfig_reformatModulePreamble = coerce True
|
||||
, _lconfig_allowSingleLineExportList = coerce True
|
||||
, _lconfig_allowHangingQuasiQuotes = coerce True
|
||||
, _lconfig_experimentalSemicolonNewlines = coerce False
|
||||
{ _lconfig_cols = coerce (80 :: Int)
|
||||
, _lconfig_indentPolicy = coerce IndentPolicyFree
|
||||
, _lconfig_indentAmount = coerce (2 :: Int)
|
||||
, _lconfig_indentWhereSpecial = coerce True
|
||||
, _lconfig_indentListSpecial = coerce True
|
||||
, _lconfig_importColumn = coerce (60 :: Int)
|
||||
, _lconfig_importAsColumn = coerce (60 :: Int)
|
||||
, _lconfig_altChooser = coerce $ AltChooserBoundedSearch 3
|
||||
, _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7)
|
||||
, _lconfig_alignmentLimit = coerce (30 :: Int)
|
||||
, _lconfig_alignmentBreakOnMultiline = coerce True
|
||||
, _lconfig_hangingTypeSignature = coerce False
|
||||
, _lconfig_reformatModulePreamble = coerce True
|
||||
, _lconfig_allowSingleLineExportList = coerce True
|
||||
, _lconfig_allowHangingQuasiQuotes = coerce True
|
||||
, _lconfig_experimentalSemicolonNewlines = coerce False
|
||||
-- , _lconfig_allowSinglelineRecord = coerce False
|
||||
, _lconfig_fixityAwareOps = coerce True
|
||||
, _lconfig_fixityAwareTypeOps = coerce True
|
||||
, _lconfig_fixityBasedAddAlignParens = coerce False
|
||||
, _lconfig_operatorParenthesisRefactorMode = coerce PRMKeep
|
||||
, _lconfig_operatorAllowUnqualify = coerce True
|
||||
}
|
||||
, _conf_errorHandling = (_conf_errorHandling staticDefaultConfig) { _econf_omit_output_valid_check = coerce True }
|
||||
, _conf_preprocessor = _conf_preprocessor staticDefaultConfig
|
||||
|
|
|
|||
Loading…
Reference in New Issue