Clean up WriteBriDoc monad state handling
parent
847e01cc30
commit
7d3490b80a
|
|
@ -95,14 +95,10 @@ ppBriDoc briDoc = do
|
|||
-- return simpl
|
||||
|
||||
let state = LayoutState { _lstate_baseYs = [0]
|
||||
, _lstate_curYOrAddNewline = Right 0 -- important that we dont use left
|
||||
-- here because moveToAnn stuff
|
||||
-- of the first node needs to do
|
||||
-- its thing properly.
|
||||
, _lstate_curY = 0
|
||||
, _lstate_indLevels = [0]
|
||||
, _lstate_indLevelLinger = 0
|
||||
, _lstate_commentCol = Nothing
|
||||
, _lstate_addSepSpace = Nothing
|
||||
, _lstate_plannedSpace = PlannedNone
|
||||
, _lstate_commentNewlines = 0
|
||||
}
|
||||
state' <-
|
||||
|
|
@ -110,19 +106,22 @@ ppBriDoc briDoc = do
|
|||
$ MultiRWSS.withMultiStateS ([] :: [LEpaComment])
|
||||
$ do
|
||||
layoutBriDocM briDoc'
|
||||
layoutWriteEnsureBlock
|
||||
case _lstate_curYOrAddNewline state' of
|
||||
Left{} -> mTell $ TextL.Builder.fromString "\n"
|
||||
Right{} -> pure ()
|
||||
pure ()
|
||||
case _lstate_plannedSpace state' of
|
||||
PlannedNone -> if _lstate_curY state' == 0
|
||||
then pure ()
|
||||
else mTell $ TextL.Builder.fromString "\n"
|
||||
PlannedSameline _ -> if _lstate_curY state' == 0
|
||||
then pure ()
|
||||
else mTell $ TextL.Builder.fromString "\n"
|
||||
PlannedNewline l -> mTell $ TextL.Builder.fromString (replicate l '\n')
|
||||
PlannedDelta l _ -> mTell $ TextL.Builder.fromString (replicate l '\n')
|
||||
|
||||
|
||||
layoutBriDocM :: forall m . LayoutConstraints m => BriDoc -> m ()
|
||||
layoutBriDocM :: HasCallStack => forall m . LayoutConstraints m => BriDoc -> m ()
|
||||
layoutBriDocM = \case
|
||||
BDEmpty -> do
|
||||
return () -- can it be that simple
|
||||
BDLit t -> do
|
||||
layoutIndentRestorePostComment
|
||||
layoutRemoveIndentLevelLinger
|
||||
layoutWriteAppend t
|
||||
BDSeq list -> do
|
||||
|
|
@ -168,7 +167,7 @@ layoutBriDocM = \case
|
|||
BrIndentRegular -> layoutWithAddBaseCol
|
||||
BrIndentSpecial i -> layoutWithAddBaseColN i
|
||||
indentF $ do
|
||||
layoutWriteNewlineBlock
|
||||
layoutWriteNewline
|
||||
layoutBriDocM indented
|
||||
BDLines lines -> alignColsLines layoutBriDocM lines
|
||||
BDAlt [] -> error "empty BDAlt"
|
||||
|
|
@ -183,7 +182,7 @@ layoutBriDocM = \case
|
|||
layoutWriteAppend $ Text.pack $ "{- via external! -}"
|
||||
zip [1 ..] tlines `forM_` \(i, l) -> do
|
||||
layoutWriteAppend $ l
|
||||
unless (i == tlineCount) layoutWriteNewlineBlock
|
||||
unless (i == tlineCount) layoutWriteNewline
|
||||
BDPlain t -> do
|
||||
layoutWriteAppend t
|
||||
-- BDAnnotationPrior comms bd -> do
|
||||
|
|
@ -297,15 +296,15 @@ takeBefore loc = do
|
|||
|
||||
printComments :: LayoutConstraints m => [GHC.LEpaComment] -> m ()
|
||||
printComments comms = do
|
||||
let
|
||||
addComment s anchor prior = do
|
||||
case anchor of
|
||||
Anchor span UnchangedAnchor ->
|
||||
layoutMoveToCommentPos True (ExactPrint.ss2deltaEnd prior span) 1
|
||||
Anchor _span (MovedAnchor dp) ->
|
||||
layoutMoveToCommentPos False dp 1
|
||||
-- ppmMoveToExactLoc $ ExactPrint.ss2deltaEnd prior span
|
||||
layoutWriteAppend $ Text.pack s
|
||||
let addComment s anchor prior = do
|
||||
case anchor of
|
||||
Anchor span UnchangedAnchor -> layoutWriteComment
|
||||
True
|
||||
(ExactPrint.ss2deltaEnd prior span)
|
||||
1
|
||||
(Text.pack s)
|
||||
Anchor _span (MovedAnchor dp) ->
|
||||
layoutWriteComment False dp 1 (Text.pack s)
|
||||
comms `forM_` \case
|
||||
L anch (EpaComment (EpaDocCommentNext s) prior) -> addComment s anch prior
|
||||
L anch (EpaComment (EpaDocCommentPrev s) prior) -> addComment s anch prior
|
||||
|
|
|
|||
|
|
@ -11,7 +11,6 @@ import qualified Control.Monad.Trans.MultiRWS.Strict
|
|||
as MultiRWSS
|
||||
import Data.CZipWith
|
||||
import qualified Data.Map.Strict as Map
|
||||
-- import qualified Data.Sequence as Seq
|
||||
import qualified Data.Text.Lazy as TextL
|
||||
import qualified Data.Text.Lazy.Builder as TextL.Builder
|
||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ import Language.Haskell.Brittany.Internal.Prelude
|
|||
|
||||
import qualified Control.Monad.Trans.State.Strict
|
||||
as StateS
|
||||
import qualified Data.Either as Either
|
||||
-- import qualified Data.Either as Either
|
||||
import qualified Data.Foldable as Foldable
|
||||
import qualified Data.IntMap.Lazy as IntMapL
|
||||
import qualified Data.IntMap.Strict as IntMapS
|
||||
|
|
@ -138,9 +138,11 @@ alignColsLines layoutBriDocM bridocs = do -- colInfos `forM_` \colInfo -> do
|
|||
-- tellDebugMess ("alignColsLines: at " ++ take 100 (show $ briDocToDoc $ head bridocs))
|
||||
curX <- do
|
||||
state <- mGet
|
||||
return $ Either.fromLeft 0 (_lstate_curYOrAddNewline state) + fromMaybe
|
||||
0
|
||||
(_lstate_addSepSpace state)
|
||||
return $ case _lstate_plannedSpace state of
|
||||
PlannedNone -> _lstate_curY state
|
||||
PlannedSameline i -> _lstate_curY state + i
|
||||
PlannedNewline _l -> lstate_baseY state
|
||||
PlannedDelta _ i -> i
|
||||
colMax <- mAsk <&> _conf_layout .> _lconfig_cols .> confUnpack
|
||||
alignMax <- mAsk <&> _conf_layout .> _lconfig_alignmentLimit .> confUnpack
|
||||
alignBreak <-
|
||||
|
|
@ -296,15 +298,11 @@ processInfo layoutBriDocM maxSpace m = \case
|
|||
alignMode <- mAsk <&> _conf_layout .> _lconfig_columnAlignMode .> confUnpack
|
||||
curX <- do
|
||||
state <- mGet
|
||||
-- tellDebugMess ("processInfo: " ++ show (_lstate_curYOrAddNewline state)
|
||||
-- ++ " - " ++ show (_lstate_addSepSpace state)
|
||||
-- ++ " - " ++ show (_lstate_commentCol state))
|
||||
let spaceAdd = fromMaybe 0 $ _lstate_addSepSpace state
|
||||
return $ case _lstate_curYOrAddNewline state of
|
||||
Left i -> case _lstate_commentCol state of
|
||||
Nothing -> spaceAdd + i
|
||||
Just c -> c
|
||||
Right{} -> spaceAdd
|
||||
return $ case _lstate_plannedSpace state of
|
||||
PlannedNone -> _lstate_curY state
|
||||
PlannedSameline i -> _lstate_curY state + i
|
||||
PlannedNewline _l -> lstate_baseY state
|
||||
PlannedDelta _ i -> i
|
||||
let colMax = min colMaxConf (curX + maxSpace)
|
||||
-- tellDebugMess $ show curX
|
||||
let (ratio, maxCols1, _colss) = case IntMapS.lookup ind m of
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ module Language.Haskell.Brittany.Internal.WriteBriDoc.Operators
|
|||
( layoutWriteEnsureNewlineBlock
|
||||
, layoutWriteEnsureAbsoluteN
|
||||
, layoutWriteEnsureBlock
|
||||
, layoutIndentRestorePostComment
|
||||
-- , layoutIndentRestorePostComment
|
||||
, layoutRemoveIndentLevelLinger
|
||||
, layoutWriteAppend
|
||||
, layoutAddSepSpace
|
||||
|
|
@ -14,14 +14,13 @@ module Language.Haskell.Brittany.Internal.WriteBriDoc.Operators
|
|||
, layoutWithAddBaseColN
|
||||
, layoutIndentLevelPushCur
|
||||
, layoutIndentLevelPop
|
||||
, layoutWriteNewlineBlock
|
||||
, layoutMoveToCommentPos
|
||||
, layoutWriteNewline
|
||||
, layoutWriteComment
|
||||
)
|
||||
where
|
||||
|
||||
import Language.Haskell.Brittany.Internal.Prelude
|
||||
|
||||
import qualified Data.Maybe
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||
import qualified GHC.OldList as List
|
||||
|
|
@ -44,32 +43,53 @@ layoutWriteAppend
|
|||
-> m ()
|
||||
layoutWriteAppend t = do
|
||||
state <- mGet
|
||||
traceLocal ("layoutWriteAppend", t, _lstate_curYOrAddNewline state, _lstate_addSepSpace state)
|
||||
case _lstate_curYOrAddNewline state of
|
||||
Right i -> do
|
||||
replicateM_ i $ mTell $ Text.Builder.fromString $ "\n"
|
||||
Left{} -> do
|
||||
return ()
|
||||
let spaces = fromMaybe 0 $ _lstate_addSepSpace state
|
||||
mTell $ Text.Builder.fromText $ Text.pack (replicate spaces ' ')
|
||||
mTell $ Text.Builder.fromText $ t
|
||||
mModify $ \s -> s
|
||||
{ _lstate_curYOrAddNewline = Left $ case _lstate_curYOrAddNewline s of
|
||||
Left c -> c + Text.length t + spaces
|
||||
Right{} -> Text.length t + spaces
|
||||
, _lstate_addSepSpace = Nothing
|
||||
}
|
||||
traceLocal
|
||||
( "layoutWriteAppend"
|
||||
, t
|
||||
, _lstate_plannedSpace state
|
||||
)
|
||||
case _lstate_plannedSpace state of
|
||||
PlannedNone -> do
|
||||
mTell $ Text.Builder.fromText t
|
||||
mSet state { _lstate_curY = _lstate_curY state + Text.length t }
|
||||
PlannedSameline x -> do
|
||||
mTell $ Text.Builder.fromString $ replicate x ' '
|
||||
mTell $ Text.Builder.fromText t
|
||||
mSet state
|
||||
{ _lstate_plannedSpace = PlannedNone
|
||||
, _lstate_curY = _lstate_curY state
|
||||
+ x
|
||||
+ Text.length t
|
||||
}
|
||||
PlannedNewline l -> do
|
||||
mTell
|
||||
$ Text.Builder.fromString
|
||||
$ replicate l '\n'
|
||||
++ replicate (lstate_baseY state) ' '
|
||||
mTell $ Text.Builder.fromText t
|
||||
mSet state { _lstate_plannedSpace = PlannedNone
|
||||
, _lstate_curY = lstate_baseY state + Text.length t
|
||||
}
|
||||
PlannedDelta l i -> do
|
||||
mTell
|
||||
$ Text.Builder.fromString
|
||||
$ replicate l '\n'
|
||||
++ replicate i ' '
|
||||
mTell $ Text.Builder.fromText t
|
||||
mSet state { _lstate_plannedSpace = PlannedNone
|
||||
, _lstate_curY = i + Text.length t
|
||||
}
|
||||
|
||||
|
||||
-- adds a newline and adds spaces to reach the base column.
|
||||
layoutWriteNewlineBlock
|
||||
layoutWriteNewline
|
||||
:: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
|
||||
=> m ()
|
||||
layoutWriteNewlineBlock = do
|
||||
traceLocal ("layoutWriteNewlineBlock")
|
||||
layoutWriteNewline = do
|
||||
traceLocal ("layoutWriteNewline")
|
||||
state <- mGet
|
||||
mSet $ state
|
||||
{ _lstate_curYOrAddNewline = Right 1
|
||||
, _lstate_addSepSpace = Just $ lstate_baseY state
|
||||
{ _lstate_plannedSpace = PlannedNewline 1
|
||||
}
|
||||
|
||||
-- layoutMoveToIndentCol :: ( MonadMultiState LayoutState m
|
||||
|
|
@ -88,42 +108,31 @@ layoutWriteNewlineBlock = do
|
|||
|
||||
-- This is also used to move to non-comments in a couple of places. Seems
|
||||
-- to be harmless so far..
|
||||
layoutMoveToCommentPos
|
||||
layoutWriteComment
|
||||
:: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
|
||||
=> Bool
|
||||
-> GHC.DeltaPos
|
||||
-> Int
|
||||
-> Text
|
||||
-> m ()
|
||||
layoutMoveToCommentPos absolute dp commentLines = do
|
||||
layoutWriteComment absolute dp commentLines s = do -- TODO92 we don't move to comment pos at all!
|
||||
let (y, x) = case dp of
|
||||
GHC.SameLine c -> (0, c)
|
||||
GHC.DifferentLine l c -> (l, c)
|
||||
state <- mGet
|
||||
traceLocal ("layoutMoveToCommentPos", y, x, commentLines, _lstate_curYOrAddNewline state, _lstate_addSepSpace state, lstate_baseY state)
|
||||
mTell $ Text.Builder.fromString $ replicate y '\n' ++ replicate (if absolute && (y > 0) then x-1 else x) ' '
|
||||
mTell $ Text.Builder.fromText s
|
||||
traceLocal ("layoutMoveToCommentPos", y, x, commentLines, _lstate_plannedSpace state, lstate_baseY state)
|
||||
mSet state
|
||||
{ _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of
|
||||
Left i -> if y == 0 then Left i else Right y
|
||||
Right{} -> Right y
|
||||
, _lstate_addSepSpace =
|
||||
Just $ if
|
||||
| y > 0 -> if absolute then x - 1 else lstate_baseY state + x
|
||||
| Data.Maybe.isNothing (_lstate_commentCol state) -> x
|
||||
| otherwise -> x
|
||||
-- TODO92 we had more complex logic here for otherwise previously,
|
||||
-- but I don't think it can happen. Leaving this here until some
|
||||
-- more testing is done as a reminder.
|
||||
-- Also, if this _is_ necessary, the "absolute" handling might to
|
||||
-- be adapted.
|
||||
-- case _lstate_curYOrAddNewline state of
|
||||
-- Left{} -> x
|
||||
-- Right{} -> _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_plannedSpace = case _lstate_plannedSpace state of
|
||||
PlannedNone -> PlannedDelta 1 (_lstate_curY state)
|
||||
PlannedSameline i -> PlannedDelta 1 (_lstate_curY state + i)
|
||||
p@PlannedNewline{} -> p
|
||||
p@PlannedDelta{} -> p
|
||||
, _lstate_commentNewlines =
|
||||
_lstate_commentNewlines state + y + commentLines - 1
|
||||
, _lstate_curY = if y == 0 then _lstate_curY state + x
|
||||
else x
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -138,11 +147,11 @@ layoutWriteEnsureNewlineBlock = do
|
|||
state <- mGet
|
||||
traceLocal ("layoutWriteEnsureNewlineBlock", lstate_baseY state)
|
||||
mSet $ state
|
||||
{ _lstate_curYOrAddNewline = case _lstate_curYOrAddNewline state of
|
||||
Left{} -> Right 1
|
||||
Right i -> Right $ max 1 i
|
||||
, _lstate_addSepSpace = Just $ lstate_baseY state
|
||||
, _lstate_commentCol = Nothing
|
||||
{ _lstate_plannedSpace = case _lstate_plannedSpace state of
|
||||
PlannedNone -> PlannedNewline 1
|
||||
PlannedSameline _ -> PlannedNewline 1
|
||||
PlannedNewline i -> PlannedNewline i
|
||||
PlannedDelta i _ -> PlannedNewline i
|
||||
}
|
||||
|
||||
layoutWriteEnsureAbsoluteN
|
||||
|
|
@ -151,17 +160,14 @@ layoutWriteEnsureAbsoluteN
|
|||
-> m ()
|
||||
layoutWriteEnsureAbsoluteN n = do
|
||||
state <- mGet
|
||||
let
|
||||
diff = case (_lstate_commentCol state, _lstate_curYOrAddNewline state) of
|
||||
(Just c, _) -> n - c
|
||||
(Nothing, Left i) -> n - i
|
||||
(Nothing, Right{}) -> n
|
||||
traceLocal ("layoutWriteEnsureAbsoluteN", n, diff)
|
||||
when (diff > 0) $ do
|
||||
mSet $ state { _lstate_addSepSpace = Just diff } -- this always sets to
|
||||
-- at least (Just 1), so we won't
|
||||
-- overwrite any old value in any
|
||||
-- bad way.
|
||||
traceLocal ("layoutWriteEnsureAbsoluteN", n)
|
||||
mSet $ state
|
||||
{ _lstate_plannedSpace = case _lstate_plannedSpace state of
|
||||
PlannedNone -> PlannedSameline (max 0 $ n - _lstate_curY state)
|
||||
PlannedSameline i -> PlannedSameline (max i $ n - _lstate_curY state)
|
||||
PlannedNewline l -> PlannedDelta l n
|
||||
PlannedDelta l _ -> PlannedDelta l n
|
||||
}
|
||||
|
||||
layoutBaseYPushInternal :: (MonadMultiState LayoutState m) => Int -> m ()
|
||||
layoutBaseYPushInternal i = do
|
||||
|
|
@ -213,15 +219,15 @@ layoutWriteEnsureBlock
|
|||
layoutWriteEnsureBlock = do
|
||||
traceLocal ("layoutWriteEnsureBlock")
|
||||
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)
|
||||
-- when (diff>0) $ layoutWriteNewlineBlock
|
||||
when (diff > 0) $ do
|
||||
mSet $ state { _lstate_addSepSpace = Just $ diff }
|
||||
mSet $ state
|
||||
{ _lstate_plannedSpace = case _lstate_plannedSpace state of
|
||||
PlannedNone ->
|
||||
PlannedSameline (max 0 $ lstate_baseY state - _lstate_curY state)
|
||||
PlannedSameline i ->
|
||||
PlannedSameline (max i $ lstate_baseY state - _lstate_curY state)
|
||||
PlannedNewline l -> PlannedDelta l (lstate_baseY state)
|
||||
PlannedDelta l i -> PlannedDelta l (max i $ lstate_baseY state)
|
||||
}
|
||||
|
||||
layoutWithAddBaseColN
|
||||
:: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
|
||||
|
|
@ -239,16 +245,13 @@ layoutBaseYPushCur = do
|
|||
state <- mGet
|
||||
traceLocal
|
||||
( "layoutBaseYPushCur"
|
||||
, _lstate_curYOrAddNewline state
|
||||
, _lstate_addSepSpace state
|
||||
)
|
||||
layoutBaseYPushInternal
|
||||
(case _lstate_commentCol state of
|
||||
Nothing -> case _lstate_curYOrAddNewline state of
|
||||
Left i -> i + fromMaybe 0 (_lstate_addSepSpace state)
|
||||
Right{} -> lstate_baseY state
|
||||
Just cCol -> cCol + fromMaybe 0 (_lstate_addSepSpace state)
|
||||
, _lstate_plannedSpace state
|
||||
)
|
||||
layoutBaseYPushInternal $ case _lstate_plannedSpace state of
|
||||
PlannedNone -> _lstate_curY state
|
||||
PlannedSameline i -> _lstate_curY state + i
|
||||
PlannedNewline _l -> lstate_baseY state
|
||||
PlannedDelta _l i -> i
|
||||
|
||||
|
||||
layoutBaseYPop :: (MonadMultiState LayoutState m) => m ()
|
||||
|
|
@ -260,13 +263,11 @@ layoutIndentLevelPushCur :: (MonadMultiState LayoutState m) => m ()
|
|||
layoutIndentLevelPushCur = do
|
||||
traceLocal ("layoutIndentLevelPushCur")
|
||||
state <- mGet
|
||||
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
|
||||
layoutIndentLevelPushInternal $ case _lstate_plannedSpace state of
|
||||
PlannedNone -> _lstate_curY state
|
||||
PlannedSameline i -> _lstate_curY state + i
|
||||
PlannedNewline _l -> error "strange operation" -- TODO92
|
||||
PlannedDelta _l i -> i
|
||||
|
||||
layoutIndentLevelPop :: (MonadMultiState LayoutState m) => m ()
|
||||
layoutIndentLevelPop = do
|
||||
|
|
@ -282,29 +283,16 @@ layoutAddSepSpace :: (MonadMultiState LayoutState m) => m ()
|
|||
layoutAddSepSpace = do
|
||||
state <- mGet
|
||||
mSet $ state
|
||||
{ _lstate_addSepSpace = Just $ fromMaybe 1 $ _lstate_addSepSpace state
|
||||
{ _lstate_plannedSpace = case _lstate_plannedSpace state of
|
||||
PlannedNone -> PlannedSameline 1
|
||||
PlannedSameline i -> PlannedSameline (max 1 i)
|
||||
x@PlannedNewline{} -> x
|
||||
PlannedDelta l i -> PlannedDelta l (i + 1)
|
||||
-- the planneddelta case is questionable. The problem is that we don't
|
||||
-- know exactly how much is "separator" and how much is exact positioning
|
||||
-- (e.g. from an inserted comment restore-position task).
|
||||
}
|
||||
|
||||
-- TODO: when refactoring is complete, the other version of this method
|
||||
-- can probably be removed.
|
||||
-- moveToExactAnn
|
||||
-- :: ( MonadMultiWriter Text.Builder.Builder m
|
||||
-- , MonadMultiState LayoutState m
|
||||
-- , MonadMultiReader (Map AnnKey Annotation) m
|
||||
-- )
|
||||
-- => AnnKey
|
||||
-- -> m ()
|
||||
-- moveToExactAnn annKey = do
|
||||
-- traceLocal ("moveToExactAnn", annKey)
|
||||
-- anns <- mAsk
|
||||
-- case Map.lookup annKey anns of
|
||||
-- Nothing -> return ()
|
||||
-- Just ann -> do
|
||||
-- -- curY <- mGet <&> _lstate_curY
|
||||
-- let ExactPrint.DP (y, _x) = ExactPrint.annEntryDelta ann
|
||||
-- -- mModify $ \state -> state { _lstate_addNewline = Just x }
|
||||
-- moveToY y
|
||||
|
||||
-- moveToY :: MonadMultiState LayoutState m => Int -> m ()
|
||||
-- moveToY y = mModify $ \state ->
|
||||
-- let
|
||||
|
|
@ -394,23 +382,6 @@ layoutAddSepSpace = do
|
|||
-- mModify $ \s -> s { _lstate_addSepSpace = Nothing }
|
||||
-- layoutWriteAppendMultiline $ Text.lines $ Text.pack $ comment
|
||||
|
||||
layoutIndentRestorePostComment
|
||||
:: (MonadMultiState LayoutState m, MonadMultiWriter Text.Builder.Builder m)
|
||||
=> m ()
|
||||
layoutIndentRestorePostComment = do
|
||||
state <- mGet
|
||||
let mCommentCol = _lstate_commentCol state
|
||||
let eCurYAddNL = _lstate_curYOrAddNewline state
|
||||
mModify
|
||||
$ \s -> s { _lstate_commentCol = Nothing, _lstate_commentNewlines = 0 }
|
||||
case (mCommentCol, eCurYAddNL) of
|
||||
(Just commentCol, Left{}) -> do
|
||||
layoutWriteEnsureNewlineBlock
|
||||
layoutWriteEnsureAbsoluteN $ commentCol + fromMaybe
|
||||
0
|
||||
(_lstate_addSepSpace state)
|
||||
_ -> return ()
|
||||
|
||||
-- layoutWritePriorCommentsRestore :: (Data.Data.Data ast,
|
||||
-- MonadMultiWriter Text.Builder.Builder m,
|
||||
-- MonadMultiState LayoutState m
|
||||
|
|
|
|||
|
|
@ -15,11 +15,18 @@ import Language.Haskell.Brittany.Internal.Types
|
|||
|
||||
|
||||
|
||||
data PlanneSpace
|
||||
= PlannedNone
|
||||
| PlannedSameline Int
|
||||
| PlannedNewline Int
|
||||
| PlannedDelta Int Int
|
||||
deriving (Show)
|
||||
|
||||
data LayoutState = LayoutState
|
||||
{ _lstate_baseYs :: [Int]
|
||||
-- ^ stack of number of current indentation columns
|
||||
-- (not number of indentations).
|
||||
, _lstate_curYOrAddNewline :: Either Int Int
|
||||
, _lstate_curY :: Int
|
||||
-- ^ Either:
|
||||
-- 1) number of chars in the current line.
|
||||
-- 2) number of newlines to be inserted before inserting any
|
||||
|
|
@ -37,16 +44,7 @@ data LayoutState = LayoutState
|
|||
-- on the first indented element have an
|
||||
-- annotation offset relative to the last
|
||||
-- non-indented element, which is confusing.
|
||||
-- , _lstate_comments :: Anns
|
||||
, _lstate_commentCol :: Maybe Int -- this communicates two things:
|
||||
-- firstly, that cursor is currently
|
||||
-- at the end of a comment (so needs
|
||||
-- newline before any actual content).
|
||||
-- secondly, the column at which
|
||||
-- insertion of comments started.
|
||||
, _lstate_addSepSpace :: Maybe Int -- number of spaces to insert if anyone
|
||||
-- writes (any non-spaces) in the
|
||||
-- current line.
|
||||
, _lstate_plannedSpace :: PlanneSpace
|
||||
-- , _lstate_isNewline :: NewLineState
|
||||
-- -- captures if the layouter currently is in a new line, i.e. if the
|
||||
-- -- current line only contains (indentation) spaces.
|
||||
|
|
@ -75,11 +73,10 @@ instance Show LayoutState where
|
|||
show state =
|
||||
"LayoutState"
|
||||
++ "{baseYs=" ++ show (_lstate_baseYs state)
|
||||
++ ",curYOrAddNewline=" ++ show (_lstate_curYOrAddNewline state)
|
||||
++ ",curY=" ++ show (_lstate_curY state)
|
||||
++ ",indLevels=" ++ show (_lstate_indLevels state)
|
||||
++ ",indLevelLinger=" ++ show (_lstate_indLevelLinger state)
|
||||
++ ",commentCol=" ++ show (_lstate_commentCol state)
|
||||
++ ",addSepSpace=" ++ show (_lstate_addSepSpace state)
|
||||
++ ",plannedSpace=" ++ show (_lstate_plannedSpace state)
|
||||
++ ",commentNewlines=" ++ show (_lstate_commentNewlines state)
|
||||
++ "}"
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue