918 lines
43 KiB
Haskell
918 lines
43 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE MonadComprehensions #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
module Language.Haskell.Brittany.Internal.Transformations.Alt
|
|
( transformAlts
|
|
)
|
|
where
|
|
|
|
|
|
|
|
import Language.Haskell.Brittany.Internal.Prelude
|
|
import Language.Haskell.Brittany.Internal.PreludeUtils
|
|
import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
|
|
import qualified Data.List.Extra
|
|
import qualified Data.Semigroup as Semigroup
|
|
import qualified Data.Text as Text
|
|
import qualified GHC.OldList as List
|
|
|
|
import Data.HList.ContainsType
|
|
|
|
import Language.Haskell.Brittany.Internal.Utils
|
|
import Language.Haskell.Brittany.Internal.Config.Types
|
|
import Language.Haskell.Brittany.Internal.Types
|
|
|
|
import qualified Control.Monad.Memo as Memo
|
|
|
|
|
|
|
|
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_forceMLFlag :: AltLineModeState
|
|
}
|
|
deriving (Show)
|
|
|
|
data AltLineModeState
|
|
= AltLineModeStateNone
|
|
| AltLineModeStateForceML Bool -- true ~ decays on next wrap
|
|
| AltLineModeStateForceSL
|
|
| AltLineModeStateContradiction
|
|
-- i.e. ForceX False -> ForceX True -> None
|
|
deriving (Show)
|
|
|
|
altLineModeRefresh :: AltLineModeState -> AltLineModeState
|
|
altLineModeRefresh AltLineModeStateNone = AltLineModeStateNone
|
|
altLineModeRefresh AltLineModeStateForceML{} = AltLineModeStateForceML False
|
|
altLineModeRefresh AltLineModeStateForceSL = AltLineModeStateForceSL
|
|
altLineModeRefresh AltLineModeStateContradiction = AltLineModeStateContradiction
|
|
|
|
altLineModeDecay :: AltLineModeState -> AltLineModeState
|
|
altLineModeDecay AltLineModeStateNone = AltLineModeStateNone
|
|
altLineModeDecay (AltLineModeStateForceML False) = AltLineModeStateForceML True
|
|
altLineModeDecay (AltLineModeStateForceML True ) = AltLineModeStateNone
|
|
altLineModeDecay AltLineModeStateForceSL = AltLineModeStateForceSL
|
|
altLineModeDecay AltLineModeStateContradiction = AltLineModeStateContradiction
|
|
|
|
mergeLineMode :: AltCurPos -> AltLineModeState -> AltCurPos
|
|
mergeLineMode acp s = case (_acp_forceMLFlag acp, s) of
|
|
(AltLineModeStateContradiction, _) -> acp
|
|
(AltLineModeStateNone, x) -> acp { _acp_forceMLFlag = x }
|
|
(AltLineModeStateForceSL, AltLineModeStateForceSL) -> acp
|
|
(AltLineModeStateForceML{}, AltLineModeStateForceML{}) ->
|
|
acp { _acp_forceMLFlag = s }
|
|
_ -> acp { _acp_forceMLFlag = AltLineModeStateContradiction }
|
|
|
|
|
|
-- removes any BDAlt's from the BriDoc
|
|
transformAlts
|
|
:: forall r w s
|
|
. ( Data.HList.ContainsType.ContainsType Config r
|
|
, Data.HList.ContainsType.ContainsType (Seq String) w
|
|
)
|
|
=> BriDocNumbered
|
|
-> MultiRWSS.MultiRWS r w s BriDoc
|
|
transformAlts =
|
|
MultiRWSS.withMultiStateA (AltCurPos 0 0 0 AltLineModeStateNone)
|
|
. Memo.startEvalMemoT
|
|
. fmap unwrapBriDocNumbered
|
|
. rec
|
|
where
|
|
-- this function is exponential by nature and cannot be improved in any
|
|
-- way i can think of, and i've tried. (stupid StableNames.)
|
|
-- transWrap :: BriDoc -> BriDocNumbered
|
|
-- transWrap brDc = flip StateS.evalState (1::Int)
|
|
-- $ Memo.startEvalMemoT
|
|
-- $ go brDc
|
|
-- where
|
|
-- incGet = StateS.get >>= \i -> StateS.put (i+1) $> i
|
|
-- go :: BriDoc -> Memo.MemoT BriDoc BriDocNumbered (StateS.State Int) BriDocNumbered
|
|
-- go = Memo.memo $ \bdX -> do
|
|
-- i <- lift $ incGet
|
|
-- fmap (\bd' -> (i,bd')) $ case bdX of
|
|
-- BDEmpty -> return $ BDFEmpty
|
|
-- BDLit t -> return $ BDFLit t
|
|
-- BDSeq list -> BDFSeq <$> go `mapM` list
|
|
-- BDCols sig list -> BDFCols sig <$> go `mapM` list
|
|
-- BDSeparator -> return $ BDFSeparator
|
|
-- BDAddBaseY ind bd -> BDFAddBaseY ind <$> go bd
|
|
-- BDSetBaseY bd -> BDFSetBaseY <$> go bd
|
|
-- BDSetIndentLevel bd -> BDFSetIndentLevel <$> go bd
|
|
-- BDPar ind line indented -> [ BDFPar ind line' indented'
|
|
-- | line' <- go line
|
|
-- , indented' <- go indented
|
|
-- ]
|
|
-- BDAlt alts -> BDFAlt <$> go `mapM` alts -- not that this will happen
|
|
-- BDForceMultiline bd -> BDFForceMultiline <$> go bd
|
|
-- BDForceSingleline bd -> BDFForceSingleline <$> go bd
|
|
-- BDForwardLineMode bd -> BDFForwardLineMode <$> go bd
|
|
-- BDExternal k ks c t -> return $ BDFExternal k ks c t
|
|
-- BDAnnotationPrior annKey bd -> BDFAnnotationPrior annKey <$> go bd
|
|
-- BDAnnotationPost annKey bd -> BDFAnnotationRest annKey <$> go bd
|
|
-- BDLines lines -> BDFLines <$> go `mapM` lines
|
|
-- BDEnsureIndent ind bd -> BDFEnsureIndent ind <$> go bd
|
|
-- BDProhibitMTEL bd -> BDFProhibitMTEL <$> go bd
|
|
|
|
|
|
|
|
rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] (MultiRWSS.MultiRWS r w (AltCurPos ': s)) BriDocNumbered
|
|
rec bdX@(brDcId, brDc) = do
|
|
let reWrap = (,) brDcId
|
|
-- debugAcp :: AltCurPos <- mGet
|
|
case brDc of
|
|
-- BDWrapAnnKey annKey bd -> do
|
|
-- acp <- mGet
|
|
-- mSet $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp }
|
|
-- BDWrapAnnKey annKey <$> rec bd
|
|
BDFEmpty{} -> processSpacingSimple bdX $> bdX
|
|
BDFLit{} -> processSpacingSimple bdX $> bdX
|
|
BDFSeq list ->
|
|
reWrap . BDFSeq <$> list `forM` rec
|
|
BDFCols sig list ->
|
|
reWrap . BDFCols sig <$> list `forM` rec
|
|
BDFSeparator -> processSpacingSimple bdX $> bdX
|
|
BDFAddBaseY indent bd -> do
|
|
acp <- mGet
|
|
indAdd <- fixIndentationForMultiple acp indent
|
|
mSet $ acp { _acp_indentPrep = max (_acp_indentPrep acp) indAdd }
|
|
r <- rec bd
|
|
acp' <- mGet
|
|
mSet $ acp' { _acp_indent = _acp_indent acp }
|
|
return $ case indent of
|
|
BrIndentNone -> r
|
|
BrIndentRegular -> reWrap $ BDFAddBaseY (BrIndentSpecial indAdd) r
|
|
BrIndentSpecial i -> reWrap $ BDFAddBaseY (BrIndentSpecial i) r
|
|
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_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 .> confUnpack
|
|
let indAdd = case indent of
|
|
BrIndentNone -> 0
|
|
BrIndentRegular -> indAmount
|
|
BrIndentSpecial i -> i
|
|
acp <- mGet
|
|
let ind = _acp_indent acp + _acp_indentPrep acp + indAdd
|
|
mSet $ acp
|
|
{ _acp_indent = ind
|
|
, _acp_indentPrep = 0
|
|
}
|
|
sameLine' <- rec sameLine
|
|
mModify $ \acp' -> acp'
|
|
{ _acp_line = ind
|
|
, _acp_indent = ind
|
|
}
|
|
indented' <- rec indented
|
|
return $ reWrap $ BDFPar indent sameLine' indented'
|
|
BDFAlt [] -> error "empty BDAlt" -- returning BDEmpty instead is a
|
|
-- possibility, but i will prefer a
|
|
-- fail-early approach; BDEmpty does not
|
|
-- make sense semantically for Alt[].
|
|
BDFAlt alts -> do
|
|
altChooser <- mAsk <&> _conf_layout .> _lconfig_altChooser .> confUnpack
|
|
case altChooser of
|
|
AltChooserSimpleQuick -> do
|
|
rec $ head alts
|
|
AltChooserShallowBest -> do
|
|
spacings <- alts `forM` getSpacing
|
|
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
|
|
-- TODO: use COMPLETE pragma instead?
|
|
lineCheck _ = error "ghc exhaustive check is insufficient"
|
|
lconf <- _conf_layout <$> mAsk
|
|
let options = -- trace ("considering options:" ++ show (length alts, acp)) $
|
|
(zip spacings alts
|
|
<&> \(vs, bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs))
|
|
( hasSpace1 lconf acp vs && lineCheck vs, bd))
|
|
id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x)
|
|
$ rec
|
|
$ fromMaybe (-- trace ("choosing last") $
|
|
List.last alts)
|
|
$ Data.List.Extra.firstJust (\(_i::Int, (b,x)) ->
|
|
[ -- traceShow ("choosing option " ++ show i) $
|
|
x
|
|
| b
|
|
])
|
|
$ zip [1..] options
|
|
AltChooserBoundedSearch limit -> do
|
|
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
|
|
lconf <- _conf_layout <$> mAsk
|
|
let options = -- trace ("considering options:" ++ show (length alts, acp)) $
|
|
(zip spacings alts
|
|
<&> \(vs, bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs))
|
|
( any (hasSpace2 lconf acp) vs
|
|
&& any lineCheck vs, bd))
|
|
let checkedOptions :: [Maybe (Int, BriDocNumbered)] =
|
|
zip [1..] options <&> (\(i, (b,x)) -> [ (i, x) | b ])
|
|
id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x)
|
|
$ rec
|
|
$ fromMaybe (-- trace ("choosing last") $
|
|
List.last alts)
|
|
$ Data.List.Extra.firstJust (fmap snd) checkedOptions
|
|
BDFForceMultiline bd -> do
|
|
acp <- mGet
|
|
x <- do
|
|
mSet $ mergeLineMode acp (AltLineModeStateForceML False)
|
|
rec bd
|
|
acp' <- mGet
|
|
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
|
return $ x
|
|
BDFForceSingleline bd -> do
|
|
acp <- mGet
|
|
x <- do
|
|
mSet $ mergeLineMode acp AltLineModeStateForceSL
|
|
rec bd
|
|
acp' <- mGet
|
|
mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
|
|
return $ x
|
|
BDFForwardLineMode 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
|
|
BDFExternal{} -> processSpacingSimple bdX $> bdX
|
|
BDFPlain{} -> processSpacingSimple bdX $> bdX
|
|
BDFAnnotationPrior annKey bd -> do
|
|
acp <- mGet
|
|
mSet $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp }
|
|
bd' <- rec bd
|
|
return $ reWrap $ BDFAnnotationPrior annKey bd'
|
|
BDFAnnotationRest annKey bd ->
|
|
reWrap . BDFAnnotationRest annKey <$> rec bd
|
|
BDFAnnotationKW annKey kw bd ->
|
|
reWrap . BDFAnnotationKW annKey kw <$> rec bd
|
|
BDFMoveToKWDP annKey kw b bd ->
|
|
reWrap . BDFMoveToKWDP annKey kw b <$> rec bd
|
|
BDFLines [] -> return $ reWrap BDFEmpty -- evil transformation. or harmless.
|
|
BDFLines (l:lr) -> do
|
|
ind <- _acp_indent <$> mGet
|
|
l' <- rec l
|
|
lr' <- lr `forM` \x -> do
|
|
mModify $ \acp -> acp
|
|
{ _acp_line = ind
|
|
, _acp_indent = ind
|
|
}
|
|
rec x
|
|
return $ reWrap $ BDFLines (l':lr')
|
|
BDFEnsureIndent indent bd -> do
|
|
acp <- mGet
|
|
indAdd <- fixIndentationForMultiple acp indent
|
|
mSet $ acp
|
|
{ _acp_indentPrep = 0
|
|
-- TODO: i am not sure this is valid, in general.
|
|
, _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
|
|
-- where there are multiple BDFEnsureIndents in the same line.
|
|
-- Then, the actual indentation is relative to the current
|
|
-- indentation, not the current cursor position.
|
|
}
|
|
r <- rec bd
|
|
acp' <- mGet
|
|
mSet $ acp' { _acp_indent = _acp_indent acp }
|
|
return $ case indent of
|
|
BrIndentNone -> r
|
|
BrIndentRegular -> reWrap $ BDFEnsureIndent (BrIndentSpecial indAdd) r
|
|
BrIndentSpecial i -> reWrap $ BDFEnsureIndent (BrIndentSpecial i) r
|
|
BDFNonBottomSpacing _ bd -> rec bd
|
|
BDFSetParSpacing bd -> rec bd
|
|
BDFForceParSpacing bd -> rec bd
|
|
BDFDebug s bd -> do
|
|
acp :: AltCurPos <- mGet
|
|
tellDebugMess $ "transformAlts: BDFDEBUG " ++ s ++ " (node-id=" ++ show brDcId ++ "): acp=" ++ show acp
|
|
reWrap . BDFDebug s <$> rec bd
|
|
processSpacingSimple
|
|
:: ( MonadMultiReader Config m
|
|
, MonadMultiState AltCurPos m
|
|
, MonadMultiWriter (Seq String) m
|
|
)
|
|
=> BriDocNumbered
|
|
-> m ()
|
|
processSpacingSimple bd = getSpacing bd >>= \case
|
|
LineModeInvalid -> error "processSpacingSimple inv"
|
|
LineModeValid (VerticalSpacing i VerticalSpacingParNone _) -> do
|
|
acp <- mGet
|
|
mSet $ acp { _acp_line = _acp_line acp + i }
|
|
LineModeValid (VerticalSpacing _ _ _) -> error "processSpacingSimple par"
|
|
_ -> error "ghc exhaustive check is insufficient"
|
|
hasSpace1 :: LayoutConfig -> AltCurPos -> LineModeValidity VerticalSpacing -> Bool
|
|
hasSpace1 _ _ LineModeInvalid = False
|
|
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 _)
|
|
= line + sameLine <= confUnpack (_lconfig_cols lconf)
|
|
hasSpace2 lconf (AltCurPos line indent indentPrep _) (VerticalSpacing sameLine (VerticalSpacingParSome par) _)
|
|
= line + sameLine <= confUnpack (_lconfig_cols lconf)
|
|
&& indent + indentPrep + par <= confUnpack (_lconfig_cols lconf)
|
|
hasSpace2 lconf (AltCurPos line _indent _ _) (VerticalSpacing sameLine VerticalSpacingParAlways{} _)
|
|
= line + sameLine <= confUnpack (_lconfig_cols lconf)
|
|
|
|
getSpacing
|
|
:: forall m
|
|
. (MonadMultiReader Config m, MonadMultiWriter (Seq String) m)
|
|
=> BriDocNumbered
|
|
-> m (LineModeValidity VerticalSpacing)
|
|
getSpacing !bridoc = rec bridoc
|
|
where
|
|
rec :: BriDocNumbered -> m (LineModeValidity VerticalSpacing)
|
|
rec (brDcId, brDc) = do
|
|
config <- mAsk
|
|
let colMax = config & _conf_layout & _lconfig_cols & confUnpack
|
|
result <- case brDc of
|
|
-- BDWrapAnnKey _annKey bd -> rec bd
|
|
BDFEmpty ->
|
|
return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
|
|
BDFLit t ->
|
|
return $ LineModeValid $ VerticalSpacing (Text.length t) VerticalSpacingParNone False
|
|
BDFSeq list ->
|
|
sumVs <$> rec `mapM` list
|
|
BDFCols _sig list -> sumVs <$> rec `mapM` list
|
|
BDFSeparator ->
|
|
return $ LineModeValid $ VerticalSpacing 1 VerticalSpacingParNone False
|
|
BDFAddBaseY 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
|
|
}
|
|
BDFBaseYPushCur bd -> do
|
|
mVs <- rec bd
|
|
return $ mVs <&> \vs -> vs
|
|
-- We leave par as-is, even though it technically is not
|
|
-- accurate (in general).
|
|
-- the reason is that we really want to _keep_ it Just if it is
|
|
-- just so we properly communicate the is-multiline fact.
|
|
-- An alternative would be setting to (Just 0).
|
|
{ _vs_sameLine = max (_vs_sameLine vs)
|
|
(case _vs_paragraph vs of
|
|
VerticalSpacingParNone -> 0
|
|
VerticalSpacingParSome i -> i
|
|
VerticalSpacingParAlways i -> min colMax i)
|
|
, _vs_paragraph = VerticalSpacingParSome 0
|
|
}
|
|
BDFBaseYPop bd -> rec bd
|
|
BDFIndentLevelPushCur bd -> rec bd
|
|
BDFIndentLevelPop bd -> rec bd
|
|
BDFPar BrIndentNone sameLine indented -> do
|
|
mVs <- rec sameLine
|
|
mIndSp <- rec indented
|
|
return
|
|
$ [ VerticalSpacing lsp pspResult parFlagResult
|
|
| VerticalSpacing lsp mPsp _ <- mVs
|
|
, indSp <- mIndSp
|
|
, lineMax <- getMaxVS $ mIndSp
|
|
, let pspResult = case mPsp of
|
|
VerticalSpacingParSome psp -> VerticalSpacingParSome $ max psp lineMax
|
|
VerticalSpacingParNone -> VerticalSpacingParSome $ lineMax
|
|
VerticalSpacingParAlways psp -> VerticalSpacingParAlways $ max psp lineMax
|
|
, let parFlagResult = mPsp == VerticalSpacingParNone
|
|
&& _vs_paragraph indSp == VerticalSpacingParNone
|
|
&& _vs_parFlag indSp
|
|
]
|
|
BDFPar{} -> error "BDPar with indent in getSpacing"
|
|
BDFAlt [] -> error "empty BDAlt"
|
|
BDFAlt (alt:_) -> rec alt
|
|
BDFForceMultiline bd -> do
|
|
mVs <- rec bd
|
|
return $ mVs >>= _vs_paragraph .> \case
|
|
VerticalSpacingParNone -> LineModeInvalid
|
|
_ -> mVs
|
|
BDFForceSingleline bd -> do
|
|
mVs <- rec bd
|
|
return $ mVs >>= _vs_paragraph .> \case
|
|
VerticalSpacingParNone -> mVs
|
|
_ -> LineModeInvalid
|
|
BDFForwardLineMode bd -> rec bd
|
|
BDFExternal _ _ _ txt -> return $ LineModeValid $ case Text.lines txt of
|
|
[t] -> VerticalSpacing (Text.length t) VerticalSpacingParNone False
|
|
_ -> VerticalSpacing 999 VerticalSpacingParNone False
|
|
BDFPlain txt -> return $ LineModeValid $ case Text.lines txt of
|
|
[t] -> VerticalSpacing (Text.length t) VerticalSpacingParNone False
|
|
_ -> VerticalSpacing 999 VerticalSpacingParNone False
|
|
BDFAnnotationPrior _annKey bd -> rec bd
|
|
BDFAnnotationKW _annKey _kw bd -> rec bd
|
|
BDFAnnotationRest _annKey bd -> rec bd
|
|
BDFMoveToKWDP _annKey _kw _b bd -> rec bd
|
|
BDFLines [] -> return
|
|
$ LineModeValid
|
|
$ VerticalSpacing 0 VerticalSpacingParNone False
|
|
BDFLines ls@(_:_) -> do
|
|
lSps <- rec `mapM` ls
|
|
let (mVs:_) = lSps -- separated into let to avoid MonadFail
|
|
return $ [ VerticalSpacing lsp (VerticalSpacingParSome $ lineMax) False
|
|
| VerticalSpacing lsp _ _ <- mVs
|
|
, lineMax <- getMaxVS $ maxVs $ lSps
|
|
]
|
|
BDFEnsureIndent 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
|
|
BDFNonBottomSpacing b bd -> do
|
|
mVs <- rec bd
|
|
return
|
|
$ mVs
|
|
<|> LineModeValid
|
|
(VerticalSpacing
|
|
0
|
|
(if b then VerticalSpacingParSome 0
|
|
else VerticalSpacingParAlways colMax
|
|
)
|
|
False
|
|
)
|
|
BDFSetParSpacing bd -> do
|
|
mVs <- rec bd
|
|
return $ mVs <&> \vs -> vs { _vs_parFlag = True }
|
|
BDFForceParSpacing bd -> do
|
|
mVs <- rec bd
|
|
return $ [ vs | vs <- mVs, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone ]
|
|
BDFDebug s bd -> do
|
|
r <- rec bd
|
|
tellDebugMess $ "getSpacing: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): mVs=" ++ show r
|
|
return r
|
|
return result
|
|
maxVs :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
|
|
maxVs = foldl'
|
|
(liftM2 (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) ->
|
|
VerticalSpacing (max x1 y1) (case (x2, y2) of
|
|
(x, VerticalSpacingParNone) -> x
|
|
(VerticalSpacingParNone, x) -> x
|
|
(VerticalSpacingParAlways i, VerticalSpacingParAlways j) ->
|
|
VerticalSpacingParAlways $ max i j
|
|
(VerticalSpacingParAlways i, VerticalSpacingParSome j) ->
|
|
VerticalSpacingParAlways $ max i j
|
|
(VerticalSpacingParSome j, VerticalSpacingParAlways i) ->
|
|
VerticalSpacingParAlways $ max i j
|
|
(VerticalSpacingParSome x, VerticalSpacingParSome y) ->
|
|
VerticalSpacingParSome $ max x y) False))
|
|
(LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone 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
|
|
singleline (LineModeValid x) = _vs_paragraph x == VerticalSpacingParNone
|
|
singleline _ = False
|
|
isPar (LineModeValid x) = _vs_parFlag x
|
|
isPar _ = False
|
|
parFlag = case sps of
|
|
[] -> True
|
|
_ -> all singleline (List.init sps) && isPar (List.last sps)
|
|
initial = LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone parFlag
|
|
getMaxVS :: LineModeValidity VerticalSpacing -> LineModeValidity Int
|
|
getMaxVS = fmap $ \(VerticalSpacing x1 x2 _) -> x1 `max` case x2 of
|
|
VerticalSpacingParSome i -> i
|
|
VerticalSpacingParNone -> 0
|
|
VerticalSpacingParAlways i -> i
|
|
|
|
data SpecialCompare = Unequal | Smaller | Bigger
|
|
|
|
getSpacings
|
|
:: forall m
|
|
. (MonadMultiReader Config m, MonadMultiWriter (Seq String) m)
|
|
=> Int
|
|
-> BriDocNumbered
|
|
-> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing]
|
|
getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|
where
|
|
-- when we do `take K . filter someCondition` on a list of spacings, we
|
|
-- need to first (also) limit the size of the input list, otherwise a
|
|
-- _large_ input with a similarly _large_ prefix not passing our filtering
|
|
-- process could lead to exponential runtime behaviour.
|
|
-- TODO: 3 is arbitrary.
|
|
preFilterLimit :: [VerticalSpacing] -> [VerticalSpacing]
|
|
preFilterLimit = take (3*limit)
|
|
memoWithKey :: Memo.MonadMemo k v m1 => k -> m1 v -> m1 v
|
|
memoWithKey k v = Memo.memo (const v) k
|
|
rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing]
|
|
rec (brDcId, brdc) = memoWithKey brDcId $ do
|
|
config <- mAsk
|
|
let colMax = config & _conf_layout & _lconfig_cols & confUnpack
|
|
let hasOkColCount (VerticalSpacing lsp psp _) =
|
|
lsp <= colMax && case psp of
|
|
VerticalSpacingParNone -> True
|
|
VerticalSpacingParSome i -> i <= colMax
|
|
VerticalSpacingParAlways{} -> True
|
|
let specialCompare vs1 vs2 =
|
|
if ( (_vs_sameLine vs1 == _vs_sameLine vs2)
|
|
&& (_vs_parFlag vs1 == _vs_parFlag vs2)
|
|
)
|
|
then case (_vs_paragraph vs1, _vs_paragraph vs2) of
|
|
(VerticalSpacingParAlways i1, VerticalSpacingParAlways i2) ->
|
|
if i1 < i2 then Smaller else Bigger
|
|
(p1, p2) -> if p1 == p2 then Smaller else Unequal
|
|
else Unequal
|
|
let allowHangingQuasiQuotes =
|
|
config
|
|
& _conf_layout
|
|
& _lconfig_allowHangingQuasiQuotes
|
|
& confUnpack
|
|
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
|
|
-- smallest member of this "equal group".
|
|
specialNub :: [VerticalSpacing] -> [VerticalSpacing]
|
|
specialNub [] = []
|
|
specialNub (x1 : xr) = case go x1 xr of
|
|
(r, xs') -> r : specialNub xs'
|
|
where
|
|
go y1 [] = (y1, [])
|
|
go y1 (y2 : yr) = case specialCompare y1 y2 of
|
|
Unequal -> let (r, yr') = go y1 yr in (r, y2 : yr')
|
|
Smaller -> go y1 yr
|
|
Bigger -> go y2 yr
|
|
let -- the standard function used to enforce a constant upper bound
|
|
-- on the number of elements returned for each node. Should be
|
|
-- applied whenever in a parent the combination of spacings from
|
|
-- its children might cause excess of the upper bound.
|
|
filterAndLimit :: [VerticalSpacing] -> [VerticalSpacing]
|
|
filterAndLimit = take limit
|
|
-- prune so we always consider a constant
|
|
-- amount of spacings per node of the BriDoc.
|
|
. specialNub
|
|
-- In the end we want to know if there is at least
|
|
-- one valid spacing for any alternative.
|
|
-- If there are duplicates in the list, then these
|
|
-- will either all be valid (so having more than the
|
|
-- first is pointless) or all invalid (in which
|
|
-- case having any of them is pointless).
|
|
-- Nonetheless I think the order of spacings should
|
|
-- be preserved as it provides a deterministic
|
|
-- choice for which spacings to prune (which is
|
|
-- an argument against simply using a Set).
|
|
-- I have also considered `fmap head . group` which
|
|
-- seems to work similarly well for common cases
|
|
-- and which might behave even better when it comes
|
|
-- to determinism of the algorithm. But determinism
|
|
-- should not be overrated here either - in the end
|
|
-- this is about deterministic behaviour of the
|
|
-- pruning we do that potentially results in
|
|
-- non-optimal layouts, and we'd rather take optimal
|
|
-- layouts when we can than take non-optimal layouts
|
|
-- just to be consistent with other cases where
|
|
-- we'd choose non-optimal layouts.
|
|
. filter hasOkColCount
|
|
-- throw out any spacings (i.e. children) that
|
|
-- already use more columns than available in
|
|
-- total.
|
|
. preFilterLimit
|
|
result <- case brdc of
|
|
-- BDWrapAnnKey _annKey bd -> rec bd
|
|
BDFEmpty ->
|
|
return $ [VerticalSpacing 0 VerticalSpacingParNone False]
|
|
BDFLit t ->
|
|
return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
|
|
BDFSeq list ->
|
|
fmap sumVs . sequence . fmap filterAndLimit <$> rec `mapM` list
|
|
BDFCols _sig list ->
|
|
fmap sumVs . sequence . fmap filterAndLimit <$> rec `mapM` list
|
|
BDFSeparator ->
|
|
return $ [VerticalSpacing 1 VerticalSpacingParNone False]
|
|
BDFAddBaseY 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
|
|
}
|
|
BDFBaseYPushCur bd -> do
|
|
mVs <- rec bd
|
|
return $ mVs <&> \vs -> vs
|
|
-- We leave par as-is, even though it technically is not
|
|
-- accurate (in general).
|
|
-- the reason is that we really want to _keep_ it Just if it is
|
|
-- just so we properly communicate the is-multiline fact.
|
|
-- An alternative would be setting to (Just 0).
|
|
{ _vs_sameLine = max (_vs_sameLine vs)
|
|
(case _vs_paragraph vs of
|
|
VerticalSpacingParNone -> 0
|
|
VerticalSpacingParSome i -> i
|
|
VerticalSpacingParAlways i -> min colMax i)
|
|
, _vs_paragraph = case _vs_paragraph vs of
|
|
VerticalSpacingParNone -> VerticalSpacingParNone
|
|
VerticalSpacingParSome i -> VerticalSpacingParSome i
|
|
VerticalSpacingParAlways i -> VerticalSpacingParAlways i
|
|
}
|
|
BDFBaseYPop bd -> rec bd
|
|
BDFIndentLevelPushCur bd -> rec bd
|
|
BDFIndentLevelPop bd -> rec bd
|
|
BDFPar BrIndentNone sameLine indented -> do
|
|
mVss <- filterAndLimit <$> rec sameLine
|
|
indSps <- filterAndLimit <$> rec indented
|
|
let mVsIndSp = take limit
|
|
$ [ (x,y)
|
|
| x<-mVss
|
|
, y<-indSps
|
|
]
|
|
return $ mVsIndSp <&>
|
|
\(VerticalSpacing lsp mPsp _, indSp) ->
|
|
VerticalSpacing
|
|
lsp
|
|
(case mPsp of
|
|
VerticalSpacingParSome psp ->
|
|
VerticalSpacingParSome $ max psp $ getMaxVS indSp -- TODO
|
|
VerticalSpacingParNone -> spMakePar indSp
|
|
VerticalSpacingParAlways psp ->
|
|
VerticalSpacingParAlways $ max psp $ getMaxVS indSp)
|
|
( mPsp == VerticalSpacingParNone
|
|
&& _vs_paragraph indSp == VerticalSpacingParNone
|
|
&& _vs_parFlag indSp
|
|
)
|
|
|
|
BDFPar{} -> error "BDPar with indent in getSpacing"
|
|
BDFAlt [] -> error "empty BDAlt"
|
|
-- BDAlt (alt:_) -> rec alt
|
|
BDFAlt alts -> do
|
|
r <- rec `mapM` alts
|
|
return $ filterAndLimit =<< r
|
|
BDFForceMultiline bd -> do
|
|
mVs <- filterAndLimit <$> rec bd
|
|
return $ filter ((/=VerticalSpacingParNone) . _vs_paragraph) mVs
|
|
BDFForceSingleline bd -> do
|
|
mVs <- filterAndLimit <$> rec bd
|
|
return $ filter ((==VerticalSpacingParNone) . _vs_paragraph) mVs
|
|
BDFForwardLineMode bd -> rec bd
|
|
BDFExternal _ _ _ txt | [t] <- Text.lines txt ->
|
|
return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
|
|
BDFExternal{} ->
|
|
return $ [] -- yes, we just assume that we cannot properly layout
|
|
-- this.
|
|
BDFPlain 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
|
|
]
|
|
BDFAnnotationPrior _annKey bd -> rec bd
|
|
BDFAnnotationKW _annKey _kw bd -> rec bd
|
|
BDFAnnotationRest _annKey bd -> rec bd
|
|
BDFMoveToKWDP _annKey _kw _b bd -> rec bd
|
|
BDFLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
|
|
BDFLines 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
|
|
-- paragraph". That most importantly means that Lines should never
|
|
-- be inserted anywhere but at the start of the line. A
|
|
-- counterexample would be anything like Seq[Lit "foo", Lines].
|
|
lSpss <- map filterAndLimit <$> rec `mapM` ls
|
|
let worbled = fmap reverse
|
|
$ sequence
|
|
$ reverse
|
|
$ lSpss
|
|
sumF lSps@(lSp1:_) = VerticalSpacing (_vs_sameLine lSp1)
|
|
(spMakePar $ maxVs lSps)
|
|
False
|
|
sumF [] = error $ "should not happen. if my logic does not fail"
|
|
++ "me, this follows from not (null ls)."
|
|
return $ sumF <$> worbled
|
|
-- lSpss@(mVs:_) <- rec `mapM` ls
|
|
-- return $ case Control.Lens.transposeOf traverse lSpss of -- TODO: we currently only
|
|
-- -- consider the first alternative for the
|
|
-- -- line's spacings.
|
|
-- -- also i am not sure if always including
|
|
-- -- the first line length in the paragraph
|
|
-- -- length gives the desired results.
|
|
-- -- it is the safe path though, for now.
|
|
-- [] -> []
|
|
-- (lSps:_) -> mVs <&> \(VerticalSpacing lsp _) ->
|
|
-- VerticalSpacing lsp $ VerticalSpacingParSome $ getMaxVS $ maxVs lSps
|
|
BDFEnsureIndent 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 parFlag) ->
|
|
VerticalSpacing (lsp + addInd) psp parFlag
|
|
BDFNonBottomSpacing 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
|
|
-- problem but breaks certain other cases.
|
|
mVs <- rec bd
|
|
return $ if null mVs
|
|
then [VerticalSpacing
|
|
0
|
|
(if b then VerticalSpacingParSome 0
|
|
else VerticalSpacingParAlways colMax
|
|
)
|
|
False
|
|
]
|
|
else mVs <&> \vs -> vs
|
|
{ _vs_sameLine = min colMax (_vs_sameLine vs)
|
|
, _vs_paragraph = case _vs_paragraph vs of
|
|
VerticalSpacingParNone -> VerticalSpacingParNone
|
|
VerticalSpacingParAlways i
|
|
| b -> VerticalSpacingParSome 0
|
|
| otherwise -> VerticalSpacingParAlways i
|
|
VerticalSpacingParSome i
|
|
| b -> VerticalSpacingParSome 0
|
|
| otherwise -> VerticalSpacingParAlways i
|
|
}
|
|
-- the version below is an alternative idea: fold the input
|
|
-- spacings into a single spacing. This was hoped to improve in
|
|
-- certain cases where non-bottom alternatives took up "too much
|
|
-- explored search space"; the downside is that it also cuts
|
|
-- the search-space short in other cases where it is not necessary,
|
|
-- leading to unnecessary new-lines. Disabled for now. A better
|
|
-- solution would require conditionally folding the search-space
|
|
-- only in appropriate locations (i.e. a new BriDoc node type
|
|
-- for this purpose, perhaps "BDFNonBottomSpacing1").
|
|
-- else
|
|
-- [ Foldable.foldl1
|
|
-- (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) ->
|
|
-- VerticalSpacing
|
|
-- (min x1 y1)
|
|
-- (case (x2, y2) of
|
|
-- (x, VerticalSpacingParNone) -> x
|
|
-- (VerticalSpacingParNone, x) -> x
|
|
-- (VerticalSpacingParAlways i, VerticalSpacingParAlways j) ->
|
|
-- VerticalSpacingParAlways $ min i j
|
|
-- (VerticalSpacingParAlways i, VerticalSpacingParSome j) ->
|
|
-- VerticalSpacingParAlways $ min i j
|
|
-- (VerticalSpacingParSome i, VerticalSpacingParAlways j) ->
|
|
-- VerticalSpacingParAlways $ min i j
|
|
-- (VerticalSpacingParSome x, VerticalSpacingParSome y) ->
|
|
-- VerticalSpacingParSome $ min x y)
|
|
-- False)
|
|
-- mVs
|
|
-- ]
|
|
BDFSetParSpacing bd -> do
|
|
mVs <- rec bd
|
|
return $ mVs <&> \vs -> vs { _vs_parFlag = True }
|
|
BDFForceParSpacing bd -> do
|
|
mVs <- preFilterLimit <$> rec bd
|
|
return $ [ vs | vs <- mVs, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone ]
|
|
BDFDebug s bd -> do
|
|
r <- rec bd
|
|
tellDebugMess $ "getSpacings: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): vs=" ++ show (take 9 r)
|
|
return r
|
|
return result
|
|
maxVs :: [VerticalSpacing] -> VerticalSpacing
|
|
maxVs = foldl'
|
|
(\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) ->
|
|
VerticalSpacing
|
|
(max x1 y1)
|
|
(case (x2, y2) of
|
|
(x, VerticalSpacingParNone) -> x
|
|
(VerticalSpacingParNone, x) -> x
|
|
(VerticalSpacingParAlways i, VerticalSpacingParAlways j) ->
|
|
VerticalSpacingParAlways $ max i j
|
|
(VerticalSpacingParAlways i, VerticalSpacingParSome j) ->
|
|
VerticalSpacingParAlways $ max i j
|
|
(VerticalSpacingParSome i, VerticalSpacingParAlways j) ->
|
|
VerticalSpacingParAlways $ max i j
|
|
(VerticalSpacingParSome x, VerticalSpacingParSome y) ->
|
|
VerticalSpacingParSome $ max x y)
|
|
False)
|
|
(VerticalSpacing 0 VerticalSpacingParNone 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
|
|
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
|
|
getMaxVS :: VerticalSpacing -> Int
|
|
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
|
|
VerticalSpacingParSome i -> VerticalSpacingParSome $ x1 `max` i
|
|
VerticalSpacingParNone -> VerticalSpacingParSome $ x1
|
|
VerticalSpacingParAlways i -> VerticalSpacingParAlways $ x1 `max` i
|
|
|
|
fixIndentationForMultiple
|
|
:: (MonadMultiReader (CConfig Identity) m) => AltCurPos -> BrIndent -> m Int
|
|
fixIndentationForMultiple acp indent = do
|
|
indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
|
|
let indAddRaw = case indent of
|
|
BrIndentNone -> 0
|
|
BrIndentRegular -> indAmount
|
|
BrIndentSpecial i -> i
|
|
-- 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
|