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

Make cols work around SetBaseY/SetIndentLevel

pull/1/head
Lennart Spitzner 2016-08-04 15:10:44 +02:00
parent 982e19b8b9
commit a82d38fa70
3 changed files with 221 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
src/Language/Haskell/Brittany/BriLayouter.hs
View File

@ -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,8 +831,10 @@ 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) $
@ -816,6 +844,10 @@ transformSimplifyFloating = stepBO .> stepFull
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

169
src/Language/Haskell/Brittany/LayoutBasics.hs
View File

@ -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,15 +475,16 @@ 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
layoutWithAddBaseColBlock
:: ( MonadMultiWriter Text.Builder.Builder m
, MonadMultiState LayoutState m
, MonadMultiReader Config m
, MonadMultiWriter (Seq String) m)
, MonadMultiWriter (Seq String) m
)
=> m ()
-> m ()
layoutWithAddBaseColBlock m = do
@ -476,25 +493,26 @@ layoutWithAddBaseColBlock m = do
#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)
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
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
m
layoutSetIndentLevelInternal $ _lstate_indLevel state
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

46
src/Language/Haskell/Brittany/Types.hs
View File

@ -35,14 +35,16 @@ type PriorMap = Map AnnKey [(Comment, DeltaPos)]
type PostMap = Map AnnKey [(Comment, DeltaPos)]
data LayoutState = LayoutState
{ _lstate_baseY :: Int -- ^ number of current indentation columns
{ _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
, _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
@ -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