diff --git a/src/Language/Haskell/Brittany/BriLayouter.hs b/src/Language/Haskell/Brittany/BriLayouter.hs index 5b9f58d..72b38e7 100644 --- a/src/Language/Haskell/Brittany/BriLayouter.hs +++ b/src/Language/Haskell/Brittany/BriLayouter.hs @@ -101,12 +101,12 @@ layoutBriDoc ast briDoc = do let filteredAnns = filterAnns ast anns let state = LayoutState - { _lstate_baseY = 0 + { _lstate_baseYs = [0] , _lstate_curYOrAddNewline = Right 0 -- important that we use left here -- because moveToAnn stuff of the -- first node needs to do its -- thing properly. - , _lstate_indLevel = 0 + , _lstate_indLevels = [0] , _lstate_indLevelLinger = 0 , _lstate_commentsPrior = extractCommentsPrior filteredAnns , _lstate_commentsPost = extractCommentsPost filteredAnns @@ -250,15 +250,21 @@ transformAlts briDoc BrIndentNone -> r BrIndentRegular -> reWrap $ BDFAddBaseY (BrIndentSpecial indAdd) r BrIndentSpecial i -> reWrap $ BDFAddBaseY (BrIndentSpecial i) r - BDFSetBaseY bd -> do + BDFBaseYPushCur bd -> do acp <- mGet mSet $ acp { _acp_indent = _acp_line acp } r <- rec bd + return $ reWrap $ BDFBaseYPushCur r + BDFBaseYPop bd -> do + acp <- mGet + r <- rec bd acp' <- mGet - mSet $ acp' { _acp_indent = _acp_indent acp } - return $ reWrap $ BDFSetBaseY r - BDFSetIndentLevel bd -> do - reWrap . BDFSetIndentLevel <$> rec bd + mSet $ acp' { _acp_indent = _acp_indentPrep acp } + return $ reWrap $ BDFBaseYPop r + BDFIndentLevelPushCur bd -> do + reWrap . BDFIndentLevelPushCur <$> rec bd + BDFIndentLevelPop bd -> do + reWrap . BDFIndentLevelPop <$> rec bd BDFPar indent sameLine indented -> do indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> runIdentity let indAdd = case indent of @@ -459,7 +465,7 @@ getSpacing !bridoc = rec bridoc ) BrIndentSpecial j -> i + j } - BDFSetBaseY bd -> do + BDFBaseYPushCur bd -> do mVs <- rec bd return $ mVs <&> \vs -> vs -- We leave par as-is, even though it technically is not @@ -474,7 +480,9 @@ getSpacing !bridoc = rec bridoc VerticalSpacingParNonBottom -> 999) , _vs_paragraph = VerticalSpacingParNonBottom } - BDFSetIndentLevel bd -> rec bd + BDFBaseYPop bd -> rec bd + BDFIndentLevelPushCur bd -> rec bd + BDFIndentLevelPop bd -> rec bd BDFPar BrIndentNone sameLine indented -> do mVs <- rec sameLine indSp <- rec indented @@ -600,7 +608,7 @@ getSpacings limit bridoc = rec bridoc ) BrIndentSpecial j -> i + j } - BDFSetBaseY bd -> do + BDFBaseYPushCur bd -> do mVs <- rec bd return $ mVs <&> \vs -> vs -- We leave par as-is, even though it technically is not @@ -617,7 +625,9 @@ getSpacings limit bridoc = rec bridoc VerticalSpacingParNone -> VerticalSpacingParNone _ -> VerticalSpacingParNonBottom } - BDFSetIndentLevel bd -> rec bd + BDFBaseYPop bd -> rec bd + BDFIndentLevelPushCur bd -> rec bd + BDFIndentLevelPop bd -> rec bd BDFPar BrIndentNone sameLine indented -> do mVss <- rec sameLine indSps <- rec indented @@ -785,6 +795,22 @@ transformSimplifyFloating = stepBO .> stepFull BDAnnotationPrior annKey1 (BDAddBaseY indent x) -> Just $ BDAddBaseY indent $ BDAnnotationPrior annKey1 x _ -> Nothing + descendBYPush = transformDownMay $ \case + BDBaseYPushCur (BDCols sig cols) -> + Just $ BDCols sig (BDBaseYPushCur (List.head cols) : List.tail cols) + _ -> Nothing + descendBYPop = transformDownMay $ \case + BDBaseYPop (BDCols sig cols) -> + Just $ BDCols sig (List.init cols ++ [BDBaseYPop (List.last cols)]) + _ -> Nothing + descendILPush = transformDownMay $ \case + BDIndentLevelPushCur (BDCols sig cols) -> + Just $ BDCols sig (BDIndentLevelPushCur (List.head cols) : List.tail cols) + _ -> Nothing + descendILPop = transformDownMay $ \case + BDIndentLevelPop (BDCols sig cols) -> + Just $ BDCols sig (List.init cols ++ [BDIndentLevelPop (List.last cols)]) + _ -> Nothing descendAddB = transformDownMay $ \case -- AddIndent floats into Lines. BDAddBaseY BrIndentNone x -> @@ -805,17 +831,23 @@ transformSimplifyFloating = stepBO .> stepFull Just $ BDSeq $ List.init list ++ [BDAddBaseY ind (List.last list)] BDAddBaseY _ lit@BDLit{} -> Just $ lit - BDAddBaseY ind (BDSetBaseY x) -> - Just $ BDSetBaseY (BDAddBaseY ind x) + BDAddBaseY ind (BDBaseYPushCur x) -> + Just $ BDBaseYPushCur (BDAddBaseY ind x) + BDAddBaseY ind (BDBaseYPop x) -> + Just $ BDBaseYPop (BDAddBaseY ind x) _ -> Nothing stepBO :: BriDoc -> BriDoc stepBO = -- traceFunctionWith "stepBO" (show . briDocToDocWithAnns) (show . briDocToDocWithAnns) $ transformUp f where f = \case - x@BDAnnotationPrior{} -> descendPrior x - x@BDAnnotationPost{} -> descendPost x - x@BDAddBaseY{} -> descendAddB x + x@BDAnnotationPrior{} -> descendPrior x + x@BDAnnotationPost{} -> descendPost x + x@BDAddBaseY{} -> descendAddB x + x@BDBaseYPushCur{} -> descendBYPush x + x@BDBaseYPop{} -> descendBYPop x + x@BDIndentLevelPushCur{} -> descendILPush x + x@BDIndentLevelPop{} -> descendILPop x x -> x stepFull = -- traceFunctionWith "stepFull" (show . briDocToDocWithAnns) (show . briDocToDocWithAnns) $ Uniplate.rewrite $ \case @@ -834,8 +866,10 @@ transformSimplifyFloating = stepBO .> stepFull Just $ BDPar (mergeIndents ind1 ind2) line indented BDAddBaseY _ lit@BDLit{} -> Just $ lit - BDAddBaseY ind (BDSetBaseY x) -> - Just $ BDSetBaseY (BDAddBaseY ind x) + BDAddBaseY ind (BDBaseYPushCur x) -> + Just $ BDBaseYPushCur (BDAddBaseY ind x) + BDAddBaseY ind (BDBaseYPop x) -> + Just $ BDBaseYPop (BDAddBaseY ind x) -- prior floating in BDAnnotationPrior annKey1 (BDPar ind line indented) -> Just $ BDPar ind (BDAnnotationPrior annKey1 line) indented @@ -991,8 +1025,10 @@ transformSimplifyColumns = Uniplate.rewrite $ \case BDCols{} -> Nothing BDSeparator -> Nothing BDAddBaseY{} -> Nothing - BDSetBaseY{} -> Nothing - BDSetIndentLevel{} -> Nothing + BDBaseYPushCur{} -> Nothing + BDBaseYPop{} -> Nothing + BDIndentLevelPushCur{} -> Nothing + BDIndentLevelPop{} -> Nothing BDPar{} -> Nothing BDAlt{} -> Nothing BDForceMultiline{} -> Nothing @@ -1052,8 +1088,10 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc BDCols _ bds -> sum <$> rec `mapM` bds BDSeparator -> StateS.get >>= \b -> StateS.put True $> if b then 0 else 1 BDAddBaseY _ bd -> rec bd - BDSetBaseY bd -> rec bd - BDSetIndentLevel bd -> rec bd + BDBaseYPushCur bd -> rec bd + BDBaseYPop bd -> rec bd + BDIndentLevelPushCur bd -> rec bd + BDIndentLevelPop bd -> rec bd BDPar _ line _ -> rec line BDAlt{} -> error "briDocLineLength BDAlt" BDForceMultiline bd -> rec bd @@ -1104,10 +1142,18 @@ layoutBriDocM = \case BrIndentRegular -> layoutWithAddBaseCol BrIndentSpecial i -> layoutWithAddBaseColN i indentF $ layoutBriDocM bd - BDSetBaseY bd -> do - layoutSetBaseColCur $ layoutBriDocM bd - BDSetIndentLevel bd -> do - layoutSetIndentLevel $ layoutBriDocM bd + BDBaseYPushCur bd -> do + layoutBaseYPushCur + layoutBriDocM bd + BDBaseYPop bd -> do + layoutBriDocM bd + layoutBaseYPop + BDIndentLevelPushCur bd -> do + layoutIndentLevelPushCur + layoutBriDocM bd + BDIndentLevelPop bd -> do + layoutBriDocM bd + layoutIndentLevelPop BDEnsureIndent indent bd -> do let indentF = case indent of BrIndentNone -> id diff --git a/src/Language/Haskell/Brittany/LayoutBasics.hs b/src/Language/Haskell/Brittany/LayoutBasics.hs index f44c130..8d988d8 100644 --- a/src/Language/Haskell/Brittany/LayoutBasics.hs +++ b/src/Language/Haskell/Brittany/LayoutBasics.hs @@ -24,8 +24,10 @@ module Language.Haskell.Brittany.LayoutBasics , layoutWithAddBaseColBlock , layoutWithAddBaseColN , layoutWithAddBaseColNBlock - , layoutSetBaseColCur - , layoutSetIndentLevel + , layoutBaseYPushCur + , layoutBaseYPop + , layoutIndentLevelPushCur + , layoutIndentLevelPop , layoutWriteEnsureAbsoluteN , layoutAddSepSpace , layoutSetCommentCol @@ -283,7 +285,7 @@ layoutWriteNewlineBlock = do traceLocal ("layoutWriteNewlineBlock") state <- mGet mSet $ state { _lstate_curYOrAddNewline = Right 1 - , _lstate_addSepSpace = Just $ _lstate_baseY state + , _lstate_addSepSpace = Just $ lstate_baseY state , _lstate_inhibitMTEL = False } @@ -308,7 +310,7 @@ layoutSetCommentCol = do state <- mGet let col = case _lstate_curYOrAddNewline state of Left i -> i + fromMaybe 0 (_lstate_addSepSpace state) - Right{} -> _lstate_baseY state + Right{} -> lstate_baseY state traceLocal ("layoutSetCommentCol", col) unless (Data.Maybe.isJust $ _lstate_commentCol state) $ mSet state { _lstate_commentCol = Just col } @@ -346,7 +348,7 @@ layoutMoveToCommentPos y x = do else _lstate_indLevelLinger state + x , _lstate_commentCol = Just $ case _lstate_curYOrAddNewline state of Left i -> i + fromMaybe 0 (_lstate_addSepSpace state) - Right{} -> _lstate_baseY state + Right{} -> lstate_baseY state } -- | does _not_ add spaces to again reach the current base column. @@ -377,7 +379,7 @@ layoutWriteEnsureNewlineBlock = do { _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of Left{} -> Right 1 Right i -> Right $ max 1 i - , _lstate_addSepSpace = Just $ _lstate_baseY state + , _lstate_addSepSpace = Just $ lstate_baseY state , _lstate_inhibitMTEL = False , _lstate_commentCol = Nothing } @@ -392,10 +394,10 @@ layoutWriteEnsureBlock = do state <- mGet let diff = case (_lstate_addSepSpace state, _lstate_curYOrAddNewline state) of - (Nothing, Left i) -> _lstate_baseY state - i - (Nothing, Right{}) -> _lstate_baseY state - (Just sp, Left i) -> max sp (_lstate_baseY state - i) - (Just sp, Right{}) -> max sp (_lstate_baseY state) + (Nothing, Left i) -> lstate_baseY state - i + (Nothing, Right{}) -> lstate_baseY state + (Just sp, Left i) -> max sp (lstate_baseY state - i) + (Just sp, Right{}) -> max sp (lstate_baseY state) -- when (diff>0) $ layoutWriteNewlineBlock when (diff > 0) $ do mSet $ state { _lstate_addSepSpace = Just $ diff } @@ -418,22 +420,36 @@ layoutWriteEnsureAbsoluteN n = do -- bad way. } -layoutSetBaseColInternal :: ( MonadMultiState LayoutState m - , MonadMultiWriter (Seq String) m - ) => Int -> m () -layoutSetBaseColInternal i = do - traceLocal ("layoutSetBaseColInternal", i) - mModify $ \s -> s { _lstate_baseY = i } +layoutBaseYPushInternal + :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) + => Int + -> m () +layoutBaseYPushInternal i = do + traceLocal ("layoutBaseYPushInternal", i) + mModify $ \s -> s { _lstate_baseYs = i : _lstate_baseYs s } -layoutSetIndentLevelInternal :: ( MonadMultiState LayoutState m - , MonadMultiWriter (Seq String) m - ) => Int -> m () -layoutSetIndentLevelInternal i = do -#if INSERTTRACES - tellDebugMessShow ("layoutSetIndentLevelInternal", i) -#endif - mModify $ \s -> s { _lstate_indLevelLinger = _lstate_indLevel s - , _lstate_indLevel = i +layoutBaseYPopInternal + :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m () +layoutBaseYPopInternal = do + traceLocal ("layoutBaseYPopInternal") + mModify $ \s -> s { _lstate_baseYs = List.tail $ _lstate_baseYs s } + +layoutIndentLevelPushInternal + :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) + => Int + -> m () +layoutIndentLevelPushInternal i = do + traceLocal ("layoutIndentLevelPushInternal", i) + mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s + , _lstate_indLevels = i : _lstate_indLevels s + } + +layoutIndentLevelPopInternal + :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m () +layoutIndentLevelPopInternal = do + traceLocal ("layoutIndentLevelPopInternal") + mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s + , _lstate_indLevels = List.tail $ _lstate_indLevels s } layoutRemoveIndentLevelLinger :: ( MonadMultiState LayoutState m @@ -443,7 +459,7 @@ layoutRemoveIndentLevelLinger = do #if INSERTTRACES tellDebugMessShow ("layoutRemoveIndentLevelLinger") #endif - mModify $ \s -> s { _lstate_indLevelLinger = _lstate_indLevel s + mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s } layoutWithAddBaseCol :: (MonadMultiWriter @@ -459,42 +475,44 @@ layoutWithAddBaseCol m = do #endif amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> runIdentity state <- mGet - layoutSetBaseColInternal $ _lstate_baseY state + amount + layoutBaseYPushInternal $ lstate_baseY state + amount m - layoutSetBaseColInternal $ _lstate_baseY state + layoutBaseYPopInternal -layoutWithAddBaseColBlock :: (MonadMultiWriter - Text.Builder.Builder m, - MonadMultiState LayoutState m - ,MonadMultiReader Config m - , MonadMultiWriter (Seq String) m) - => m () - -> m () +layoutWithAddBaseColBlock + :: ( MonadMultiWriter Text.Builder.Builder m + , MonadMultiState LayoutState m + , MonadMultiReader Config m + , MonadMultiWriter (Seq String) m + ) + => m () + -> m () layoutWithAddBaseColBlock m = do #if INSERTTRACES tellDebugMessShow ("layoutWithAddBaseColBlock") #endif amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> runIdentity state <- mGet - layoutSetBaseColInternal $ _lstate_baseY state + amount + layoutBaseYPushInternal $ lstate_baseY state + amount layoutWriteEnsureBlock m - layoutSetBaseColInternal $ _lstate_baseY state + layoutBaseYPopInternal -layoutWithAddBaseColNBlock :: (MonadMultiWriter - Text.Builder.Builder m, - MonadMultiState LayoutState m - , MonadMultiWriter (Seq String) m) - => Int - -> m () - -> m () +layoutWithAddBaseColNBlock + :: ( MonadMultiWriter Text.Builder.Builder m + , MonadMultiState LayoutState m + , MonadMultiWriter (Seq String) m + ) + => Int + -> m () + -> m () layoutWithAddBaseColNBlock amount m = do traceLocal ("layoutWithAddBaseColNBlock", amount) state <- mGet - layoutSetBaseColInternal $ _lstate_baseY state + amount + layoutBaseYPushInternal $ lstate_baseY state + amount layoutWriteEnsureBlock m - layoutSetBaseColInternal $ _lstate_baseY state + layoutBaseYPopInternal layoutWithAddBaseColN :: (MonadMultiWriter Text.Builder.Builder m, @@ -508,44 +526,47 @@ layoutWithAddBaseColN amount m = do tellDebugMessShow ("layoutWithAddBaseColN", amount) #endif state <- mGet - layoutSetBaseColInternal $ _lstate_baseY state + amount + layoutBaseYPushInternal $ lstate_baseY state + amount m - layoutSetBaseColInternal $ _lstate_baseY state + layoutBaseYPopInternal -layoutSetBaseColCur :: (MonadMultiState - LayoutState m, - MonadMultiWriter (Seq String) m) - => m () -> m () -layoutSetBaseColCur m = do -#if INSERTTRACES - tellDebugMessShow ("layoutSetBaseColCur") -#endif +layoutBaseYPushCur + :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m () +layoutBaseYPushCur = do + traceLocal ("layoutBaseYPushCur") state <- mGet case _lstate_commentCol state of Nothing -> case (_lstate_curYOrAddNewline state, _lstate_addSepSpace state) of - (Left i, Just j) -> layoutSetBaseColInternal (i+j) - (Left i, Nothing) -> layoutSetBaseColInternal i + (Left i, Just j) -> layoutBaseYPushInternal (i+j) + (Left i, Nothing) -> layoutBaseYPushInternal i (Right{}, _) -> return () - Just cCol -> layoutSetBaseColInternal cCol - m - layoutSetBaseColInternal $ _lstate_baseY state + Just cCol -> layoutBaseYPushInternal cCol -layoutSetIndentLevel :: (MonadMultiState - LayoutState m, - MonadMultiWriter (Seq String) m) - => m () -> m () -layoutSetIndentLevel m = do -#if INSERTTRACES - tellDebugMessShow ("layoutSetIndentLevel") -#endif +layoutBaseYPop + :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m () +layoutBaseYPop = do + traceLocal ("layoutBaseYPop") + layoutBaseYPopInternal + +layoutIndentLevelPushCur + :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m () +layoutIndentLevelPushCur = do + traceLocal ("layoutIndentLevelPushCur") state <- mGet - layoutSetIndentLevelInternal $ case (_lstate_curYOrAddNewline state, _lstate_addSepSpace state) of - (Left i, Just j) -> i + j - (Left i, Nothing) -> i - (Right{}, Just j) -> j - (Right{}, Nothing) -> 0 - m - layoutSetIndentLevelInternal $ _lstate_indLevel state + let y = case (_lstate_curYOrAddNewline state, _lstate_addSepSpace state) of + (Left i, Just j) -> i + j + (Left i, Nothing) -> i + (Right{}, Just j) -> j + (Right{}, Nothing) -> 0 + layoutIndentLevelPushInternal y + layoutBaseYPushInternal y + +layoutIndentLevelPop + :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m () +layoutIndentLevelPop = do + traceLocal ("layoutIndentLevelPop") + layoutBaseYPop + layoutIndentLevelPopInternal -- why are comment indentations relative to the previous indentation on -- the first node of an additional indentation, and relative to the outer -- indentation after the last node of some indented stuff? sure does not @@ -588,7 +609,7 @@ moveToExactAnn annKey = do in state { _lstate_curYOrAddNewline = upd , _lstate_addSepSpace = if Data.Either.isRight upd - then _lstate_commentCol state <|> _lstate_addSepSpace state <|> Just (_lstate_baseY state) + then _lstate_commentCol state <|> _lstate_addSepSpace state <|> Just (lstate_baseY state) else Nothing , _lstate_commentCol = Nothing } @@ -884,10 +905,20 @@ docAddBaseY :: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docAddBaseY ind bdm = allocateNode . BDFAddBaseY ind =<< bdm docSetBaseY :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered -docSetBaseY bdm = allocateNode . BDFSetBaseY =<< bdm +docSetBaseY bdm = do + bd <- bdm + -- the order here is important so that these two nodes can be treated + -- properly over at `transformAlts`. + n1 <- allocateNode $ BDFBaseYPushCur bd + n2 <- allocateNode $ BDFBaseYPop n1 + return n2 docSetIndentLevel :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered -docSetIndentLevel bdm = allocateNode . BDFSetIndentLevel =<< bdm +docSetIndentLevel bdm = do + bd <- bdm + n1 <- allocateNode $ BDFIndentLevelPushCur bd + n2 <- allocateNode $ BDFIndentLevelPop n1 + return n2 docSeparator :: ToBriDocM BriDocNumbered docSeparator = allocateNode BDFSeparator diff --git a/src/Language/Haskell/Brittany/Types.hs b/src/Language/Haskell/Brittany/Types.hs index cfefa67..5f010a2 100644 --- a/src/Language/Haskell/Brittany/Types.hs +++ b/src/Language/Haskell/Brittany/Types.hs @@ -35,20 +35,22 @@ type PriorMap = Map AnnKey [(Comment, DeltaPos)] type PostMap = Map AnnKey [(Comment, DeltaPos)] data LayoutState = LayoutState - { _lstate_baseY :: Int -- ^ number of current indentation columns - -- (not number of indentations). + { _lstate_baseYs :: [Int] + -- ^ stack of number of current indentation columns + -- (not number of indentations). , _lstate_curYOrAddNewline :: Either Int Int -- ^ Either: -- 1) number of chars in the current line. -- 2) number of newlines to be inserted before inserting any -- non-space elements. - , _lstate_indLevel :: Int -- ^ current indentation level. set for - -- any layout-affected elements such as - -- let/do/case/where elements. - -- The main purpose of this member is to - -- properly align comments, as their - -- annotation positions are relative to the - -- current layout indentation level. + , _lstate_indLevels :: [Int] + -- ^ stack of current indentation levels. set for + -- any layout-affected elements such as + -- let/do/case/where elements. + -- The main purpose of this member is to + -- properly align comments, as their + -- annotation positions are relative to the + -- current layout indentation level. , _lstate_indLevelLinger :: Int -- like a "last" of indLevel. Used for -- properly treating cases where comments -- on the first indented element have an @@ -80,13 +82,19 @@ data LayoutState = LayoutState -- -- current line only contains (indentation) spaces. } +lstate_baseY :: LayoutState -> Int +lstate_baseY = head . _lstate_baseYs + +lstate_indLevel :: LayoutState -> Int +lstate_indLevel = head . _lstate_indLevels + -- evil, incomplete Show instance; only for debugging. instance Show LayoutState where show state = "LayoutState" - ++ "{baseY=" ++ show (_lstate_baseY state) + ++ "{baseYs=" ++ show (_lstate_baseYs state) ++ ",curYOrAddNewline=" ++ show (_lstate_curYOrAddNewline state) - ++ ",indLevel=" ++ show (_lstate_indLevel state) + ++ ",indLevels=" ++ show (_lstate_indLevels state) ++ ",indLevelLinger=" ++ show (_lstate_indLevelLinger state) ++ ",commentCol=" ++ show (_lstate_commentCol state) ++ ",addSepSpace=" ++ show (_lstate_addSepSpace state) @@ -194,8 +202,10 @@ data BriDoc -- should not contains BDPars | BDSeparator -- semantically, space-unless-at-end-of-line. | BDAddBaseY BrIndent BriDoc - | BDSetBaseY BriDoc - | BDSetIndentLevel BriDoc + | BDBaseYPushCur BriDoc + | BDBaseYPop BriDoc + | BDIndentLevelPushCur BriDoc + | BDIndentLevelPop BriDoc | BDPar { _bdpar_indent :: BrIndent , _bdpar_restOfLine :: BriDoc -- should not contain other BDPars @@ -234,8 +244,10 @@ data BriDocF f -- should not contains BDPars | BDFSeparator -- semantically, space-unless-at-end-of-line. | BDFAddBaseY BrIndent (f (BriDocF f)) - | BDFSetBaseY (f (BriDocF f)) - | BDFSetIndentLevel (f (BriDocF f)) + | BDFBaseYPushCur (f (BriDocF f)) + | BDFBaseYPop (f (BriDocF f)) + | BDFIndentLevelPushCur (f (BriDocF f)) + | BDFIndentLevelPop (f (BriDocF f)) | BDFPar { _bdfpar_indent :: BrIndent , _bdfpar_restOfLine :: f (BriDocF f) -- should not contain other BDPars @@ -276,8 +288,10 @@ instance Uniplate.Uniplate BriDoc where uniplate (BDCols sig list) = plate BDCols |- sig ||* list uniplate x@BDSeparator = plate x uniplate (BDAddBaseY ind bd) = plate BDAddBaseY |- ind |* bd - uniplate (BDSetBaseY bd) = plate BDSetBaseY |* bd - uniplate (BDSetIndentLevel bd) = plate BDSetIndentLevel |* bd + uniplate (BDBaseYPushCur bd) = plate BDBaseYPushCur |* bd + uniplate (BDBaseYPop bd) = plate BDBaseYPop |* bd + uniplate (BDIndentLevelPushCur bd) = plate BDIndentLevelPushCur |* bd + uniplate (BDIndentLevelPop bd) = plate BDIndentLevelPop |* bd uniplate (BDPar ind line indented) = plate BDPar |- ind |* line |* indented uniplate (BDAlt alts) = plate BDAlt ||* alts uniplate (BDForceMultiline bd) = plate BDForceMultiline |* bd @@ -301,8 +315,10 @@ unwrapBriDocNumbered = snd .> \case BDFCols sig list -> BDCols sig $ rec <$> list BDFSeparator -> BDSeparator BDFAddBaseY ind bd -> BDAddBaseY ind $ rec bd - BDFSetBaseY bd -> BDSetBaseY $ rec bd - BDFSetIndentLevel bd -> BDSetIndentLevel $ rec bd + BDFBaseYPushCur bd -> BDBaseYPushCur $ rec bd + BDFBaseYPop bd -> BDBaseYPop $ rec bd + BDFIndentLevelPushCur bd -> BDIndentLevelPushCur $ rec bd + BDFIndentLevelPop bd -> BDIndentLevelPop $ rec bd BDFPar ind line indented -> BDPar ind (rec line) (rec indented) BDFAlt alts -> BDAlt $ rec <$> alts -- not that this will happen BDFForceMultiline bd -> BDForceMultiline $ rec bd @@ -326,8 +342,10 @@ briDocSeqSpine = \case BDCols _sig list -> foldl' ((briDocSeqSpine .) . seq) () list BDSeparator -> () BDAddBaseY _ind bd -> briDocSeqSpine bd - BDSetBaseY bd -> briDocSeqSpine bd - BDSetIndentLevel bd -> briDocSeqSpine bd + BDBaseYPushCur bd -> briDocSeqSpine bd + BDBaseYPop bd -> briDocSeqSpine bd + BDIndentLevelPushCur bd -> briDocSeqSpine bd + BDIndentLevelPop bd -> briDocSeqSpine bd BDPar _ind line indented -> briDocSeqSpine line `seq` briDocSeqSpine indented BDAlt alts -> foldl' (\(!()) -> briDocSeqSpine) () alts BDForceMultiline bd -> briDocSeqSpine bd