diff --git a/src/Language/Haskell/Brittany/Internal/Backend.hs b/src/Language/Haskell/Brittany/Internal/Backend.hs index 6652443..1061f0e 100644 --- a/src/Language/Haskell/Brittany/Internal/Backend.hs +++ b/src/Language/Haskell/Brittany/Internal/Backend.hs @@ -172,11 +172,13 @@ layoutBriDocM = \case priors `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> do - -- evil hack for CPP: case comment of ('#':_) -> layoutMoveToCommentPos y (-999) + -- ^ evil hack for CPP "(" -> pure () - ")" -> layoutMoveToCommentPosX (x - 1) + ")" -> pure () + -- ^ these two fix the formatting of parens + -- on the lhs of type alias defs _ -> layoutMoveToCommentPos y x -- fixedX <- fixMoveToLineByIsNewline x -- replicateM_ fixedX layoutWriteNewline @@ -245,10 +247,12 @@ layoutBriDocM = \case Just comments -> do comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> do - -- evil hack for CPP: case comment of ('#':_) -> layoutMoveToCommentPos y (-999) - ")" -> layoutMoveToCommentPosX (x - 1) + -- ^ evil hack for CPP + ")" -> pure () + -- ^ fixes the formatting of parens + -- on the lhs of type alias defs _ -> layoutMoveToCommentPos y x -- fixedX <- fixMoveToLineByIsNewline x -- replicateM_ fixedX layoutWriteNewline diff --git a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs index 56b95bb..0a2792c 100644 --- a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs @@ -26,7 +26,6 @@ module Language.Haskell.Brittany.Internal.BackendUtils , layoutAddSepSpace , layoutSetCommentCol , layoutMoveToCommentPos - , layoutMoveToCommentPosX , layoutIndentRestorePostComment , moveToExactAnn , ppmMoveToExactLoc @@ -189,30 +188,20 @@ layoutMoveToCommentPos y x = do { _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of Left i -> if y == 0 then Left i else Right y Right{} -> Right y - , _lstate_addSepSpace = if Data.Maybe.isJust (_lstate_commentCol state) - then Just $ case _lstate_curYOrAddNewline state of - Left{} -> if y == 0 then x else _lstate_indLevelLinger state + x - Right{} -> _lstate_indLevelLinger state + x - else Just $ if y == 0 then x else _lstate_indLevelLinger state + x - , _lstate_commentCol = Just $ case _lstate_commentCol state of - Just existing -> existing - Nothing -> case _lstate_curYOrAddNewline state of - Left i -> i + fromMaybe 0 (_lstate_addSepSpace state) - Right{} -> lstate_baseY state + , _lstate_addSepSpace = + Just $ if Data.Maybe.isJust (_lstate_commentCol state) + then case _lstate_curYOrAddNewline state of + Left{} -> if y == 0 then x else _lstate_indLevelLinger state + x + Right{} -> _lstate_indLevelLinger state + x + else if y == 0 then x else _lstate_indLevelLinger state + x + , _lstate_commentCol = + Just $ case _lstate_commentCol state of + Just existing -> existing + Nothing -> case _lstate_curYOrAddNewline state of + Left i -> i + fromMaybe 0 (_lstate_addSepSpace state) + Right{} -> lstate_baseY state } -layoutMoveToCommentPosX - :: ( MonadMultiWriter Text.Builder.Builder m - , MonadMultiState LayoutState m - , MonadMultiWriter (Seq String) m - ) - => Int - -> m () -layoutMoveToCommentPosX x = do - traceLocal ("layoutMoveToCommentPosX", x) - state <- mGet - mSet state { _lstate_addSepSpace = Just $ _lstate_indLevelLinger state + x } - -- | does _not_ add spaces to again reach the current base column. layoutWriteNewline :: ( MonadMultiWriter Text.Builder.Builder m diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index 7f37282..cf7da4f 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -659,46 +659,45 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do -- This isn't quite right, but does give syntactically valid results let needsParens = not $ null rest || hasOwnParens docSeq - $ [ appSep $ docLit $ Text.pack "type" - , appSep - . docSeq - $ [ docParenL | needsParens ] - ++ [ appSep $ layoutTyVarBndr a - , appSep $ docLit nameStr - , layoutTyVarBndr b - ] - ++ [ docParenR | needsParens ] + $ [ docLit $ Text.pack "type" + , docSeparator ] - ++ fmap (appSep . layoutTyVarBndr) rest + ++ [ docParenL | needsParens ] + ++ [ layoutTyVarBndr False a + , docSeparator + , docLit nameStr + , docSeparator + , layoutTyVarBndr False b + ] + ++ [ docParenR | needsParens ] + ++ fmap (layoutTyVarBndr True) rest else docSeq - $ [ appSep $ docLit $ Text.pack "type" - , appSep $ docWrapNode name $ docLit nameStr + $ [ docLit $ Text.pack "type" + , docSeparator + , docWrapNode name $ docLit nameStr ] - ++ fmap (appSep . layoutTyVarBndr) vars + ++ fmap (layoutTyVarBndr True) vars + sharedLhs <- docSharedWrapper id lhs typeDoc <- docSharedWrapper layoutType typ hasComments <- hasAnyCommentsConnected typ - docAlt - $ [ docSeq - [lhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc] - | not hasComments - ] - ++ [ docAddBaseY BrIndentRegular $ docPar - lhs - (docCols ColTyOpPrefix [appSep $ docLit $ Text.pack "=", typeDoc]) - ] + runFilteredAlternative $ do + addAlternativeCond (not hasComments) $ docSeq + [sharedLhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc] + addAlternative $ docAddBaseY BrIndentRegular $ docPar + sharedLhs + (docCols ColTyOpPrefix [appSep $ docLit $ Text.pack "=", typeDoc]) -layoutTyVarBndr :: ToBriDoc HsTyVarBndr -layoutTyVarBndr lbndr@(L _ bndr) = do - needsPriorSpace <- hasAnnKeywordComment lbndr AnnCloseP +layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr +layoutTyVarBndr needsSep lbndr@(L _ bndr) = do docWrapNodePrior lbndr $ case bndr of UserTyVar name -> do nameStr <- lrdrNameToTextAnn name - docSeq $ [ docSeparator | needsPriorSpace ] ++ [docLit nameStr] + docSeq $ [docSeparator | needsSep] ++ [docLit nameStr] KindedTyVar name kind -> do nameStr <- lrdrNameToTextAnn name docSeq - $ [ docSeparator | needsPriorSpace ] + $ [ docSeparator | needsSep ] ++ [ docLit $ Text.pack "(" , appSep $ docLit nameStr , appSep . docLit $ Text.pack "::"