content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MonadComprehensions #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeOperators #-}
  
  module Language.Haskell.Brittany.Internal.Transformations.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.Semigroup as Semigroup
  import qualified Data.Text as Text
  import qualified GHC.OldList as List
  import Language.Haskell.Brittany.Internal.Config.Types
  import Language.Haskell.Brittany.Internal.Prelude
  import Language.Haskell.Brittany.Internal.PreludeUtils
  import Language.Haskell.Brittany.Internal.Types
  import Language.Haskell.Brittany.Internal.Utils
  
  
  
  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)
                  )
              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 ])
              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 . mapM filterAndLimit <$> rec `mapM` list
        BDFCols _sig list -> fmap sumVs . mapM 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
  