{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Language.Haskell.Brittany.Internal.Transformations.T1_Alt where

import qualified Control.Monad.Memo as Memo
import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
import Data.HList.ContainsType
import qualified Data.List.Extra
import qualified Data.Text as Text
import qualified GHC.OldList as List
import qualified Data.Strict.Maybe as Strict

import Language.Haskell.Brittany.Internal.Config.Types
import Language.Haskell.Brittany.Internal.Prelude
import Language.Haskell.Brittany.Internal.Components.BriDoc
-- import Language.Haskell.Brittany.Internal.Utils



data VerticalSpacingPar
  = VerticalSpacingParNone -- no indented lines
  | VerticalSpacingParSome   Int -- indented lines, requiring this much
                                 -- vertical space at most
  | VerticalSpacingParAlways Int -- indented lines, requiring this much
                                 -- vertical space at most, but should
                                 -- be considered as having space for
                                 -- any spacing validity check.
    -- TODO: it might be wrong not to extend "always" to the none case, i.e.
    -- we might get better properties of spacing operators by having a
    -- product like (Normal|Always, None|Some Int).
  deriving (Eq, Show)

data VerticalSpacing
  = VerticalSpacing
    { _vs_sameLine       :: !Int
    , _vs_paragraph      :: !VerticalSpacingPar
    , _vs_parFlag        :: !Bool
    , _vs_onlyZeroAddInd :: !Bool
    }
  deriving (Eq, Show)

newtype LineModeValidity a = LineModeValidity (Strict.Maybe a)
  deriving (Functor, Applicative, Monad, Show, Alternative)

pattern LineModeValid :: forall t. t -> LineModeValidity t
pattern LineModeValid x = LineModeValidity (Strict.Just x) :: LineModeValidity t
pattern LineModeInvalid :: forall t. LineModeValidity t
pattern LineModeInvalid = LineModeValidity Strict.Nothing :: LineModeValidity t

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_indentPrepForced :: Bool
  , _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 False AltLineModeStateNone)
    . Memo.startEvalMemoT
    . fmap unwrapBriDocNumbered
    . go
 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 $ BDEmpty
    --         BDLit t           -> return $ BDLit t
    --         BDSeq list        -> BDSeq <$> go `mapM` list
    --         BDCols sig list   -> BDCols sig <$> go `mapM` list
    --         BDSeparator       -> return $ BDSeparator
    --         BDAddBaseY ind bd -> BDAddBaseY ind <$> go bd
    --         BDSetBaseY bd     -> BDSetBaseY <$> go bd
    --         BDSetIndentLevel bd     -> BDSetIndentLevel <$> go bd
    --         BDPar ind line indented -> [ BDPar ind line' indented'
    --                                    | line' <- go line
    --                                    , indented' <- go indented
    --                                    ]
    --         BDAlt alts              -> BDAlt <$> go `mapM` alts -- not that this will happen
    --         BDForceMultiline  bd    -> BDForceMultiline <$> go bd
    --         BDForceSingleline bd    -> BDForceSingleline <$> go bd
    --         BDForwardLineMode bd    -> BDForwardLineMode <$> go bd
    --         BDExternal k ks c t         -> return $ BDExternal k ks c t
    --         BDAnnotationPrior annKey bd -> BDAnnotationPrior annKey <$> go bd
    --         BDAnnotationPost  annKey bd -> BDAnnotationPost  annKey <$> go bd
    --         BDLines lines         -> BDLines <$> go `mapM` lines
    --         BDEnsureIndent ind bd -> BDEnsureIndent ind <$> go bd
    --         BDProhibitMTEL bd     -> BDProhibitMTEL <$> go bd



  go
    :: BriDocNumbered
    -> Memo.MemoT
         Int
         [VerticalSpacing]
         (MultiRWSS.MultiRWS r w (AltCurPos ': s))
         BriDocNumbered
  go 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 <$> go bd
      BDEmpty{} -> processSpacingSimple bdX $> bdX
      BDLit{} -> processSpacingSimple bdX $> bdX
      BDSeq list -> reWrap . BDSeq <$> list `forM` go
      BDCols sig list -> reWrap . BDCols sig <$> list `forM` go
      BDSeparator -> processSpacingSimple bdX $> bdX
      BDAddBaseY indent bd -> do
        acp <- mGet
        (indAdd, forced) <- fixIndentationForMultiple acp indent
        mSet $ acp
          { _acp_indentPrep = max (_acp_indentPrep acp) indAdd
          , _acp_indentPrepForced = forced || _acp_indentPrepForced acp
          }
        r <- go bd
        acp' <- mGet
        mSet $ acp' { _acp_indent = _acp_indent acp }
        return $ case indent of
          BrIndentNone -> r
          BrIndentRegular -> reWrap $ BDAddBaseY (BrIndentSpecial indAdd) r
          BrIndentRegularForce -> reWrap $ BDAddBaseY (BrIndentSpecial indAdd) r
          BrIndentSpecial i -> reWrap $ BDAddBaseY (BrIndentSpecial i) r
      BDBaseYPushCur bd -> do
        acp <- mGet
        mSet $ acp { _acp_indent = _acp_line acp }
        r <- go bd
        acp' <- mGet
        mSet $ acp' { _acp_indent = _acp_indent acp }
        return $ reWrap $ BDBaseYPushCur r
      BDEntryDelta dp bd -> do
        return $ reWrap $ BDEntryDelta dp bd
      BDIndentLevelPushCur bd -> do
        reWrap . BDIndentLevelPushCur <$> go bd
      BDIndentLevelPop bd -> do
        reWrap . BDIndentLevelPop <$> go bd
      BDPar indent sameLine indented -> do
        indAmount <-
          mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
        acp <- mGet
        let parentForced = _acp_indentPrepForced acp
        let
          (indAdd, forced) = case indent of
            BrIndentNone         -> (0        , parentForced)
            BrIndentRegular      -> (indAmount, parentForced)
            BrIndentRegularForce -> (indAmount, True )
            BrIndentSpecial i    -> (i        , parentForced)
        let ind = _acp_indent acp + _acp_indentPrep acp + indAdd
        mSet $ acp
          { _acp_indent = ind, _acp_indentPrep = 0
          , _acp_indentPrepForced = parentForced
          }
        sameLine' <- go sameLine
        mModify $ \acp' -> acp'
          { _acp_line = ind, _acp_indent = ind
          , _acp_indentPrepForced = forced
          }
        indented' <- go indented
        return $ reWrap $ BDPar indent sameLine' indented'
      BDAlt [] -> 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[].
      BDAlt alts -> do
        altChooser <- mAsk <&> _conf_layout .> _lconfig_altChooser .> confUnpack
        case altChooser of
          AltChooserSimpleQuick -> do
            go $ head alts
          AltChooserShallowBest -> do
            spacings <- alts `forM` getSpacing
            acp <- mGet
            let
              lineCheck LineModeInvalid = False
              lineCheck (LineModeValid (VerticalSpacing _ p _ z)) =
                let pRes = case _acp_forceMLFlag acp of
                      AltLineModeStateNone -> True
                      AltLineModeStateForceSL{} -> p == VerticalSpacingParNone
                      AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
                      AltLineModeStateContradiction -> False
                    zRes = not z || not (_acp_indentPrepForced acp)
                in pRes && zRes
              -- 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)
                )
            go
              $ 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 _ z) =
                let pRes = case _acp_forceMLFlag acp of
                      AltLineModeStateNone -> True
                      AltLineModeStateForceSL{} -> p == VerticalSpacingParNone
                      AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
                      AltLineModeStateContradiction -> False
                    zRes = not z || not (_acp_indentPrepForced acp)
                in pRes && zRes
            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 ])
            go
              $ fromMaybe (-- trace ("choosing last") $
                           List.last alts)
              $ Data.List.Extra.firstJust (fmap snd) checkedOptions
      BDForceAlt ForceMultiline bd -> do
        acp <- mGet
        mSet $ mergeLineMode acp (AltLineModeStateForceML False)
        x <- go bd
        mModify $ \acp' -> acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
        pure $ x
      BDForceAlt ForceSingleline bd -> do
        acp <- mGet
        mSet $ mergeLineMode acp AltLineModeStateForceSL
        x <- go bd
        mModify $ \acp' -> acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
        pure $ x
      BDForwardLineMode bd -> do
        acp <- mGet
        mSet $ acp
          { _acp_forceMLFlag = altLineModeRefresh $ _acp_forceMLFlag acp
          }
        x <- go bd
        mModify $ \acp' -> acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
        pure $ x
      BDForceAlt ForceZeroAdd bd -> go bd
      BDExternal{} -> processSpacingSimple bdX $> bdX
      BDPlain{} -> processSpacingSimple bdX $> bdX
      BDQueueComments comms bd ->
        reWrap . BDQueueComments comms <$> go bd
      BDFlushCommentsPrior loc bd ->
        -- TODO92 for AnnotationPrior we had this here:
        -- > acp <- mGet
        -- > mSet
        -- >   $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp }
        -- > bd' <- go bd
        -- not sure if the lineModeDecay is relevant any longer though..
        reWrap . BDFlushCommentsPrior loc <$> go bd
      BDFlushCommentsPost loc shouldMark bd ->
        reWrap . BDFlushCommentsPost loc shouldMark <$> go bd
      BDLines [] -> return $ reWrap BDEmpty -- evil transformation. or harmless.
      BDLines (l : lr) -> do
        initialAcp <- mGet
        l' <- go l
        lr' <- lr `forM` \x -> do
          mModify $ \acp -> acp
            { _acp_line = _acp_indent initialAcp
            , _acp_indent = _acp_indent initialAcp
            , _acp_indentPrepForced = _acp_indentPrepForced initialAcp
            }
          go x
        return $ reWrap $ BDLines (l' : lr')
      BDEnsureIndent indent bd -> do
        acp <- mGet
        (indAdd, forced) <- fixIndentationForMultiple acp indent
        mSet $ acp
          { _acp_indentPrep = 0
            -- TODO: i am not sure this is valid, in general.
          , _acp_indentPrepForced = forced
          , _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 BDEnsureIndents in the same line.
            -- Then, the actual indentation is relative to the current
            -- indentation, not the current cursor position.
          }
        r <- go bd
        acp' <- mGet
        mSet $ acp' { _acp_indent = _acp_indent acp }
        return $ case indent of
          BrIndentNone -> r
          BrIndentRegular ->
            reWrap $ BDEnsureIndent (BrIndentSpecial indAdd) r
          BrIndentRegularForce ->
            reWrap $ BDEnsureIndent (BrIndentSpecial indAdd) r
          BrIndentSpecial i -> reWrap $ BDEnsureIndent (BrIndentSpecial i) r
      BDForceAlt (NonBottomSpacing _) bd -> go bd
      BDForceAlt SetParSpacing bd -> go bd
      BDForceAlt ForceParSpacing bd -> go bd
      BDDebug s bd -> do
        acp :: AltCurPos <- mGet
        tellDebugMess
          $ "transformAlts: BDDEBUG "
          ++ s
          ++ " (node-id="
          ++ show brDcId
          ++ "): acp="
          ++ show acp
        reWrap . BDDebug s <$> go 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 = go bridoc
 where
  go :: BriDocNumbered -> m (LineModeValidity VerticalSpacing)
  go (brDcId, brDc) = do
    config <- mAsk
    let colMax = config & _conf_layout & _lconfig_cols & confUnpack
    let indAmount = confUnpack $ _lconfig_indentAmount $ _conf_layout $ config
    result :: LineModeValidity VerticalSpacing <- case brDc of
      -- BDWrapAnnKey _annKey bd -> go bd
      BDEmpty ->
        pure
          $ LineModeValid
          $ VerticalSpacing 0 VerticalSpacingParNone False False
      BDLit t ->
        pure
          $ LineModeValid
          $ VerticalSpacing (Text.length t) VerticalSpacingParNone False False
      BDSeq list -> sumVs <$> go `mapM` list
      BDCols _sig list -> sumVs <$> go `mapM` list
      BDSeparator ->
        pure
          $ LineModeValid
          $ VerticalSpacing 1 VerticalSpacingParNone False False
      BDAddBaseY indent bd -> do
        mVs <- go bd
        pure
          [ vs
            { _vs_paragraph = case _vs_paragraph vs of
              VerticalSpacingParNone -> VerticalSpacingParNone
              VerticalSpacingParAlways i ->
                VerticalSpacingParAlways $ case indent of
                  BrIndentNone -> i
                  BrIndentRegular -> i + indAmount
                  BrIndentRegularForce -> i + indAmount
                  BrIndentSpecial j -> i + j
              VerticalSpacingParSome i ->
                VerticalSpacingParSome $ case indent of
                  BrIndentNone -> i
                  BrIndentRegular -> i + indAmount
                  BrIndentRegularForce -> i + indAmount
                  BrIndentSpecial j -> i + j
            }
          | vs <- mVs
          , indent == BrIndentNone || _vs_onlyZeroAddInd vs == False
          ]
      BDBaseYPushCur bd -> do
        mVs <- go 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
          }
      BDIndentLevelPushCur bd -> go bd
      BDIndentLevelPop bd -> go bd
      BDPar BrIndentNone sameLine indented -> do
        mVs <- go sameLine
        mIndSp <- go indented
        return
          $ [ VerticalSpacing lsp pspResult parFlagResult False -- TODO92 should we turn this on?
            | 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
            ]
      BDPar{} -> error "BDPar with indent in getSpacing"
      BDAlt [] -> error "empty BDAlt"
      BDAlt (alt : _) -> go alt
      BDForceAlt ForceMultiline bd -> do
        mVs <- go bd
        return $ mVs >>= _vs_paragraph .> \case
          VerticalSpacingParNone -> LineModeInvalid
          _ -> mVs
      BDForceAlt ForceSingleline bd -> do
        mVs <- go bd
        return $ mVs >>= _vs_paragraph .> \case
          VerticalSpacingParNone -> mVs
          _ -> LineModeInvalid
      BDForceAlt ForceZeroAdd bd -> do
        mVs <- go bd
        pure $ [ vs { _vs_onlyZeroAddInd = True } | vs <- mVs ]
      BDForwardLineMode bd -> go bd
      BDExternal _ txt -> return $ LineModeValid $ case Text.lines txt of
        [t] ->
          VerticalSpacing (Text.length t) VerticalSpacingParNone False False
        _ -> VerticalSpacing 999 VerticalSpacingParNone False False
      BDPlain txt -> return $ LineModeValid $ case Text.lines txt of
        [t] ->
          VerticalSpacing (Text.length t) VerticalSpacingParNone False False
        _ -> VerticalSpacing 999 VerticalSpacingParNone False False
      BDQueueComments _comms bd -> go bd
      BDFlushCommentsPrior _loc bd -> go bd
      BDFlushCommentsPost _loc _shouldMark bd -> go bd
      BDEntryDelta _dp bd -> go bd
      BDLines [] ->
        pure
          $ LineModeValid
          $ VerticalSpacing 0 VerticalSpacingParNone False False
          -- TODO92 should we set _vs_onlyZeroAddInd here too?
          --        did not do that before, but it makes sense for lines..
      BDLines (l1 : lR) -> do
        mVs <- go l1
        mVRs <- go `mapM` lR
        let lSps = mVs : mVRs
        return
          $ [ VerticalSpacing lsp (VerticalSpacingParSome $ lineMax) False False
              -- TODO92 should we set _vs_onlyZeroAddInd here too?
              --        did not do that before, but it makes sense for lines..
            | VerticalSpacing lsp _ _ _ <- mVs
            , lineMax <- getMaxVS $ maxVs $ lSps
            ]
      BDEnsureIndent indent bd -> do
        mVs <- go bd
        let addInd = case indent of
              BrIndentNone -> 0
              BrIndentRegular -> indAmount
              BrIndentRegularForce -> indAmount
              BrIndentSpecial i -> i
        return $ mVs <&> \(VerticalSpacing lsp psp pf _) ->
          VerticalSpacing (lsp + addInd) psp pf False
      BDForceAlt (NonBottomSpacing b) bd -> do
        mVs <- go bd
        return $ mVs <|> LineModeValid
          (VerticalSpacing
            0
            (if b
              then VerticalSpacingParSome 0
              else VerticalSpacingParAlways colMax
            )
            False
            False
          )
      BDForceAlt SetParSpacing bd -> do
        mVs <- go bd
        return $ mVs <&> \vs -> vs { _vs_parFlag = True }
      BDForceAlt ForceParSpacing bd -> do
        mVs <- go bd
        return
          $ [ vs
            | vs <- mVs
            , _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone
            ]
      BDDebug s bd -> do
        r <- go bd
        tellDebugMess
          $ "getSpacing: BDDebug "
          ++ show s
          ++ " (node-id="
          ++ show brDcId
          ++ "): mVs="
          ++ show r
        return r
    pure 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
        False
      )
    )
    (LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False False)
  sumVs
    :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
  sumVs sps = foldl' (liftM2 goSum) initial sps
   where
    goSum (VerticalSpacing x1 x2 x3 x4) (VerticalSpacing y1 y2 _ y4) =
      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
        (x4 || y4)
    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 False
  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 <$> go 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
  go :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing]
  go (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 indAmount = confUnpack $ _lconfig_indentAmount $ _conf_layout $ config
    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 goNub x1 xr of
        (r, xs') -> r : specialNub xs'
       where
        goNub y1 [] = (y1, [])
        goNub y1 (y2 : yr) = case specialCompare y1 y2 of
          Unequal -> let (r, yr') = goNub y1 yr in (r, y2 : yr')
          Smaller -> goNub y1 yr
          Bigger -> goNub 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 -> go bd
      BDEmpty -> return $ [VerticalSpacing 0 VerticalSpacingParNone False False]
      BDLit t -> do
        let l = Text.length t
        pure $ [VerticalSpacing l VerticalSpacingParNone False False]
      BDSeq list -> fmap sumVs . mapM filterAndLimit <$> go `mapM` list
      BDCols _sig list -> fmap sumVs . mapM filterAndLimit <$> go `mapM` list
      BDSeparator ->
        pure $ [VerticalSpacing 1 VerticalSpacingParNone False False]
      BDAddBaseY indent bd -> do
        mVs <- go bd
        return $ mVs <&> \vs -> vs
          { _vs_paragraph = case _vs_paragraph vs of
            VerticalSpacingParNone -> VerticalSpacingParNone
            VerticalSpacingParAlways i ->
              VerticalSpacingParAlways $ case indent of
                BrIndentNone -> i
                BrIndentRegular -> i + indAmount
                BrIndentRegularForce -> i + indAmount
                BrIndentSpecial j -> i + j
            VerticalSpacingParSome i -> VerticalSpacingParSome $ case indent of
              BrIndentNone -> i
              BrIndentRegular -> i + indAmount
              BrIndentRegularForce -> i + indAmount
              BrIndentSpecial j -> i + j
          }
      BDBaseYPushCur bd -> do
        mVs <- go 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
          }
      BDIndentLevelPushCur bd -> go bd
      BDIndentLevelPop bd -> go bd
      BDPar BrIndentNone sameLine indented -> do
        mVss <- filterAndLimit <$> go sameLine
        indSps <- filterAndLimit <$> go 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
            )
            False -- TODO92 should we turn this on?

      BDPar{} -> error "BDPar with indent in getSpacing"
      BDAlt [] -> error "empty BDAlt"
      -- BDAlt (alt:_) -> go alt
      BDAlt alts -> do
        r <- go `mapM` alts
        return $ filterAndLimit =<< r
      BDForceAlt ForceMultiline bd -> do
        mVs <- filterAndLimit <$> go bd
        return $ filter ((/= VerticalSpacingParNone) . _vs_paragraph) mVs
      BDForceAlt ForceSingleline bd -> do
        mVs <- filterAndLimit <$> go bd
        return $ filter ((== VerticalSpacingParNone) . _vs_paragraph) mVs
      BDForwardLineMode bd -> go bd
      BDExternal _ txt | [t] <- Text.lines txt -> do
        let l = Text.length t
        pure $ [VerticalSpacing l VerticalSpacingParNone False False]
      BDExternal{} -> return $ [] -- yes, we just assume that we cannot properly layout
                    -- this.
      BDPlain t -> do
        let tl = Text.length
        pure
          [ case Text.lines t of
              [] -> VerticalSpacing 0 VerticalSpacingParNone False False
              [t1] ->
                VerticalSpacing (tl t1) VerticalSpacingParNone False False
              (t1 : _) ->
                VerticalSpacing (tl t1) (VerticalSpacingParAlways 0) True False
          | allowHangingQuasiQuotes
          ]
      BDQueueComments _comms bd -> go bd
      BDFlushCommentsPrior _loc bd -> go bd
      BDFlushCommentsPost _loc _shouldMark bd -> go bd
      BDEntryDelta _dp bd -> go bd
      BDLines [] ->
        pure $ [VerticalSpacing 0 VerticalSpacingParNone False False]
      BDLines 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 <- mapM (fmap filterAndLimit . go) ls
        let
          worbled = sequence $ case lSpss of
            [] -> []
            [x] -> [x]
            (x1:xR) -> x1 : map reverse xR
          sumF lSps@(lSp1 : _) =
            VerticalSpacing (_vs_sameLine lSp1)
                            (spMakePar $ maxVs lSps)
                            False
                            False -- TODO92
          sumF [] =
            error
              $ "should not happen. if my logic does not fail"
              ++ "me, this follows from not (null ls)."
        return $ sumF <$> worbled
        -- lSpss@(mVs:_) <- go `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
      BDEnsureIndent indent bd -> do
        mVs <- go bd
        let
          addInd = case indent of
            BrIndentNone -> 0
            BrIndentRegular -> indAmount
            BrIndentRegularForce -> indAmount
            BrIndentSpecial i -> i
        return $ mVs <&> \(VerticalSpacing lsp psp parFlag _) ->
          VerticalSpacing (lsp + addInd) psp parFlag False
      BDForceAlt (NonBottomSpacing 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 <- go bd
        return $ if null mVs
          then
            [ VerticalSpacing
                0
                (if b
                  then VerticalSpacingParSome 0
                  else VerticalSpacingParAlways colMax
                )
                False
                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 "BDNonBottomSpacing1").
          -- 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
          --   ]
      BDForceAlt SetParSpacing bd -> do
        mVs <- go bd
        return $ mVs <&> \vs -> vs { _vs_parFlag = True }
      BDForceAlt ForceParSpacing bd -> do
        mVs <- preFilterLimit <$> go bd
        return
          $ [ vs
            | vs <- mVs
            , _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone
            ]
      BDForceAlt ForceZeroAdd bd -> do
        mVs <- preFilterLimit <$> go bd
        pure [ vs { _vs_onlyZeroAddInd = True } | vs <- mVs ]
      BDDebug s bd -> do
        r <- go bd
        tellDebugMess
          $ "getSpacings: BDDebug "
          ++ 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
      False
    )
    (VerticalSpacing 0 VerticalSpacingParNone False False)
  sumVs :: [VerticalSpacing] -> VerticalSpacing
  sumVs sps = foldl' goSum initial sps
   where
    goSum (VerticalSpacing x1 x2 x3 x4) (VerticalSpacing y1 y2 _ y4) =
      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
        (x4 || y4)
    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 False
  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, Bool)
fixIndentationForMultiple acp indent = do
  indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
  let
    (indAddRaw, strongFlag) = case indent of
      BrIndentNone -> (0, False)
      BrIndentRegular -> (indAmount, False)
      BrIndentRegularForce -> (indAmount, True)
      BrIndentSpecial i -> (i, False)
  -- 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
      , strongFlag
      )
