#define INSERTTRACESALT 0
#define INSERTTRACESALTVISIT 0
#define INSERTTRACESGETSPACING 0

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}

module Language.Haskell.Brittany.Internal.Transformations.Alt
  ( transformAlts
  )
where



#include "prelude.inc"

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
  { AltCurPos -> Int
_acp_line :: Int -- chars in the current line
  , AltCurPos -> Int
_acp_indent :: Int -- current indentation level
  , AltCurPos -> Int
_acp_indentPrep :: Int -- indentChange affecting the next Par
  , AltCurPos -> AltLineModeState
_acp_forceMLFlag :: AltLineModeState
  }
  deriving (Int -> AltCurPos -> ShowS
[AltCurPos] -> ShowS
AltCurPos -> String
(Int -> AltCurPos -> ShowS)
-> (AltCurPos -> String)
-> ([AltCurPos] -> ShowS)
-> Show AltCurPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AltCurPos] -> ShowS
$cshowList :: [AltCurPos] -> ShowS
show :: AltCurPos -> String
$cshow :: AltCurPos -> String
showsPrec :: Int -> AltCurPos -> ShowS
$cshowsPrec :: Int -> AltCurPos -> ShowS
Show)

data AltLineModeState
  = AltLineModeStateNone
  | AltLineModeStateForceML Bool -- true ~ decays on next wrap
  | AltLineModeStateForceSL
  | AltLineModeStateContradiction
  -- i.e. ForceX False -> ForceX True -> None
  deriving (Int -> AltLineModeState -> ShowS
[AltLineModeState] -> ShowS
AltLineModeState -> String
(Int -> AltLineModeState -> ShowS)
-> (AltLineModeState -> String)
-> ([AltLineModeState] -> ShowS)
-> Show AltLineModeState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AltLineModeState] -> ShowS
$cshowList :: [AltLineModeState] -> ShowS
show :: AltLineModeState -> String
$cshow :: AltLineModeState -> String
showsPrec :: Int -> AltLineModeState -> ShowS
$cshowsPrec :: Int -> AltLineModeState -> ShowS
Show)

altLineModeRefresh :: AltLineModeState -> AltLineModeState
altLineModeRefresh :: AltLineModeState -> AltLineModeState
altLineModeRefresh AltLineModeState
AltLineModeStateNone          = AltLineModeState
AltLineModeStateNone
altLineModeRefresh AltLineModeStateForceML{}     = Bool -> AltLineModeState
AltLineModeStateForceML Bool
False
altLineModeRefresh AltLineModeState
AltLineModeStateForceSL       = AltLineModeState
AltLineModeStateForceSL
altLineModeRefresh AltLineModeState
AltLineModeStateContradiction = AltLineModeState
AltLineModeStateContradiction

altLineModeDecay :: AltLineModeState -> AltLineModeState
altLineModeDecay :: AltLineModeState -> AltLineModeState
altLineModeDecay AltLineModeState
AltLineModeStateNone            = AltLineModeState
AltLineModeStateNone
altLineModeDecay (AltLineModeStateForceML Bool
False) = Bool -> AltLineModeState
AltLineModeStateForceML Bool
True
altLineModeDecay (AltLineModeStateForceML Bool
True ) = AltLineModeState
AltLineModeStateNone
altLineModeDecay AltLineModeState
AltLineModeStateForceSL         = AltLineModeState
AltLineModeStateForceSL
altLineModeDecay AltLineModeState
AltLineModeStateContradiction   = AltLineModeState
AltLineModeStateContradiction

mergeLineMode :: AltCurPos -> AltLineModeState -> AltCurPos
mergeLineMode :: AltCurPos -> AltLineModeState -> AltCurPos
mergeLineMode AltCurPos
acp AltLineModeState
s = case (AltCurPos -> AltLineModeState
_acp_forceMLFlag AltCurPos
acp, AltLineModeState
s) of
  (AltLineModeState
AltLineModeStateContradiction, AltLineModeState
_) -> AltCurPos
acp
  (AltLineModeState
AltLineModeStateNone, AltLineModeState
x) -> AltCurPos
acp { _acp_forceMLFlag :: AltLineModeState
_acp_forceMLFlag = AltLineModeState
x }
  (AltLineModeState
AltLineModeStateForceSL, AltLineModeState
AltLineModeStateForceSL) -> AltCurPos
acp
  (AltLineModeStateForceML{}, AltLineModeStateForceML{}) ->
    AltCurPos
acp { _acp_forceMLFlag :: AltLineModeState
_acp_forceMLFlag = AltLineModeState
s }
  (AltLineModeState, AltLineModeState)
_ -> AltCurPos
acp { _acp_forceMLFlag :: AltLineModeState
_acp_forceMLFlag = AltLineModeState
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 :: BriDocNumbered -> MultiRWS r w s BriDoc
transformAlts =
  AltCurPos
-> MultiRWST r w (AltCurPos : s) Identity BriDoc
-> MultiRWS r w s BriDoc
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m a
MultiRWSS.withMultiStateA (Int -> Int -> Int -> AltLineModeState -> AltCurPos
AltCurPos Int
0 Int
0 Int
0 AltLineModeState
AltLineModeStateNone)
    (MultiRWST r w (AltCurPos : s) Identity BriDoc
 -> MultiRWS r w s BriDoc)
-> (BriDocNumbered
    -> MultiRWST r w (AltCurPos : s) Identity BriDoc)
-> BriDocNumbered
-> MultiRWS r w s BriDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoT Int [VerticalSpacing] (MultiRWS r w (AltCurPos : s)) BriDoc
-> MultiRWST r w (AltCurPos : s) Identity BriDoc
forall (m :: * -> *) k v a. Monad m => MemoT k v m a -> m a
Memo.startEvalMemoT
    (MemoT Int [VerticalSpacing] (MultiRWS r w (AltCurPos : s)) BriDoc
 -> MultiRWST r w (AltCurPos : s) Identity BriDoc)
-> (BriDocNumbered
    -> MemoT
         Int [VerticalSpacing] (MultiRWS r w (AltCurPos : s)) BriDoc)
-> BriDocNumbered
-> MultiRWST r w (AltCurPos : s) Identity BriDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BriDocNumbered -> BriDoc)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
-> MemoT
     Int [VerticalSpacing] (MultiRWS r w (AltCurPos : s)) BriDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BriDocNumbered -> BriDoc
unwrapBriDocNumbered
    (StateCache
   (Container (Map Int [VerticalSpacing]))
   (MultiRWS r w (AltCurPos : s))
   BriDocNumbered
 -> MemoT
      Int [VerticalSpacing] (MultiRWS r w (AltCurPos : s)) BriDoc)
-> (BriDocNumbered
    -> StateCache
         (Container (Map Int [VerticalSpacing]))
         (MultiRWS r w (AltCurPos : s))
         BriDocNumbered)
-> BriDocNumbered
-> MemoT
     Int [VerticalSpacing] (MultiRWS r w (AltCurPos : s)) BriDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
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 :: BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec bdX :: BriDocNumbered
bdX@(Int
brDcId, BriDocFInt
brDc) = do
#if INSERTTRACESALTVISIT
      do
        acp :: AltCurPos <- mGet
        tellDebugMess $ "transformAlts: visiting: " ++ case brDc of
          BDFAnnotationPrior annKey _ -> show (toConstr brDc, annKey, acp)
          BDFAnnotationRest annKey _ -> show (toConstr brDc, annKey, acp)
          _ -> show (toConstr brDc, acp)
#endif
      let reWrap :: BriDocFInt -> BriDocNumbered
reWrap = (,) Int
brDcId
      -- debugAcp :: AltCurPos <- mGet
      case BriDocFInt
brDc of
        -- BDWrapAnnKey annKey bd -> do
        --   acp <- mGet
        --   mSet $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp }
        --   BDWrapAnnKey annKey <$> rec bd
        BDFEmpty{}    -> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiState AltCurPos m,
 MonadMultiWriter (Seq String) m) =>
BriDocNumbered -> m ()
processSpacingSimple BriDocNumbered
bdX StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  ()
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BriDocNumbered
bdX
        BDFLit{}      -> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiState AltCurPos m,
 MonadMultiWriter (Seq String) m) =>
BriDocNumbered -> m ()
processSpacingSimple BriDocNumbered
bdX StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  ()
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BriDocNumbered
bdX
        BDFSeq [BriDocNumbered]
list      ->
          BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered)
-> ([BriDocNumbered] -> BriDocFInt)
-> [BriDocNumbered]
-> BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BriDocNumbered] -> BriDocFInt
forall (f :: * -> *). [f (BriDocF f)] -> BriDocF f
BDFSeq ([BriDocNumbered] -> BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     [BriDocNumbered]
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BriDocNumbered]
list [BriDocNumbered]
-> (BriDocNumbered
    -> StateCache
         (Container (Map Int [VerticalSpacing]))
         (MultiRWS r w (AltCurPos : s))
         BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     [BriDocNumbered]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec
        BDFCols ColSig
sig [BriDocNumbered]
list ->
          BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered)
-> ([BriDocNumbered] -> BriDocFInt)
-> [BriDocNumbered]
-> BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColSig -> [BriDocNumbered] -> BriDocFInt
forall (f :: * -> *). ColSig -> [f (BriDocF f)] -> BriDocF f
BDFCols ColSig
sig ([BriDocNumbered] -> BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     [BriDocNumbered]
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BriDocNumbered]
list [BriDocNumbered]
-> (BriDocNumbered
    -> StateCache
         (Container (Map Int [VerticalSpacing]))
         (MultiRWS r w (AltCurPos : s))
         BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     [BriDocNumbered]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec
        BriDocFInt
BDFSeparator  -> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiState AltCurPos m,
 MonadMultiWriter (Seq String) m) =>
BriDocNumbered -> m ()
processSpacingSimple BriDocNumbered
bdX StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  ()
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BriDocNumbered
bdX
        BDFAddBaseY BrIndent
indent BriDocNumbered
bd -> do
          AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          Int
indAdd <- AltCurPos
-> BrIndent
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     Int
forall (m :: * -> *).
MonadMultiReader Config m =>
AltCurPos -> BrIndent -> m Int
fixIndentationForMultiple AltCurPos
acp BrIndent
indent
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp { _acp_indentPrep :: Int
_acp_indentPrep = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (AltCurPos -> Int
_acp_indentPrep AltCurPos
acp) Int
indAdd }
          BriDocNumbered
r <- BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
          AltCurPos
acp' <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp' { _acp_indent :: Int
_acp_indent = AltCurPos -> Int
_acp_indent AltCurPos
acp }
          BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ case BrIndent
indent of
            BrIndent
BrIndentNone -> BriDocNumbered
r
            BrIndent
BrIndentRegular ->   BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BrIndent -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). BrIndent -> f (BriDocF f) -> BriDocF f
BDFAddBaseY (Int -> BrIndent
BrIndentSpecial Int
indAdd) BriDocNumbered
r
            BrIndentSpecial Int
i -> BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BrIndent -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). BrIndent -> f (BriDocF f) -> BriDocF f
BDFAddBaseY (Int -> BrIndent
BrIndentSpecial Int
i) BriDocNumbered
r
        BDFBaseYPushCur BriDocNumbered
bd -> do
          AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp { _acp_indent :: Int
_acp_indent = AltCurPos -> Int
_acp_line AltCurPos
acp }
          BriDocNumbered
r <- BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
          BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFBaseYPushCur BriDocNumbered
r
        BDFBaseYPop BriDocNumbered
bd -> do
          AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          BriDocNumbered
r <- BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
          AltCurPos
acp' <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp' { _acp_indent :: Int
_acp_indent = AltCurPos -> Int
_acp_indentPrep AltCurPos
acp }
          BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFBaseYPop BriDocNumbered
r
        BDFIndentLevelPushCur BriDocNumbered
bd -> do
          BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFIndentLevelPushCur (BriDocNumbered -> BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
        BDFIndentLevelPop BriDocNumbered
bd -> do
          BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BriDocNumbered -> BriDocFInt
forall (f :: * -> *). f (BriDocF f) -> BriDocF f
BDFIndentLevelPop (BriDocNumbered -> BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
        BDFPar BrIndent
indent BriDocNumbered
sameLine BriDocNumbered
indented -> do
          Int
indAmount <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  Config
-> (Config -> Int)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout (Config -> CLayoutConfig Identity)
-> (CLayoutConfig Identity -> Identity (Last Int))
-> Config
-> Identity (Last Int)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_indentAmount (Config -> Identity (Last Int))
-> (Identity (Last Int) -> Int) -> Config -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
          let indAdd :: Int
indAdd = case BrIndent
indent of
                BrIndent
BrIndentNone -> Int
0
                BrIndent
BrIndentRegular -> Int
indAmount
                BrIndentSpecial Int
i -> Int
i
          AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          let ind :: Int
ind = AltCurPos -> Int
_acp_indent AltCurPos
acp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AltCurPos -> Int
_acp_indentPrep AltCurPos
acp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indAdd
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp
            { _acp_indent :: Int
_acp_indent = Int
ind
            , _acp_indentPrep :: Int
_acp_indentPrep = Int
0
            }
          BriDocNumbered
sameLine' <- BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
sameLine
          (AltCurPos -> AltCurPos)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((AltCurPos -> AltCurPos)
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> (AltCurPos -> AltCurPos)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ \AltCurPos
acp' -> AltCurPos
acp'
            { _acp_line :: Int
_acp_line   = Int
ind
            , _acp_indent :: Int
_acp_indent = Int
ind
            }
          BriDocNumbered
indented' <- BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
indented
          BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BrIndent -> BriDocNumbered -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *).
BrIndent -> f (BriDocF f) -> f (BriDocF f) -> BriDocF f
BDFPar BrIndent
indent BriDocNumbered
sameLine' BriDocNumbered
indented'
        BDFAlt [] -> String
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a. HasCallStack => String -> a
error String
"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 [BriDocNumbered]
alts -> do
          AltChooser
altChooser <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  Config
-> (Config -> AltChooser)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     AltChooser
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout (Config -> CLayoutConfig Identity)
-> (CLayoutConfig Identity -> Identity (Last AltChooser))
-> Config
-> Identity (Last AltChooser)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> CLayoutConfig Identity -> Identity (Last AltChooser)
forall (f :: * -> *). CLayoutConfig f -> f (Last AltChooser)
_lconfig_altChooser (Config -> Identity (Last AltChooser))
-> (Identity (Last AltChooser) -> AltChooser)
-> Config
-> AltChooser
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Identity (Last AltChooser) -> AltChooser
forall a b. Coercible a b => Identity a -> b
confUnpack
          case AltChooser
altChooser of
            AltChooser
AltChooserSimpleQuick -> do
              BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ [BriDocNumbered] -> BriDocNumbered
forall a. [a] -> a
head [BriDocNumbered]
alts
            AltChooser
AltChooserShallowBest -> do
              [LineModeValidity VerticalSpacing]
spacings <- [BriDocNumbered]
alts [BriDocNumbered]
-> (BriDocNumbered
    -> StateCache
         (Container (Map Int [VerticalSpacing]))
         (MultiRWS r w (AltCurPos : s))
         (LineModeValidity VerticalSpacing))
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     [LineModeValidity VerticalSpacing]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     (LineModeValidity VerticalSpacing)
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiWriter (Seq String) m) =>
BriDocNumbered -> m (LineModeValidity VerticalSpacing)
getSpacing
              AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
              let lineCheck :: LineModeValidity VerticalSpacing -> Bool
lineCheck LineModeValidity VerticalSpacing
LineModeInvalid = Bool
False
                  lineCheck (LineModeValid (VerticalSpacing Int
_ VerticalSpacingPar
p Bool
_)) =
                    case AltCurPos -> AltLineModeState
_acp_forceMLFlag AltCurPos
acp of
                      AltLineModeState
AltLineModeStateNone      -> Bool
True
                      AltLineModeStateForceSL{} -> VerticalSpacingPar
p VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacingPar
VerticalSpacingParNone
                      AltLineModeStateForceML{} -> VerticalSpacingPar
p VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
/= VerticalSpacingPar
VerticalSpacingParNone
                      AltLineModeState
AltLineModeStateContradiction -> Bool
False
                  -- TODO: use COMPLETE pragma instead?
                  lineCheck LineModeValidity VerticalSpacing
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"ghc exhaustive check is insufficient"
              CLayoutConfig Identity
lconf <- Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout (Config -> CLayoutConfig Identity)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     Config
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     (CLayoutConfig Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
#if INSERTTRACESALT
              tellDebugMess $ "considering options with " ++ show (length alts, acp)
#endif
              let options :: [(Bool, BriDocNumbered)]
options = -- trace ("considering options:" ++ show (length alts, acp)) $
                            ([LineModeValidity VerticalSpacing]
-> [BriDocNumbered]
-> [(LineModeValidity VerticalSpacing, BriDocNumbered)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LineModeValidity VerticalSpacing]
spacings [BriDocNumbered]
alts
                             [(LineModeValidity VerticalSpacing, BriDocNumbered)]
-> ((LineModeValidity VerticalSpacing, BriDocNumbered)
    -> (Bool, BriDocNumbered))
-> [(Bool, BriDocNumbered)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(LineModeValidity VerticalSpacing
vs, BriDocNumbered
bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs))
                               ( CLayoutConfig Identity
-> AltCurPos -> LineModeValidity VerticalSpacing -> Bool
hasSpace1 CLayoutConfig Identity
lconf AltCurPos
acp LineModeValidity VerticalSpacing
vs Bool -> Bool -> Bool
&& LineModeValidity VerticalSpacing -> Bool
lineCheck LineModeValidity VerticalSpacing
vs, BriDocNumbered
bd))
#if INSERTTRACESALT
              zip spacings options `forM_` \(vs, (_, bd)) ->
                tellDebugMess $ "  " ++ "spacing=" ++ show vs
                             ++ ",hasSpace1=" ++ show (hasSpace1 lconf acp vs)
                             ++ ",lineCheck=" ++ show (lineCheck vs)
                             ++ " " ++ show (toConstr bd)
#endif
              StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a. a -> a
id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x)
                 (StateCache
   (Container (Map Int [VerticalSpacing]))
   (MultiRWS r w (AltCurPos : s))
   BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec
                 (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> Maybe BriDocNumbered -> BriDocNumbered
forall a. a -> Maybe a -> a
fromMaybe (-- trace ("choosing last") $
                              [BriDocNumbered] -> BriDocNumbered
forall a. [a] -> a
List.last [BriDocNumbered]
alts)
                 (Maybe BriDocNumbered -> BriDocNumbered)
-> Maybe BriDocNumbered -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ ((Int, (Bool, BriDocNumbered)) -> Maybe BriDocNumbered)
-> [(Int, (Bool, BriDocNumbered))] -> Maybe BriDocNumbered
forall a b. (a -> Maybe b) -> [a] -> Maybe b
Data.List.Extra.firstJust (\(Int
_i::Int, (Bool
b,BriDocNumbered
x)) ->
                     [ -- traceShow ("choosing option " ++ show i) $
                       BriDocNumbered
x
                     | Bool
b
                     ])
                 ([(Int, (Bool, BriDocNumbered))] -> Maybe BriDocNumbered)
-> [(Int, (Bool, BriDocNumbered))] -> Maybe BriDocNumbered
forall a b. (a -> b) -> a -> b
$ [Int]
-> [(Bool, BriDocNumbered)] -> [(Int, (Bool, BriDocNumbered))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Bool, BriDocNumbered)]
options
            AltChooserBoundedSearch Int
limit -> do
              [[VerticalSpacing]]
spacings <- [BriDocNumbered]
alts [BriDocNumbered]
-> (BriDocNumbered
    -> StateCache
         (Container (Map Int [VerticalSpacing]))
         (MultiRWS r w (AltCurPos : s))
         [VerticalSpacing])
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     [[VerticalSpacing]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` Int
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     [VerticalSpacing]
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiWriter (Seq String) m) =>
Int
-> BriDocNumbered
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
getSpacings Int
limit
              AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
              let lineCheck :: VerticalSpacing -> Bool
lineCheck (VerticalSpacing Int
_ VerticalSpacingPar
p Bool
_) =
                    case AltCurPos -> AltLineModeState
_acp_forceMLFlag AltCurPos
acp of
                      AltLineModeState
AltLineModeStateNone      -> Bool
True
                      AltLineModeStateForceSL{} -> VerticalSpacingPar
p VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacingPar
VerticalSpacingParNone
                      AltLineModeStateForceML{} -> VerticalSpacingPar
p VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
/= VerticalSpacingPar
VerticalSpacingParNone
                      AltLineModeState
AltLineModeStateContradiction -> Bool
False
              CLayoutConfig Identity
lconf <- Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout (Config -> CLayoutConfig Identity)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     Config
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     (CLayoutConfig Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
#if INSERTTRACESALT
              tellDebugMess $ "considering options with " ++ show (length alts, acp)
#endif
              let options :: [(Bool, BriDocNumbered)]
options = -- trace ("considering options:" ++ show (length alts, acp)) $
                            ([[VerticalSpacing]]
-> [BriDocNumbered] -> [([VerticalSpacing], BriDocNumbered)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[VerticalSpacing]]
spacings [BriDocNumbered]
alts
                             [([VerticalSpacing], BriDocNumbered)]
-> (([VerticalSpacing], BriDocNumbered) -> (Bool, BriDocNumbered))
-> [(Bool, BriDocNumbered)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \([VerticalSpacing]
vs, BriDocNumbered
bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs))
                               (  (VerticalSpacing -> Bool) -> [VerticalSpacing] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (CLayoutConfig Identity -> AltCurPos -> VerticalSpacing -> Bool
hasSpace2 CLayoutConfig Identity
lconf AltCurPos
acp) [VerticalSpacing]
vs
                               Bool -> Bool -> Bool
&& (VerticalSpacing -> Bool) -> [VerticalSpacing] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any VerticalSpacing -> Bool
lineCheck [VerticalSpacing]
vs, BriDocNumbered
bd))
              let [Maybe (Int, BriDocNumbered)]
checkedOptions :: [Maybe (Int, BriDocNumbered)] =
                    [Int]
-> [(Bool, BriDocNumbered)] -> [(Int, (Bool, BriDocNumbered))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [(Bool, BriDocNumbered)]
options [(Int, (Bool, BriDocNumbered))]
-> ((Int, (Bool, BriDocNumbered)) -> Maybe (Int, BriDocNumbered))
-> [Maybe (Int, BriDocNumbered)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(Int
i, (Bool
b,BriDocNumbered
x)) -> [ (Int
i, BriDocNumbered
x) | Bool
b ])
#if INSERTTRACESALT
              zip spacings options `forM_` \(vs, (_, bd)) ->
                tellDebugMess $ "  " ++ "spacing=" ++ show vs
                             ++ ",hasSpace2=" ++ show (hasSpace2 lconf acp <$> vs)
                             ++ ",lineCheck=" ++ show (lineCheck <$> vs)
                             ++ " " ++ show (toConstr bd)
              tellDebugMess $ "  " ++ show (Data.Maybe.mapMaybe (fmap fst) checkedOptions)
#endif
              StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a. a -> a
id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x)
                 (StateCache
   (Container (Map Int [VerticalSpacing]))
   (MultiRWS r w (AltCurPos : s))
   BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec
                 (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered -> Maybe BriDocNumbered -> BriDocNumbered
forall a. a -> Maybe a -> a
fromMaybe (-- trace ("choosing last") $
                              [BriDocNumbered] -> BriDocNumbered
forall a. [a] -> a
List.last [BriDocNumbered]
alts)
                 (Maybe BriDocNumbered -> BriDocNumbered)
-> Maybe BriDocNumbered -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ (Maybe (Int, BriDocNumbered) -> Maybe BriDocNumbered)
-> [Maybe (Int, BriDocNumbered)] -> Maybe BriDocNumbered
forall a b. (a -> Maybe b) -> [a] -> Maybe b
Data.List.Extra.firstJust (((Int, BriDocNumbered) -> BriDocNumbered)
-> Maybe (Int, BriDocNumbered) -> Maybe BriDocNumbered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, BriDocNumbered) -> BriDocNumbered
forall a b. (a, b) -> b
snd) [Maybe (Int, BriDocNumbered)]
checkedOptions
        BDFForceMultiline BriDocNumbered
bd -> do
          AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          BriDocNumbered
x <- do
            AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos -> AltLineModeState -> AltCurPos
mergeLineMode AltCurPos
acp (Bool -> AltLineModeState
AltLineModeStateForceML Bool
False)
            BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
          AltCurPos
acp' <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp' { _acp_forceMLFlag :: AltLineModeState
_acp_forceMLFlag = AltCurPos -> AltLineModeState
_acp_forceMLFlag AltCurPos
acp }
          BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered
x
        BDFForceSingleline BriDocNumbered
bd -> do
          AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          BriDocNumbered
x <- do
            AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos -> AltLineModeState -> AltCurPos
mergeLineMode AltCurPos
acp AltLineModeState
AltLineModeStateForceSL
            BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
          AltCurPos
acp' <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp' { _acp_forceMLFlag :: AltLineModeState
_acp_forceMLFlag = AltCurPos -> AltLineModeState
_acp_forceMLFlag AltCurPos
acp }
          BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered
x
        BDFForwardLineMode BriDocNumbered
bd -> do
          AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          BriDocNumbered
x <- do
            AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp { _acp_forceMLFlag :: AltLineModeState
_acp_forceMLFlag = AltLineModeState -> AltLineModeState
altLineModeRefresh (AltLineModeState -> AltLineModeState)
-> AltLineModeState -> AltLineModeState
forall a b. (a -> b) -> a -> b
$ AltCurPos -> AltLineModeState
_acp_forceMLFlag AltCurPos
acp }
            BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
          AltCurPos
acp' <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp' { _acp_forceMLFlag :: AltLineModeState
_acp_forceMLFlag = AltCurPos -> AltLineModeState
_acp_forceMLFlag AltCurPos
acp }
          BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocNumbered
x
        BDFExternal{} -> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiState AltCurPos m,
 MonadMultiWriter (Seq String) m) =>
BriDocNumbered -> m ()
processSpacingSimple BriDocNumbered
bdX StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  ()
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BriDocNumbered
bdX
        BDFPlain{}    -> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiState AltCurPos m,
 MonadMultiWriter (Seq String) m) =>
BriDocNumbered -> m ()
processSpacingSimple BriDocNumbered
bdX StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  ()
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BriDocNumbered
bdX
        BDFAnnotationPrior AnnKey
annKey BriDocNumbered
bd -> do
          AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp { _acp_forceMLFlag :: AltLineModeState
_acp_forceMLFlag = AltLineModeState -> AltLineModeState
altLineModeDecay (AltLineModeState -> AltLineModeState)
-> AltLineModeState -> AltLineModeState
forall a b. (a -> b) -> a -> b
$ AltCurPos -> AltLineModeState
_acp_forceMLFlag AltCurPos
acp }
          BriDocNumbered
bd' <- BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
          BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ AnnKey -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). AnnKey -> f (BriDocF f) -> BriDocF f
BDFAnnotationPrior AnnKey
annKey BriDocNumbered
bd'
        BDFAnnotationRest AnnKey
annKey BriDocNumbered
bd ->
          BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnKey -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). AnnKey -> f (BriDocF f) -> BriDocF f
BDFAnnotationRest AnnKey
annKey (BriDocNumbered -> BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
        BDFAnnotationKW AnnKey
annKey Maybe AnnKeywordId
kw BriDocNumbered
bd ->
          BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnKey -> Maybe AnnKeywordId -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *).
AnnKey -> Maybe AnnKeywordId -> f (BriDocF f) -> BriDocF f
BDFAnnotationKW AnnKey
annKey Maybe AnnKeywordId
kw (BriDocNumbered -> BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
        BDFMoveToKWDP AnnKey
annKey AnnKeywordId
kw Bool
b BriDocNumbered
bd ->
          BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnKey -> AnnKeywordId -> Bool -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *).
AnnKey -> AnnKeywordId -> Bool -> f (BriDocF f) -> BriDocF f
BDFMoveToKWDP AnnKey
annKey AnnKeywordId
kw Bool
b (BriDocNumbered -> BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
        BDFLines [] -> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocFInt -> BriDocNumbered
reWrap BriDocFInt
forall (f :: * -> *). BriDocF f
BDFEmpty -- evil transformation. or harmless.
        BDFLines (BriDocNumbered
l:[BriDocNumbered]
lr) -> do
          Int
ind <- AltCurPos -> Int
_acp_indent (AltCurPos -> Int)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          BriDocNumbered
l' <- BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
l
          [BriDocNumbered]
lr' <- [BriDocNumbered]
lr [BriDocNumbered]
-> (BriDocNumbered
    -> StateCache
         (Container (Map Int [VerticalSpacing]))
         (MultiRWS r w (AltCurPos : s))
         BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     [BriDocNumbered]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` \BriDocNumbered
x -> do
            (AltCurPos -> AltCurPos)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((AltCurPos -> AltCurPos)
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> (AltCurPos -> AltCurPos)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ \AltCurPos
acp -> AltCurPos
acp
              { _acp_line :: Int
_acp_line   = Int
ind
              , _acp_indent :: Int
_acp_indent = Int
ind
              }
            BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
x
          BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ [BriDocNumbered] -> BriDocFInt
forall (f :: * -> *). [f (BriDocF f)] -> BriDocF f
BDFLines (BriDocNumbered
l'BriDocNumbered -> [BriDocNumbered] -> [BriDocNumbered]
forall a. a -> [a] -> [a]
:[BriDocNumbered]
lr')
        BDFEnsureIndent BrIndent
indent BriDocNumbered
bd -> do
          AltCurPos
acp <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          Int
indAdd <- AltCurPos
-> BrIndent
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     Int
forall (m :: * -> *).
MonadMultiReader Config m =>
AltCurPos -> BrIndent -> m Int
fixIndentationForMultiple AltCurPos
acp BrIndent
indent
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp
            { _acp_indentPrep :: Int
_acp_indentPrep = Int
0
              -- TODO: i am not sure this is valid, in general.
            , _acp_indent :: Int
_acp_indent = AltCurPos -> Int
_acp_indent AltCurPos
acp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indAdd
            , _acp_line :: Int
_acp_line = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (AltCurPos -> Int
_acp_line AltCurPos
acp) (AltCurPos -> Int
_acp_indent AltCurPos
acp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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.
            }
          BriDocNumbered
r <- BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
          AltCurPos
acp' <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> AltCurPos
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp' { _acp_indent :: Int
_acp_indent = AltCurPos -> Int
_acp_indent AltCurPos
acp }
          BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (m :: * -> *) a. Monad m => a -> m a
return (BriDocNumbered
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      BriDocNumbered)
-> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ case BrIndent
indent of
            BrIndent
BrIndentNone -> BriDocNumbered
r
            BrIndent
BrIndentRegular ->   BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BrIndent -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). BrIndent -> f (BriDocF f) -> BriDocF f
BDFEnsureIndent (Int -> BrIndent
BrIndentSpecial Int
indAdd) BriDocNumbered
r
            BrIndentSpecial Int
i -> BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered) -> BriDocFInt -> BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BrIndent -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). BrIndent -> f (BriDocF f) -> BriDocF f
BDFEnsureIndent (Int -> BrIndent
BrIndentSpecial Int
i) BriDocNumbered
r
        BDFNonBottomSpacing Bool
_ BriDocNumbered
bd -> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
        BDFSetParSpacing BriDocNumbered
bd -> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
        BDFForceParSpacing BriDocNumbered
bd -> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
        BDFDebug String
s BriDocNumbered
bd -> do
          AltCurPos
acp :: AltCurPos <- StateCache
  (Container (Map Int [VerticalSpacing]))
  (MultiRWS r w (AltCurPos : s))
  AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
          String
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall (m :: * -> *).
MonadMultiWriter (Seq String) m =>
String -> m ()
tellDebugMess (String
 -> StateCache
      (Container (Map Int [VerticalSpacing]))
      (MultiRWS r w (AltCurPos : s))
      ())
-> String
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     ()
forall a b. (a -> b) -> a -> b
$ String
"transformAlts: BDFDEBUG " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (node-id=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
brDcId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): acp=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ AltCurPos -> String
forall a. Show a => a -> String
show AltCurPos
acp
          BriDocFInt -> BriDocNumbered
reWrap (BriDocFInt -> BriDocNumbered)
-> (BriDocNumbered -> BriDocFInt)
-> BriDocNumbered
-> BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BriDocNumbered -> BriDocFInt
forall (f :: * -> *). String -> f (BriDocF f) -> BriDocF f
BDFDebug String
s (BriDocNumbered -> BriDocNumbered)
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered
-> StateCache
     (Container (Map Int [VerticalSpacing]))
     (MultiRWS r w (AltCurPos : s))
     BriDocNumbered
rec BriDocNumbered
bd
    processSpacingSimple
      :: ( MonadMultiReader Config m
         , MonadMultiState AltCurPos m
         , MonadMultiWriter (Seq String) m
         )
      => BriDocNumbered
      -> m ()
    processSpacingSimple :: BriDocNumbered -> m ()
processSpacingSimple BriDocNumbered
bd = BriDocNumbered -> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *).
(MonadMultiReader Config m, MonadMultiWriter (Seq String) m) =>
BriDocNumbered -> m (LineModeValidity VerticalSpacing)
getSpacing BriDocNumbered
bd m (LineModeValidity VerticalSpacing)
-> (LineModeValidity VerticalSpacing -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      LineModeValidity VerticalSpacing
LineModeInvalid                           -> String -> m ()
forall a. HasCallStack => String -> a
error String
"processSpacingSimple inv"
      LineModeValid (VerticalSpacing Int
i VerticalSpacingPar
VerticalSpacingParNone Bool
_) -> do
        AltCurPos
acp <- m AltCurPos
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
        AltCurPos -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (AltCurPos -> m ()) -> AltCurPos -> m ()
forall a b. (a -> b) -> a -> b
$ AltCurPos
acp { _acp_line :: Int
_acp_line = AltCurPos -> Int
_acp_line AltCurPos
acp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i }
      LineModeValid (VerticalSpacing Int
_ VerticalSpacingPar
_ Bool
_)  -> String -> m ()
forall a. HasCallStack => String -> a
error String
"processSpacingSimple par"
      LineModeValidity VerticalSpacing
_ -> String -> m ()
forall a. HasCallStack => String -> a
error String
"ghc exhaustive check is insufficient"
    hasSpace1 :: LayoutConfig -> AltCurPos -> LineModeValidity VerticalSpacing -> Bool
    hasSpace1 :: CLayoutConfig Identity
-> AltCurPos -> LineModeValidity VerticalSpacing -> Bool
hasSpace1 CLayoutConfig Identity
_ AltCurPos
_ LineModeValidity VerticalSpacing
LineModeInvalid = Bool
False
    hasSpace1 CLayoutConfig Identity
lconf AltCurPos
acp (LineModeValid VerticalSpacing
vs) = CLayoutConfig Identity -> AltCurPos -> VerticalSpacing -> Bool
hasSpace2 CLayoutConfig Identity
lconf AltCurPos
acp VerticalSpacing
vs
    hasSpace1 CLayoutConfig Identity
_ AltCurPos
_ LineModeValidity VerticalSpacing
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"ghc exhaustive check is insufficient"
    hasSpace2 :: LayoutConfig -> AltCurPos -> VerticalSpacing -> Bool
    hasSpace2 :: CLayoutConfig Identity -> AltCurPos -> VerticalSpacing -> Bool
hasSpace2 CLayoutConfig Identity
lconf (AltCurPos Int
line Int
_indent Int
_ AltLineModeState
_) (VerticalSpacing Int
sameLine VerticalSpacingPar
VerticalSpacingParNone Bool
_)
      = Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sameLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack (CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_cols CLayoutConfig Identity
lconf)
    hasSpace2 CLayoutConfig Identity
lconf (AltCurPos Int
line Int
indent Int
indentPrep AltLineModeState
_) (VerticalSpacing Int
sameLine (VerticalSpacingParSome Int
par) Bool
_)
      = Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sameLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack (CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_cols CLayoutConfig Identity
lconf)
        Bool -> Bool -> Bool
&& Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentPrep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
par Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack (CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_cols CLayoutConfig Identity
lconf)
    hasSpace2 CLayoutConfig Identity
lconf (AltCurPos Int
line Int
_indent Int
_ AltLineModeState
_) (VerticalSpacing Int
sameLine VerticalSpacingParAlways{} Bool
_)
      = Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sameLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack (CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_cols CLayoutConfig Identity
lconf)

getSpacing
  :: forall m
   . (MonadMultiReader Config m, MonadMultiWriter (Seq String) m)
  => BriDocNumbered
  -> m (LineModeValidity VerticalSpacing)
getSpacing :: BriDocNumbered -> m (LineModeValidity VerticalSpacing)
getSpacing !BriDocNumbered
bridoc = BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bridoc
 where
  rec :: BriDocNumbered -> m (LineModeValidity VerticalSpacing)
  rec :: BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec (Int
brDcId, BriDocFInt
brDc) = do
    Config
config <- m Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
    let colMax :: Int
colMax = Config
config Config
-> (Config -> CLayoutConfig Identity) -> CLayoutConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout CLayoutConfig Identity
-> (CLayoutConfig Identity -> Identity (Last Int))
-> Identity (Last Int)
forall a b. a -> (a -> b) -> b
& CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_cols Identity (Last Int) -> (Identity (Last Int) -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
    LineModeValidity VerticalSpacing
result <- case BriDocFInt
brDc of
      -- BDWrapAnnKey _annKey bd -> rec bd
      BriDocFInt
BDFEmpty ->
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ VerticalSpacing -> LineModeValidity VerticalSpacing
forall t. t -> LineModeValidity t
LineModeValid (VerticalSpacing -> LineModeValidity VerticalSpacing)
-> VerticalSpacing -> LineModeValidity VerticalSpacing
forall a b. (a -> b) -> a -> b
$ Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
0 VerticalSpacingPar
VerticalSpacingParNone Bool
False
      BDFLit Text
t ->
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ VerticalSpacing -> LineModeValidity VerticalSpacing
forall t. t -> LineModeValidity t
LineModeValid (VerticalSpacing -> LineModeValidity VerticalSpacing)
-> VerticalSpacing -> LineModeValidity VerticalSpacing
forall a b. (a -> b) -> a -> b
$ Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing (Text -> Int
Text.length Text
t) VerticalSpacingPar
VerticalSpacingParNone Bool
False
      BDFSeq [BriDocNumbered]
list ->
        [LineModeValidity VerticalSpacing]
-> LineModeValidity VerticalSpacing
sumVs ([LineModeValidity VerticalSpacing]
 -> LineModeValidity VerticalSpacing)
-> m [LineModeValidity VerticalSpacing]
-> m (LineModeValidity VerticalSpacing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec (BriDocNumbered -> m (LineModeValidity VerticalSpacing))
-> [BriDocNumbered] -> m [LineModeValidity VerticalSpacing]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [BriDocNumbered]
list
      BDFCols ColSig
_sig [BriDocNumbered]
list -> [LineModeValidity VerticalSpacing]
-> LineModeValidity VerticalSpacing
sumVs ([LineModeValidity VerticalSpacing]
 -> LineModeValidity VerticalSpacing)
-> m [LineModeValidity VerticalSpacing]
-> m (LineModeValidity VerticalSpacing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec (BriDocNumbered -> m (LineModeValidity VerticalSpacing))
-> [BriDocNumbered] -> m [LineModeValidity VerticalSpacing]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [BriDocNumbered]
list
      BriDocFInt
BDFSeparator ->
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ VerticalSpacing -> LineModeValidity VerticalSpacing
forall t. t -> LineModeValidity t
LineModeValid (VerticalSpacing -> LineModeValidity VerticalSpacing)
-> VerticalSpacing -> LineModeValidity VerticalSpacing
forall a b. (a -> b) -> a -> b
$ Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
1 VerticalSpacingPar
VerticalSpacingParNone Bool
False
      BDFAddBaseY BrIndent
indent BriDocNumbered
bd -> do
        LineModeValidity VerticalSpacing
mVs <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ LineModeValidity VerticalSpacing
mVs LineModeValidity VerticalSpacing
-> (VerticalSpacing -> VerticalSpacing)
-> LineModeValidity VerticalSpacing
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \VerticalSpacing
vs -> VerticalSpacing
vs
          { _vs_paragraph :: VerticalSpacingPar
_vs_paragraph = case VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
vs of
              VerticalSpacingPar
VerticalSpacingParNone -> VerticalSpacingPar
VerticalSpacingParNone
              VerticalSpacingParAlways Int
i -> Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ case BrIndent
indent of
                BrIndent
BrIndentNone      -> Int
i
                BrIndent
BrIndentRegular   -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ( Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
                                         (Identity (Last Int) -> Int) -> Identity (Last Int) -> Int
forall a b. (a -> b) -> a -> b
$ CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_indentAmount
                                         (CLayoutConfig Identity -> Identity (Last Int))
-> CLayoutConfig Identity -> Identity (Last Int)
forall a b. (a -> b) -> a -> b
$ Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout
                                         (Config -> CLayoutConfig Identity)
-> Config -> CLayoutConfig Identity
forall a b. (a -> b) -> a -> b
$ Config
config
                                         )
                BrIndentSpecial Int
j -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j
              VerticalSpacingParSome Int
i -> Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ case BrIndent
indent of
                BrIndent
BrIndentNone      -> Int
i
                BrIndent
BrIndentRegular   -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ( Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
                                         (Identity (Last Int) -> Int) -> Identity (Last Int) -> Int
forall a b. (a -> b) -> a -> b
$ CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_indentAmount
                                         (CLayoutConfig Identity -> Identity (Last Int))
-> CLayoutConfig Identity -> Identity (Last Int)
forall a b. (a -> b) -> a -> b
$ Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout
                                         (Config -> CLayoutConfig Identity)
-> Config -> CLayoutConfig Identity
forall a b. (a -> b) -> a -> b
$ Config
config
                                         )
                BrIndentSpecial Int
j -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j
          }
      BDFBaseYPushCur BriDocNumbered
bd -> do
        LineModeValidity VerticalSpacing
mVs <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ LineModeValidity VerticalSpacing
mVs LineModeValidity VerticalSpacing
-> (VerticalSpacing -> VerticalSpacing)
-> LineModeValidity VerticalSpacing
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \VerticalSpacing
vs -> VerticalSpacing
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 :: Int
_vs_sameLine = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (VerticalSpacing -> Int
_vs_sameLine VerticalSpacing
vs)
                               (case VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
vs of
                                  VerticalSpacingPar
VerticalSpacingParNone -> Int
0
                                  VerticalSpacingParSome Int
i -> Int
i
                                  VerticalSpacingParAlways Int
i -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
colMax Int
i)
          , _vs_paragraph :: VerticalSpacingPar
_vs_paragraph = Int -> VerticalSpacingPar
VerticalSpacingParSome Int
0
          }
      BDFBaseYPop BriDocNumbered
bd -> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
      BDFIndentLevelPushCur BriDocNumbered
bd -> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
      BDFIndentLevelPop BriDocNumbered
bd -> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
      BDFPar BrIndent
BrIndentNone BriDocNumbered
sameLine BriDocNumbered
indented -> do
        LineModeValidity VerticalSpacing
mVs <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
sameLine
        LineModeValidity VerticalSpacing
mIndSp <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
indented
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return
          (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ [ Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
lsp VerticalSpacingPar
pspResult Bool
parFlagResult
            | VerticalSpacing Int
lsp VerticalSpacingPar
mPsp Bool
_ <- LineModeValidity VerticalSpacing
mVs
            , VerticalSpacing
indSp <- LineModeValidity VerticalSpacing
mIndSp
            , Int
lineMax <- LineModeValidity VerticalSpacing -> LineModeValidity Int
getMaxVS (LineModeValidity VerticalSpacing -> LineModeValidity Int)
-> LineModeValidity VerticalSpacing -> LineModeValidity Int
forall a b. (a -> b) -> a -> b
$ LineModeValidity VerticalSpacing
mIndSp
            , let pspResult :: VerticalSpacingPar
pspResult = case VerticalSpacingPar
mPsp of
                    VerticalSpacingParSome Int
psp   -> Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
psp Int
lineMax
                    VerticalSpacingPar
VerticalSpacingParNone       -> Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
lineMax
                    VerticalSpacingParAlways Int
psp -> Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
psp Int
lineMax
            , let parFlagResult :: Bool
parFlagResult =  VerticalSpacingPar
mPsp VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacingPar
VerticalSpacingParNone
                                Bool -> Bool -> Bool
&& VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
indSp VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
==  VerticalSpacingPar
VerticalSpacingParNone
                                Bool -> Bool -> Bool
&& VerticalSpacing -> Bool
_vs_parFlag VerticalSpacing
indSp
            ]
      BDFPar{} -> String -> m (LineModeValidity VerticalSpacing)
forall a. HasCallStack => String -> a
error String
"BDPar with indent in getSpacing"
      BDFAlt [] -> String -> m (LineModeValidity VerticalSpacing)
forall a. HasCallStack => String -> a
error String
"empty BDAlt"
      BDFAlt (BriDocNumbered
alt:[BriDocNumbered]
_) -> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
alt
      BDFForceMultiline  BriDocNumbered
bd -> do
        LineModeValidity VerticalSpacing
mVs <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ LineModeValidity VerticalSpacing
mVs LineModeValidity VerticalSpacing
-> (VerticalSpacing -> LineModeValidity VerticalSpacing)
-> LineModeValidity VerticalSpacing
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VerticalSpacing -> VerticalSpacingPar
_vs_paragraph (VerticalSpacing -> VerticalSpacingPar)
-> (VerticalSpacingPar -> LineModeValidity VerticalSpacing)
-> VerticalSpacing
-> LineModeValidity VerticalSpacing
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> \case
          VerticalSpacingPar
VerticalSpacingParNone -> LineModeValidity VerticalSpacing
forall t. LineModeValidity t
LineModeInvalid
          VerticalSpacingPar
_  -> LineModeValidity VerticalSpacing
mVs
      BDFForceSingleline BriDocNumbered
bd -> do
        LineModeValidity VerticalSpacing
mVs <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ LineModeValidity VerticalSpacing
mVs LineModeValidity VerticalSpacing
-> (VerticalSpacing -> LineModeValidity VerticalSpacing)
-> LineModeValidity VerticalSpacing
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VerticalSpacing -> VerticalSpacingPar
_vs_paragraph (VerticalSpacing -> VerticalSpacingPar)
-> (VerticalSpacingPar -> LineModeValidity VerticalSpacing)
-> VerticalSpacing
-> LineModeValidity VerticalSpacing
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> \case
          VerticalSpacingPar
VerticalSpacingParNone -> LineModeValidity VerticalSpacing
mVs
          VerticalSpacingPar
_  -> LineModeValidity VerticalSpacing
forall t. LineModeValidity t
LineModeInvalid
      BDFForwardLineMode BriDocNumbered
bd -> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
      BDFExternal AnnKey
_ Set AnnKey
_ Bool
_ Text
txt -> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ VerticalSpacing -> LineModeValidity VerticalSpacing
forall t. t -> LineModeValidity t
LineModeValid (VerticalSpacing -> LineModeValidity VerticalSpacing)
-> VerticalSpacing -> LineModeValidity VerticalSpacing
forall a b. (a -> b) -> a -> b
$ case Text -> [Text]
Text.lines Text
txt of
        [Text
t] -> Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing (Text -> Int
Text.length Text
t) VerticalSpacingPar
VerticalSpacingParNone Bool
False
        [Text]
_   -> Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
999 VerticalSpacingPar
VerticalSpacingParNone Bool
False
      BDFPlain Text
txt -> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ VerticalSpacing -> LineModeValidity VerticalSpacing
forall t. t -> LineModeValidity t
LineModeValid (VerticalSpacing -> LineModeValidity VerticalSpacing)
-> VerticalSpacing -> LineModeValidity VerticalSpacing
forall a b. (a -> b) -> a -> b
$ case Text -> [Text]
Text.lines Text
txt of
        [Text
t] -> Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing (Text -> Int
Text.length Text
t) VerticalSpacingPar
VerticalSpacingParNone Bool
False
        [Text]
_   -> Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
999 VerticalSpacingPar
VerticalSpacingParNone Bool
False
      BDFAnnotationPrior AnnKey
_annKey BriDocNumbered
bd -> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
      BDFAnnotationKW AnnKey
_annKey Maybe AnnKeywordId
_kw BriDocNumbered
bd -> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
      BDFAnnotationRest  AnnKey
_annKey BriDocNumbered
bd -> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
      BDFMoveToKWDP AnnKey
_annKey AnnKeywordId
_kw Bool
_b BriDocNumbered
bd -> BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
      BDFLines [] -> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return
        (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ VerticalSpacing -> LineModeValidity VerticalSpacing
forall t. t -> LineModeValidity t
LineModeValid
        (VerticalSpacing -> LineModeValidity VerticalSpacing)
-> VerticalSpacing -> LineModeValidity VerticalSpacing
forall a b. (a -> b) -> a -> b
$ Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
0 VerticalSpacingPar
VerticalSpacingParNone Bool
False
      BDFLines ls :: [BriDocNumbered]
ls@(BriDocNumbered
_:[BriDocNumbered]
_) -> do
        [LineModeValidity VerticalSpacing]
lSps <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec (BriDocNumbered -> m (LineModeValidity VerticalSpacing))
-> [BriDocNumbered] -> m [LineModeValidity VerticalSpacing]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [BriDocNumbered]
ls
        let (LineModeValidity VerticalSpacing
mVs:[LineModeValidity VerticalSpacing]
_) = [LineModeValidity VerticalSpacing]
lSps -- separated into let to avoid MonadFail
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ [ Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
lsp (Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
lineMax) Bool
False
                 | VerticalSpacing Int
lsp VerticalSpacingPar
_ Bool
_ <- LineModeValidity VerticalSpacing
mVs
                 , Int
lineMax <- LineModeValidity VerticalSpacing -> LineModeValidity Int
getMaxVS (LineModeValidity VerticalSpacing -> LineModeValidity Int)
-> LineModeValidity VerticalSpacing -> LineModeValidity Int
forall a b. (a -> b) -> a -> b
$ [LineModeValidity VerticalSpacing]
-> LineModeValidity VerticalSpacing
maxVs ([LineModeValidity VerticalSpacing]
 -> LineModeValidity VerticalSpacing)
-> [LineModeValidity VerticalSpacing]
-> LineModeValidity VerticalSpacing
forall a b. (a -> b) -> a -> b
$ [LineModeValidity VerticalSpacing]
lSps
                 ]
      BDFEnsureIndent BrIndent
indent BriDocNumbered
bd -> do
        LineModeValidity VerticalSpacing
mVs <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
        let addInd :: Int
addInd = case BrIndent
indent of
              BrIndent
BrIndentNone      -> Int
0
              BrIndent
BrIndentRegular   -> Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
                                 (Identity (Last Int) -> Int) -> Identity (Last Int) -> Int
forall a b. (a -> b) -> a -> b
$ CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_indentAmount
                                 (CLayoutConfig Identity -> Identity (Last Int))
-> CLayoutConfig Identity -> Identity (Last Int)
forall a b. (a -> b) -> a -> b
$ Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout
                                 (Config -> CLayoutConfig Identity)
-> Config -> CLayoutConfig Identity
forall a b. (a -> b) -> a -> b
$ Config
config
              BrIndentSpecial Int
i -> Int
i
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ LineModeValidity VerticalSpacing
mVs LineModeValidity VerticalSpacing
-> (VerticalSpacing -> VerticalSpacing)
-> LineModeValidity VerticalSpacing
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(VerticalSpacing Int
lsp VerticalSpacingPar
psp Bool
pf) ->
          Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing (Int
lsp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
addInd) VerticalSpacingPar
psp Bool
pf
      BDFNonBottomSpacing Bool
b BriDocNumbered
bd -> do
        LineModeValidity VerticalSpacing
mVs <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return
          (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$   LineModeValidity VerticalSpacing
mVs
          LineModeValidity VerticalSpacing
-> LineModeValidity VerticalSpacing
-> LineModeValidity VerticalSpacing
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VerticalSpacing -> LineModeValidity VerticalSpacing
forall t. t -> LineModeValidity t
LineModeValid
                (Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing
                  Int
0
                  (if Bool
b then Int -> VerticalSpacingPar
VerticalSpacingParSome Int
0
                        else Int -> VerticalSpacingPar
VerticalSpacingParAlways Int
colMax
                  )
                  Bool
False
                )
      BDFSetParSpacing BriDocNumbered
bd -> do
        LineModeValidity VerticalSpacing
mVs <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ LineModeValidity VerticalSpacing
mVs LineModeValidity VerticalSpacing
-> (VerticalSpacing -> VerticalSpacing)
-> LineModeValidity VerticalSpacing
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \VerticalSpacing
vs -> VerticalSpacing
vs { _vs_parFlag :: Bool
_vs_parFlag = Bool
True }
      BDFForceParSpacing BriDocNumbered
bd -> do
        LineModeValidity VerticalSpacing
mVs <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return (LineModeValidity VerticalSpacing
 -> m (LineModeValidity VerticalSpacing))
-> LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall a b. (a -> b) -> a -> b
$ [ VerticalSpacing
vs | VerticalSpacing
vs <- LineModeValidity VerticalSpacing
mVs, VerticalSpacing -> Bool
_vs_parFlag VerticalSpacing
vs Bool -> Bool -> Bool
|| VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
vs VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacingPar
VerticalSpacingParNone ]
      BDFDebug String
s BriDocNumbered
bd -> do
        LineModeValidity VerticalSpacing
r <- BriDocNumbered -> m (LineModeValidity VerticalSpacing)
rec BriDocNumbered
bd
        String -> m ()
forall (m :: * -> *).
MonadMultiWriter (Seq String) m =>
String -> m ()
tellDebugMess (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"getSpacing: BDFDebug " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (node-id=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
brDcId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): mVs=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LineModeValidity VerticalSpacing -> String
forall a. Show a => a -> String
show LineModeValidity VerticalSpacing
r
        LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return LineModeValidity VerticalSpacing
r
#if INSERTTRACESGETSPACING
    tellDebugMess $ "getSpacing: visiting: " ++ show (toConstr $ brDc) ++ " -> " ++ show result
#endif
    LineModeValidity VerticalSpacing
-> m (LineModeValidity VerticalSpacing)
forall (m :: * -> *) a. Monad m => a -> m a
return LineModeValidity VerticalSpacing
result
  maxVs :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
  maxVs :: [LineModeValidity VerticalSpacing]
-> LineModeValidity VerticalSpacing
maxVs = (LineModeValidity VerticalSpacing
 -> LineModeValidity VerticalSpacing
 -> LineModeValidity VerticalSpacing)
-> LineModeValidity VerticalSpacing
-> [LineModeValidity VerticalSpacing]
-> LineModeValidity VerticalSpacing
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    ((VerticalSpacing -> VerticalSpacing -> VerticalSpacing)
-> LineModeValidity VerticalSpacing
-> LineModeValidity VerticalSpacing
-> LineModeValidity VerticalSpacing
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\(VerticalSpacing Int
x1 VerticalSpacingPar
x2 Bool
_) (VerticalSpacing Int
y1 VerticalSpacingPar
y2 Bool
_) ->
        Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x1 Int
y1) (case (VerticalSpacingPar
x2, VerticalSpacingPar
y2) of
          (VerticalSpacingPar
x, VerticalSpacingPar
VerticalSpacingParNone) -> VerticalSpacingPar
x
          (VerticalSpacingPar
VerticalSpacingParNone, VerticalSpacingPar
x) -> VerticalSpacingPar
x
          (VerticalSpacingParAlways Int
i, VerticalSpacingParAlways Int
j) ->
            Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i Int
j
          (VerticalSpacingParAlways Int
i, VerticalSpacingParSome Int
j) ->
            Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i Int
j
          (VerticalSpacingParSome Int
j, VerticalSpacingParAlways Int
i) ->
            Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i Int
j
          (VerticalSpacingParSome Int
x, VerticalSpacingParSome Int
y) ->
            Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
y) Bool
False))
    (VerticalSpacing -> LineModeValidity VerticalSpacing
forall t. t -> LineModeValidity t
LineModeValid (VerticalSpacing -> LineModeValidity VerticalSpacing)
-> VerticalSpacing -> LineModeValidity VerticalSpacing
forall a b. (a -> b) -> a -> b
$ Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
0 VerticalSpacingPar
VerticalSpacingParNone Bool
False)
  sumVs :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
  sumVs :: [LineModeValidity VerticalSpacing]
-> LineModeValidity VerticalSpacing
sumVs [LineModeValidity VerticalSpacing]
sps = (LineModeValidity VerticalSpacing
 -> LineModeValidity VerticalSpacing
 -> LineModeValidity VerticalSpacing)
-> LineModeValidity VerticalSpacing
-> [LineModeValidity VerticalSpacing]
-> LineModeValidity VerticalSpacing
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((VerticalSpacing -> VerticalSpacing -> VerticalSpacing)
-> LineModeValidity VerticalSpacing
-> LineModeValidity VerticalSpacing
-> LineModeValidity VerticalSpacing
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 VerticalSpacing -> VerticalSpacing -> VerticalSpacing
go) LineModeValidity VerticalSpacing
initial [LineModeValidity VerticalSpacing]
sps
   where
    go :: VerticalSpacing -> VerticalSpacing -> VerticalSpacing
go (VerticalSpacing Int
x1 VerticalSpacingPar
x2 Bool
x3) (VerticalSpacing Int
y1 VerticalSpacingPar
y2 Bool
_) = Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing
      (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y1)
      (case (VerticalSpacingPar
x2, VerticalSpacingPar
y2) of
        (VerticalSpacingPar
x, VerticalSpacingPar
VerticalSpacingParNone) -> VerticalSpacingPar
x
        (VerticalSpacingPar
VerticalSpacingParNone, VerticalSpacingPar
x) -> VerticalSpacingPar
x
        (VerticalSpacingParAlways Int
i, VerticalSpacingParAlways Int
j) ->
          Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j
        (VerticalSpacingParAlways Int
i, VerticalSpacingParSome Int
j) ->
          Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j
        (VerticalSpacingParSome Int
i, VerticalSpacingParAlways Int
j) ->
          Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j
        (VerticalSpacingParSome Int
x, VerticalSpacingParSome Int
y) ->
          Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
      Bool
x3
    singleline :: LineModeValidity VerticalSpacing -> Bool
singleline (LineModeValid VerticalSpacing
x) = VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
x VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacingPar
VerticalSpacingParNone
    singleline LineModeValidity VerticalSpacing
_                 = Bool
False
    isPar :: LineModeValidity VerticalSpacing -> Bool
isPar (LineModeValid VerticalSpacing
x) = VerticalSpacing -> Bool
_vs_parFlag VerticalSpacing
x
    isPar LineModeValidity VerticalSpacing
_                 = Bool
False
    parFlag :: Bool
parFlag = case [LineModeValidity VerticalSpacing]
sps of
      [] -> Bool
True
      [LineModeValidity VerticalSpacing]
_ -> (LineModeValidity VerticalSpacing -> Bool)
-> [LineModeValidity VerticalSpacing] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LineModeValidity VerticalSpacing -> Bool
singleline ([LineModeValidity VerticalSpacing]
-> [LineModeValidity VerticalSpacing]
forall a. [a] -> [a]
List.init [LineModeValidity VerticalSpacing]
sps) Bool -> Bool -> Bool
&& LineModeValidity VerticalSpacing -> Bool
isPar ([LineModeValidity VerticalSpacing]
-> LineModeValidity VerticalSpacing
forall a. [a] -> a
List.last [LineModeValidity VerticalSpacing]
sps)
    initial :: LineModeValidity VerticalSpacing
initial = VerticalSpacing -> LineModeValidity VerticalSpacing
forall t. t -> LineModeValidity t
LineModeValid (VerticalSpacing -> LineModeValidity VerticalSpacing)
-> VerticalSpacing -> LineModeValidity VerticalSpacing
forall a b. (a -> b) -> a -> b
$ Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
0 VerticalSpacingPar
VerticalSpacingParNone Bool
parFlag
  getMaxVS :: LineModeValidity VerticalSpacing -> LineModeValidity Int
  getMaxVS :: LineModeValidity VerticalSpacing -> LineModeValidity Int
getMaxVS = (VerticalSpacing -> Int)
-> LineModeValidity VerticalSpacing -> LineModeValidity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((VerticalSpacing -> Int)
 -> LineModeValidity VerticalSpacing -> LineModeValidity Int)
-> (VerticalSpacing -> Int)
-> LineModeValidity VerticalSpacing
-> LineModeValidity Int
forall a b. (a -> b) -> a -> b
$ \(VerticalSpacing Int
x1 VerticalSpacingPar
x2 Bool
_) -> Int
x1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` case VerticalSpacingPar
x2 of
    VerticalSpacingParSome Int
i -> Int
i
    VerticalSpacingPar
VerticalSpacingParNone -> Int
0
    VerticalSpacingParAlways Int
i -> Int
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 :: Int
-> BriDocNumbered
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
getSpacings Int
limit BriDocNumbered
bridoc = [VerticalSpacing] -> [VerticalSpacing]
preFilterLimit ([VerticalSpacing] -> [VerticalSpacing])
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
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 :: [VerticalSpacing] -> [VerticalSpacing]
preFilterLimit = Int -> [VerticalSpacing] -> [VerticalSpacing]
forall a. Int -> [a] -> [a]
take (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
limit)
    memoWithKey :: Memo.MonadMemo k v m1 => k -> m1 v -> m1 v
    memoWithKey :: k -> m1 v -> m1 v
memoWithKey k
k m1 v
v = (k -> m1 v) -> k -> m1 v
forall k v (m :: * -> *). MonadMemo k v m => (k -> m v) -> k -> m v
Memo.memo (m1 v -> k -> m1 v
forall a b. a -> b -> a
const m1 v
v) k
k
    rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing]
    rec :: BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec (Int
brDcId, BriDocFInt
brdc) = Int
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall k v (m1 :: * -> *). MonadMemo k v m1 => k -> m1 v -> m1 v
memoWithKey Int
brDcId (MemoT Int [VerticalSpacing] m [VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ do
      Config
config <- StateCache (Container (Map Int [VerticalSpacing])) m Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
      let colMax :: Int
colMax = Config
config Config
-> (Config -> CLayoutConfig Identity) -> CLayoutConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout CLayoutConfig Identity
-> (CLayoutConfig Identity -> Identity (Last Int))
-> Identity (Last Int)
forall a b. a -> (a -> b) -> b
& CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_cols Identity (Last Int) -> (Identity (Last Int) -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
      let hasOkColCount :: VerticalSpacing -> Bool
hasOkColCount (VerticalSpacing Int
lsp VerticalSpacingPar
psp Bool
_) =
            Int
lsp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
colMax Bool -> Bool -> Bool
&& case VerticalSpacingPar
psp of
              VerticalSpacingPar
VerticalSpacingParNone -> Bool
True
              VerticalSpacingParSome Int
i -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
colMax
              VerticalSpacingParAlways{} -> Bool
True
      let specialCompare :: VerticalSpacing -> VerticalSpacing -> SpecialCompare
specialCompare VerticalSpacing
vs1 VerticalSpacing
vs2 =
            if (  (VerticalSpacing -> Int
_vs_sameLine VerticalSpacing
vs1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacing -> Int
_vs_sameLine VerticalSpacing
vs2)
               Bool -> Bool -> Bool
&& (VerticalSpacing -> Bool
_vs_parFlag VerticalSpacing
vs1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacing -> Bool
_vs_parFlag VerticalSpacing
vs2)
               )
              then case (VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
vs1, VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
vs2) of
                (VerticalSpacingParAlways Int
i1, VerticalSpacingParAlways Int
i2) ->
                  if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i2 then SpecialCompare
Smaller else SpecialCompare
Bigger
                (VerticalSpacingPar
p1, VerticalSpacingPar
p2) -> if VerticalSpacingPar
p1 VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacingPar
p2 then SpecialCompare
Smaller else SpecialCompare
Unequal
              else SpecialCompare
Unequal
      let allowHangingQuasiQuotes :: Bool
allowHangingQuasiQuotes =
            Config
config
              Config
-> (Config -> CLayoutConfig Identity) -> CLayoutConfig Identity
forall a b. a -> (a -> b) -> b
& Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout
              CLayoutConfig Identity
-> (CLayoutConfig Identity -> Identity (Last Bool))
-> Identity (Last Bool)
forall a b. a -> (a -> b) -> b
& CLayoutConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CLayoutConfig f -> f (Last Bool)
_lconfig_allowHangingQuasiQuotes
              Identity (Last Bool) -> (Identity (Last Bool) -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
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 :: [VerticalSpacing] -> [VerticalSpacing]
specialNub [] = []
          specialNub (VerticalSpacing
x1 : [VerticalSpacing]
xr) = case VerticalSpacing
-> [VerticalSpacing] -> (VerticalSpacing, [VerticalSpacing])
go VerticalSpacing
x1 [VerticalSpacing]
xr of
            (VerticalSpacing
r, [VerticalSpacing]
xs') -> VerticalSpacing
r VerticalSpacing -> [VerticalSpacing] -> [VerticalSpacing]
forall a. a -> [a] -> [a]
: [VerticalSpacing] -> [VerticalSpacing]
specialNub [VerticalSpacing]
xs'
           where
            go :: VerticalSpacing
-> [VerticalSpacing] -> (VerticalSpacing, [VerticalSpacing])
go VerticalSpacing
y1 []        = (VerticalSpacing
y1, [])
            go VerticalSpacing
y1 (VerticalSpacing
y2 : [VerticalSpacing]
yr) = case VerticalSpacing -> VerticalSpacing -> SpecialCompare
specialCompare VerticalSpacing
y1 VerticalSpacing
y2 of
              SpecialCompare
Unequal -> let (VerticalSpacing
r, [VerticalSpacing]
yr') = VerticalSpacing
-> [VerticalSpacing] -> (VerticalSpacing, [VerticalSpacing])
go VerticalSpacing
y1 [VerticalSpacing]
yr in (VerticalSpacing
r, VerticalSpacing
y2 VerticalSpacing -> [VerticalSpacing] -> [VerticalSpacing]
forall a. a -> [a] -> [a]
: [VerticalSpacing]
yr')
              SpecialCompare
Smaller -> VerticalSpacing
-> [VerticalSpacing] -> (VerticalSpacing, [VerticalSpacing])
go VerticalSpacing
y1 [VerticalSpacing]
yr
              SpecialCompare
Bigger  -> VerticalSpacing
-> [VerticalSpacing] -> (VerticalSpacing, [VerticalSpacing])
go VerticalSpacing
y2 [VerticalSpacing]
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 :: [VerticalSpacing] -> [VerticalSpacing]
filterAndLimit = Int -> [VerticalSpacing] -> [VerticalSpacing]
forall a. Int -> [a] -> [a]
take Int
limit
                           -- prune so we always consider a constant
                           -- amount of spacings per node of the BriDoc.
                         ([VerticalSpacing] -> [VerticalSpacing])
-> ([VerticalSpacing] -> [VerticalSpacing])
-> [VerticalSpacing]
-> [VerticalSpacing]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VerticalSpacing] -> [VerticalSpacing]
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.
                         ([VerticalSpacing] -> [VerticalSpacing])
-> ([VerticalSpacing] -> [VerticalSpacing])
-> [VerticalSpacing]
-> [VerticalSpacing]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerticalSpacing -> Bool) -> [VerticalSpacing] -> [VerticalSpacing]
forall a. (a -> Bool) -> [a] -> [a]
filter VerticalSpacing -> Bool
hasOkColCount
                           -- throw out any spacings (i.e. children) that
                           -- already use more columns than available in
                           -- total.
                         ([VerticalSpacing] -> [VerticalSpacing])
-> ([VerticalSpacing] -> [VerticalSpacing])
-> [VerticalSpacing]
-> [VerticalSpacing]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VerticalSpacing] -> [VerticalSpacing]
preFilterLimit
      [VerticalSpacing]
result <- case BriDocFInt
brdc of
        -- BDWrapAnnKey _annKey bd -> rec bd
        BriDocFInt
BDFEmpty ->
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
0 VerticalSpacingPar
VerticalSpacingParNone Bool
False]
        BDFLit Text
t ->
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing (Text -> Int
Text.length Text
t) VerticalSpacingPar
VerticalSpacingParNone Bool
False]
        BDFSeq [BriDocNumbered]
list ->
          ([VerticalSpacing] -> VerticalSpacing)
-> [[VerticalSpacing]] -> [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VerticalSpacing] -> VerticalSpacing
sumVs ([[VerticalSpacing]] -> [VerticalSpacing])
-> ([[VerticalSpacing]] -> [[VerticalSpacing]])
-> [[VerticalSpacing]]
-> [VerticalSpacing]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[VerticalSpacing]] -> [[VerticalSpacing]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([[VerticalSpacing]] -> [[VerticalSpacing]])
-> ([[VerticalSpacing]] -> [[VerticalSpacing]])
-> [[VerticalSpacing]]
-> [[VerticalSpacing]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([VerticalSpacing] -> [VerticalSpacing])
-> [[VerticalSpacing]] -> [[VerticalSpacing]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VerticalSpacing] -> [VerticalSpacing]
filterAndLimit ([[VerticalSpacing]] -> [VerticalSpacing])
-> StateCache
     (Container (Map Int [VerticalSpacing])) m [[VerticalSpacing]]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec (BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [BriDocNumbered]
-> StateCache
     (Container (Map Int [VerticalSpacing])) m [[VerticalSpacing]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [BriDocNumbered]
list
        BDFCols ColSig
_sig [BriDocNumbered]
list ->
          ([VerticalSpacing] -> VerticalSpacing)
-> [[VerticalSpacing]] -> [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VerticalSpacing] -> VerticalSpacing
sumVs ([[VerticalSpacing]] -> [VerticalSpacing])
-> ([[VerticalSpacing]] -> [[VerticalSpacing]])
-> [[VerticalSpacing]]
-> [VerticalSpacing]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[VerticalSpacing]] -> [[VerticalSpacing]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([[VerticalSpacing]] -> [[VerticalSpacing]])
-> ([[VerticalSpacing]] -> [[VerticalSpacing]])
-> [[VerticalSpacing]]
-> [[VerticalSpacing]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([VerticalSpacing] -> [VerticalSpacing])
-> [[VerticalSpacing]] -> [[VerticalSpacing]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VerticalSpacing] -> [VerticalSpacing]
filterAndLimit ([[VerticalSpacing]] -> [VerticalSpacing])
-> StateCache
     (Container (Map Int [VerticalSpacing])) m [[VerticalSpacing]]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec (BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [BriDocNumbered]
-> StateCache
     (Container (Map Int [VerticalSpacing])) m [[VerticalSpacing]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [BriDocNumbered]
list
        BriDocFInt
BDFSeparator ->
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
1 VerticalSpacingPar
VerticalSpacingParNone Bool
False]
        BDFAddBaseY BrIndent
indent BriDocNumbered
bd -> do
          [VerticalSpacing]
mVs <- BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [VerticalSpacing]
mVs [VerticalSpacing]
-> (VerticalSpacing -> VerticalSpacing) -> [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \VerticalSpacing
vs -> VerticalSpacing
vs
            { _vs_paragraph :: VerticalSpacingPar
_vs_paragraph = case VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
vs of
                VerticalSpacingPar
VerticalSpacingParNone -> VerticalSpacingPar
VerticalSpacingParNone
                VerticalSpacingParAlways Int
i -> Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ case BrIndent
indent of
                  BrIndent
BrIndentNone      -> Int
i
                  BrIndent
BrIndentRegular   -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ( Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
                                           (Identity (Last Int) -> Int) -> Identity (Last Int) -> Int
forall a b. (a -> b) -> a -> b
$ CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_indentAmount
                                           (CLayoutConfig Identity -> Identity (Last Int))
-> CLayoutConfig Identity -> Identity (Last Int)
forall a b. (a -> b) -> a -> b
$ Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout
                                           (Config -> CLayoutConfig Identity)
-> Config -> CLayoutConfig Identity
forall a b. (a -> b) -> a -> b
$ Config
config
                                           )
                  BrIndentSpecial Int
j -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j
                VerticalSpacingParSome Int
i -> Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ case BrIndent
indent of
                  BrIndent
BrIndentNone      -> Int
i
                  BrIndent
BrIndentRegular   -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ( Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
                                           (Identity (Last Int) -> Int) -> Identity (Last Int) -> Int
forall a b. (a -> b) -> a -> b
$ CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_indentAmount
                                           (CLayoutConfig Identity -> Identity (Last Int))
-> CLayoutConfig Identity -> Identity (Last Int)
forall a b. (a -> b) -> a -> b
$ Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout
                                           (Config -> CLayoutConfig Identity)
-> Config -> CLayoutConfig Identity
forall a b. (a -> b) -> a -> b
$ Config
config
                                           )
                  BrIndentSpecial Int
j -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j
            }
        BDFBaseYPushCur BriDocNumbered
bd -> do
          [VerticalSpacing]
mVs <- BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [VerticalSpacing]
mVs [VerticalSpacing]
-> (VerticalSpacing -> VerticalSpacing) -> [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \VerticalSpacing
vs -> VerticalSpacing
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 :: Int
_vs_sameLine = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (VerticalSpacing -> Int
_vs_sameLine VerticalSpacing
vs)
                                 (case VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
vs of
                                  VerticalSpacingPar
VerticalSpacingParNone -> Int
0
                                  VerticalSpacingParSome Int
i -> Int
i
                                  VerticalSpacingParAlways Int
i -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
colMax Int
i)
            , _vs_paragraph :: VerticalSpacingPar
_vs_paragraph = case VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
vs of
                VerticalSpacingPar
VerticalSpacingParNone -> VerticalSpacingPar
VerticalSpacingParNone
                VerticalSpacingParSome Int
i -> Int -> VerticalSpacingPar
VerticalSpacingParSome Int
i
                VerticalSpacingParAlways Int
i -> Int -> VerticalSpacingPar
VerticalSpacingParAlways Int
i
            }
        BDFBaseYPop BriDocNumbered
bd -> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
        BDFIndentLevelPushCur BriDocNumbered
bd -> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
        BDFIndentLevelPop BriDocNumbered
bd -> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
        BDFPar BrIndent
BrIndentNone BriDocNumbered
sameLine BriDocNumbered
indented -> do
          [VerticalSpacing]
mVss   <- [VerticalSpacing] -> [VerticalSpacing]
filterAndLimit ([VerticalSpacing] -> [VerticalSpacing])
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
sameLine
          [VerticalSpacing]
indSps <- [VerticalSpacing] -> [VerticalSpacing]
filterAndLimit ([VerticalSpacing] -> [VerticalSpacing])
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
indented
          let mVsIndSp :: [(VerticalSpacing, VerticalSpacing)]
mVsIndSp = Int
-> [(VerticalSpacing, VerticalSpacing)]
-> [(VerticalSpacing, VerticalSpacing)]
forall a. Int -> [a] -> [a]
take Int
limit
                       ([(VerticalSpacing, VerticalSpacing)]
 -> [(VerticalSpacing, VerticalSpacing)])
-> [(VerticalSpacing, VerticalSpacing)]
-> [(VerticalSpacing, VerticalSpacing)]
forall a b. (a -> b) -> a -> b
$ [ (VerticalSpacing
x,VerticalSpacing
y)
                         | VerticalSpacing
x<-[VerticalSpacing]
mVss
                         , VerticalSpacing
y<-[VerticalSpacing]
indSps
                         ]
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [(VerticalSpacing, VerticalSpacing)]
mVsIndSp [(VerticalSpacing, VerticalSpacing)]
-> ((VerticalSpacing, VerticalSpacing) -> VerticalSpacing)
-> [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
            \(VerticalSpacing Int
lsp VerticalSpacingPar
mPsp Bool
_, VerticalSpacing
indSp) ->
              Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing
                Int
lsp
                (case VerticalSpacingPar
mPsp of
                  VerticalSpacingParSome Int
psp ->
                    Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
psp (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ VerticalSpacing -> Int
getMaxVS VerticalSpacing
indSp -- TODO
                  VerticalSpacingPar
VerticalSpacingParNone -> VerticalSpacing -> VerticalSpacingPar
spMakePar VerticalSpacing
indSp
                  VerticalSpacingParAlways Int
psp ->
                    Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
psp (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ VerticalSpacing -> Int
getMaxVS VerticalSpacing
indSp)
                (  VerticalSpacingPar
mPsp VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacingPar
VerticalSpacingParNone
                Bool -> Bool -> Bool
&& VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
indSp VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacingPar
VerticalSpacingParNone
                Bool -> Bool -> Bool
&& VerticalSpacing -> Bool
_vs_parFlag VerticalSpacing
indSp
                )

        BDFPar{} -> String -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a. HasCallStack => String -> a
error String
"BDPar with indent in getSpacing"
        BDFAlt [] -> String -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a. HasCallStack => String -> a
error String
"empty BDAlt"
        -- BDAlt (alt:_) -> rec alt
        BDFAlt [BriDocNumbered]
alts -> do
          [[VerticalSpacing]]
r <- BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec (BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [BriDocNumbered]
-> StateCache
     (Container (Map Int [VerticalSpacing])) m [[VerticalSpacing]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [BriDocNumbered]
alts
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [VerticalSpacing] -> [VerticalSpacing]
filterAndLimit ([VerticalSpacing] -> [VerticalSpacing])
-> [[VerticalSpacing]] -> [VerticalSpacing]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[VerticalSpacing]]
r
        BDFForceMultiline  BriDocNumbered
bd -> do
          [VerticalSpacing]
mVs <- [VerticalSpacing] -> [VerticalSpacing]
filterAndLimit ([VerticalSpacing] -> [VerticalSpacing])
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ (VerticalSpacing -> Bool) -> [VerticalSpacing] -> [VerticalSpacing]
forall a. (a -> Bool) -> [a] -> [a]
filter ((VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
/=VerticalSpacingPar
VerticalSpacingParNone) (VerticalSpacingPar -> Bool)
-> (VerticalSpacing -> VerticalSpacingPar)
-> VerticalSpacing
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerticalSpacing -> VerticalSpacingPar
_vs_paragraph) [VerticalSpacing]
mVs
        BDFForceSingleline BriDocNumbered
bd -> do
          [VerticalSpacing]
mVs <- [VerticalSpacing] -> [VerticalSpacing]
filterAndLimit ([VerticalSpacing] -> [VerticalSpacing])
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ (VerticalSpacing -> Bool) -> [VerticalSpacing] -> [VerticalSpacing]
forall a. (a -> Bool) -> [a] -> [a]
filter ((VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
==VerticalSpacingPar
VerticalSpacingParNone) (VerticalSpacingPar -> Bool)
-> (VerticalSpacing -> VerticalSpacingPar)
-> VerticalSpacing
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerticalSpacing -> VerticalSpacingPar
_vs_paragraph) [VerticalSpacing]
mVs
        BDFForwardLineMode BriDocNumbered
bd -> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
        BDFExternal AnnKey
_ Set AnnKey
_ Bool
_ Text
txt | [Text
t] <- Text -> [Text]
Text.lines Text
txt ->
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing (Text -> Int
Text.length Text
t) VerticalSpacingPar
VerticalSpacingParNone Bool
False]
        BDFExternal{} ->
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [] -- yes, we just assume that we cannot properly layout
                      -- this.
        BDFPlain Text
t -> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return
          [ case Text -> [Text]
Text.lines Text
t of
              []       -> Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
0 VerticalSpacingPar
VerticalSpacingParNone Bool
False
              [Text
t1    ] -> Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing
                (Text -> Int
Text.length Text
t1)
                VerticalSpacingPar
VerticalSpacingParNone
                Bool
False
              (Text
t1 : [Text]
_) -> Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing
                (Text -> Int
Text.length Text
t1)
                (Int -> VerticalSpacingPar
VerticalSpacingParAlways Int
0)
                Bool
True
          | Bool
allowHangingQuasiQuotes
          ]
        BDFAnnotationPrior AnnKey
_annKey BriDocNumbered
bd -> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
        BDFAnnotationKW AnnKey
_annKey Maybe AnnKeywordId
_kw BriDocNumbered
bd -> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
        BDFAnnotationRest  AnnKey
_annKey BriDocNumbered
bd -> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
        BDFMoveToKWDP AnnKey
_annKey AnnKeywordId
_kw Bool
_b BriDocNumbered
bd -> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
        BDFLines [] -> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
0 VerticalSpacingPar
VerticalSpacingParNone Bool
False]
        BDFLines ls :: [BriDocNumbered]
ls@(BriDocNumbered
_:[BriDocNumbered]
_) -> 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].
          [[VerticalSpacing]]
lSpss <- ([VerticalSpacing] -> [VerticalSpacing])
-> [[VerticalSpacing]] -> [[VerticalSpacing]]
forall a b. (a -> b) -> [a] -> [b]
map [VerticalSpacing] -> [VerticalSpacing]
filterAndLimit ([[VerticalSpacing]] -> [[VerticalSpacing]])
-> StateCache
     (Container (Map Int [VerticalSpacing])) m [[VerticalSpacing]]
-> StateCache
     (Container (Map Int [VerticalSpacing])) m [[VerticalSpacing]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec (BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [BriDocNumbered]
-> StateCache
     (Container (Map Int [VerticalSpacing])) m [[VerticalSpacing]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [BriDocNumbered]
ls
          let worbled :: [[VerticalSpacing]]
worbled = ([VerticalSpacing] -> [VerticalSpacing])
-> [[VerticalSpacing]] -> [[VerticalSpacing]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [VerticalSpacing] -> [VerticalSpacing]
forall a. [a] -> [a]
reverse
                      ([[VerticalSpacing]] -> [[VerticalSpacing]])
-> [[VerticalSpacing]] -> [[VerticalSpacing]]
forall a b. (a -> b) -> a -> b
$ [[VerticalSpacing]] -> [[VerticalSpacing]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                      ([[VerticalSpacing]] -> [[VerticalSpacing]])
-> [[VerticalSpacing]] -> [[VerticalSpacing]]
forall a b. (a -> b) -> a -> b
$ [[VerticalSpacing]] -> [[VerticalSpacing]]
forall a. [a] -> [a]
reverse
                      ([[VerticalSpacing]] -> [[VerticalSpacing]])
-> [[VerticalSpacing]] -> [[VerticalSpacing]]
forall a b. (a -> b) -> a -> b
$ [[VerticalSpacing]]
lSpss
              sumF :: [VerticalSpacing] -> VerticalSpacing
sumF lSps :: [VerticalSpacing]
lSps@(VerticalSpacing
lSp1:[VerticalSpacing]
_) = Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing (VerticalSpacing -> Int
_vs_sameLine VerticalSpacing
lSp1)
                                                   (VerticalSpacing -> VerticalSpacingPar
spMakePar (VerticalSpacing -> VerticalSpacingPar)
-> VerticalSpacing -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ [VerticalSpacing] -> VerticalSpacing
maxVs [VerticalSpacing]
lSps)
                                                   Bool
False
              sumF [] = String -> VerticalSpacing
forall a. HasCallStack => String -> a
error (String -> VerticalSpacing) -> String -> VerticalSpacing
forall a b. (a -> b) -> a -> b
$ String
"should not happen. if my logic does not fail"
                             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"me, this follows from not (null ls)."
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [VerticalSpacing] -> VerticalSpacing
sumF ([VerticalSpacing] -> VerticalSpacing)
-> [[VerticalSpacing]] -> [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[VerticalSpacing]]
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 BrIndent
indent BriDocNumbered
bd -> do
          [VerticalSpacing]
mVs <- BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
          let addInd :: Int
addInd = case BrIndent
indent of
                BrIndent
BrIndentNone      -> Int
0
                BrIndent
BrIndentRegular   -> Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
                                   (Identity (Last Int) -> Int) -> Identity (Last Int) -> Int
forall a b. (a -> b) -> a -> b
$ CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_indentAmount
                                   (CLayoutConfig Identity -> Identity (Last Int))
-> CLayoutConfig Identity -> Identity (Last Int)
forall a b. (a -> b) -> a -> b
$ Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout
                                   (Config -> CLayoutConfig Identity)
-> Config -> CLayoutConfig Identity
forall a b. (a -> b) -> a -> b
$ Config
config
                BrIndentSpecial Int
i -> Int
i
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [VerticalSpacing]
mVs [VerticalSpacing]
-> (VerticalSpacing -> VerticalSpacing) -> [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(VerticalSpacing Int
lsp VerticalSpacingPar
psp Bool
parFlag) ->
            Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing (Int
lsp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
addInd) VerticalSpacingPar
psp Bool
parFlag
        BDFNonBottomSpacing Bool
b BriDocNumbered
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.
          [VerticalSpacing]
mVs <- BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ if [VerticalSpacing] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VerticalSpacing]
mVs
            then [Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing
                    Int
0
                    (if Bool
b then Int -> VerticalSpacingPar
VerticalSpacingParSome Int
0
                          else Int -> VerticalSpacingPar
VerticalSpacingParAlways Int
colMax
                    )
                    Bool
False
                 ]
            else [VerticalSpacing]
mVs [VerticalSpacing]
-> (VerticalSpacing -> VerticalSpacing) -> [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \VerticalSpacing
vs -> VerticalSpacing
vs
              { _vs_sameLine :: Int
_vs_sameLine = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
colMax (VerticalSpacing -> Int
_vs_sameLine VerticalSpacing
vs)
              , _vs_paragraph :: VerticalSpacingPar
_vs_paragraph = case VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
vs of
                  VerticalSpacingPar
VerticalSpacingParNone -> VerticalSpacingPar
VerticalSpacingParNone
                  VerticalSpacingParAlways Int
i
                    | Bool
b         -> Int -> VerticalSpacingPar
VerticalSpacingParSome Int
0
                    | Bool
otherwise -> Int -> VerticalSpacingPar
VerticalSpacingParAlways Int
i
                  VerticalSpacingParSome Int
i
                    | Bool
b         -> Int -> VerticalSpacingPar
VerticalSpacingParSome Int
0
                    | Bool
otherwise -> Int -> VerticalSpacingPar
VerticalSpacingParAlways Int
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 BriDocNumbered
bd -> do
          [VerticalSpacing]
mVs <- BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [VerticalSpacing]
mVs [VerticalSpacing]
-> (VerticalSpacing -> VerticalSpacing) -> [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \VerticalSpacing
vs -> VerticalSpacing
vs { _vs_parFlag :: Bool
_vs_parFlag = Bool
True }
        BDFForceParSpacing BriDocNumbered
bd -> do
          [VerticalSpacing]
mVs <- [VerticalSpacing] -> [VerticalSpacing]
preFilterLimit ([VerticalSpacing] -> [VerticalSpacing])
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return ([VerticalSpacing]
 -> MemoT Int [VerticalSpacing] m [VerticalSpacing])
-> [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall a b. (a -> b) -> a -> b
$ [ VerticalSpacing
vs | VerticalSpacing
vs <- [VerticalSpacing]
mVs, VerticalSpacing -> Bool
_vs_parFlag VerticalSpacing
vs Bool -> Bool -> Bool
|| VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
vs VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacingPar
VerticalSpacingParNone ]
        BDFDebug String
s BriDocNumbered
bd -> do
          [VerticalSpacing]
r <- BriDocNumbered -> MemoT Int [VerticalSpacing] m [VerticalSpacing]
rec BriDocNumbered
bd
          String -> StateCache (Container (Map Int [VerticalSpacing])) m ()
forall (m :: * -> *).
MonadMultiWriter (Seq String) m =>
String -> m ()
tellDebugMess (String -> StateCache (Container (Map Int [VerticalSpacing])) m ())
-> String
-> StateCache (Container (Map Int [VerticalSpacing])) m ()
forall a b. (a -> b) -> a -> b
$ String
"getSpacings: BDFDebug " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (node-id=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
brDcId String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): vs=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [VerticalSpacing] -> String
forall a. Show a => a -> String
show (Int -> [VerticalSpacing] -> [VerticalSpacing]
forall a. Int -> [a] -> [a]
take Int
9 [VerticalSpacing]
r)
          [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return [VerticalSpacing]
r
#if INSERTTRACESGETSPACING
      case brdc of
        BDFAnnotationPrior{} -> return ()
        BDFAnnotationRest{} -> return ()
        _ -> mTell $ Seq.fromList ["getSpacings: visiting: "
                            ++ show (toConstr $ brdc) -- (briDocToDoc $ unwrapBriDocNumbered (0, brdc))
                           , " -> "
                            ++ show (take 9 result)
                           ]
#endif
      [VerticalSpacing]
-> MemoT Int [VerticalSpacing] m [VerticalSpacing]
forall (m :: * -> *) a. Monad m => a -> m a
return [VerticalSpacing]
result
    maxVs :: [VerticalSpacing] -> VerticalSpacing
    maxVs :: [VerticalSpacing] -> VerticalSpacing
maxVs = (VerticalSpacing -> VerticalSpacing -> VerticalSpacing)
-> VerticalSpacing -> [VerticalSpacing] -> VerticalSpacing
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
      (\(VerticalSpacing Int
x1 VerticalSpacingPar
x2 Bool
_) (VerticalSpacing Int
y1 VerticalSpacingPar
y2 Bool
_) ->
          Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing
            (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x1 Int
y1)
            (case (VerticalSpacingPar
x2, VerticalSpacingPar
y2) of
              (VerticalSpacingPar
x, VerticalSpacingPar
VerticalSpacingParNone) -> VerticalSpacingPar
x
              (VerticalSpacingPar
VerticalSpacingParNone, VerticalSpacingPar
x) -> VerticalSpacingPar
x
              (VerticalSpacingParAlways Int
i, VerticalSpacingParAlways Int
j) ->
                Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i Int
j
              (VerticalSpacingParAlways Int
i, VerticalSpacingParSome Int
j) ->
                Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i Int
j
              (VerticalSpacingParSome Int
i, VerticalSpacingParAlways Int
j) ->
                Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i Int
j
              (VerticalSpacingParSome Int
x, VerticalSpacingParSome Int
y) ->
                Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
y)
            Bool
False)
      (Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
0 VerticalSpacingPar
VerticalSpacingParNone Bool
False)
    sumVs :: [VerticalSpacing] -> VerticalSpacing
    sumVs :: [VerticalSpacing] -> VerticalSpacing
sumVs [VerticalSpacing]
sps = (VerticalSpacing -> VerticalSpacing -> VerticalSpacing)
-> VerticalSpacing -> [VerticalSpacing] -> VerticalSpacing
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' VerticalSpacing -> VerticalSpacing -> VerticalSpacing
go VerticalSpacing
initial [VerticalSpacing]
sps
     where
      go :: VerticalSpacing -> VerticalSpacing -> VerticalSpacing
go (VerticalSpacing Int
x1 VerticalSpacingPar
x2 Bool
x3) (VerticalSpacing Int
y1 VerticalSpacingPar
y2 Bool
_) = Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing
        (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y1)
        (case (VerticalSpacingPar
x2, VerticalSpacingPar
y2) of
          (VerticalSpacingPar
x, VerticalSpacingPar
VerticalSpacingParNone) -> VerticalSpacingPar
x
          (VerticalSpacingPar
VerticalSpacingParNone, VerticalSpacingPar
x) -> VerticalSpacingPar
x
          (VerticalSpacingParAlways Int
i, VerticalSpacingParAlways Int
j) ->
            Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j
          (VerticalSpacingParAlways Int
i, VerticalSpacingParSome Int
j) ->
            Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j
          (VerticalSpacingParSome Int
i, VerticalSpacingParAlways Int
j) ->
            Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j
          (VerticalSpacingParSome Int
x, VerticalSpacingParSome Int
y) -> Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
        Bool
x3
      singleline :: VerticalSpacing -> Bool
singleline VerticalSpacing
x = VerticalSpacing -> VerticalSpacingPar
_vs_paragraph VerticalSpacing
x VerticalSpacingPar -> VerticalSpacingPar -> Bool
forall a. Eq a => a -> a -> Bool
== VerticalSpacingPar
VerticalSpacingParNone
      isPar :: VerticalSpacing -> Bool
isPar      VerticalSpacing
x = VerticalSpacing -> Bool
_vs_parFlag VerticalSpacing
x
      parFlag :: Bool
parFlag = case [VerticalSpacing]
sps of
        [] -> Bool
True
        [VerticalSpacing]
_ -> (VerticalSpacing -> Bool) -> [VerticalSpacing] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all VerticalSpacing -> Bool
singleline ([VerticalSpacing] -> [VerticalSpacing]
forall a. [a] -> [a]
List.init [VerticalSpacing]
sps) Bool -> Bool -> Bool
&& VerticalSpacing -> Bool
isPar ([VerticalSpacing] -> VerticalSpacing
forall a. [a] -> a
List.last [VerticalSpacing]
sps)
      initial :: VerticalSpacing
initial = Int -> VerticalSpacingPar -> Bool -> VerticalSpacing
VerticalSpacing Int
0 VerticalSpacingPar
VerticalSpacingParNone Bool
parFlag
    getMaxVS :: VerticalSpacing -> Int
    getMaxVS :: VerticalSpacing -> Int
getMaxVS (VerticalSpacing Int
x1 VerticalSpacingPar
x2 Bool
_) = Int
x1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` case VerticalSpacingPar
x2 of
      VerticalSpacingParSome Int
i -> Int
i
      VerticalSpacingPar
VerticalSpacingParNone -> Int
0
      VerticalSpacingParAlways Int
i -> Int
i
    spMakePar :: VerticalSpacing -> VerticalSpacingPar
    spMakePar :: VerticalSpacing -> VerticalSpacingPar
spMakePar (VerticalSpacing Int
x1 VerticalSpacingPar
x2 Bool
_) = case VerticalSpacingPar
x2 of
      VerticalSpacingParSome Int
i -> Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
x1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
i
      VerticalSpacingPar
VerticalSpacingParNone -> Int -> VerticalSpacingPar
VerticalSpacingParSome (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
x1
      VerticalSpacingParAlways Int
i -> Int -> VerticalSpacingPar
VerticalSpacingParAlways (Int -> VerticalSpacingPar) -> Int -> VerticalSpacingPar
forall a b. (a -> b) -> a -> b
$ Int
x1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
i

fixIndentationForMultiple
  :: (MonadMultiReader (CConfig Identity) m) => AltCurPos -> BrIndent -> m Int
fixIndentationForMultiple :: AltCurPos -> BrIndent -> m Int
fixIndentationForMultiple AltCurPos
acp BrIndent
indent = do
  Int
indAmount <- m Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk m Config -> (Config -> Int) -> m Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout (Config -> CLayoutConfig Identity)
-> (CLayoutConfig Identity -> Identity (Last Int))
-> Config
-> Identity (Last Int)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_indentAmount (Config -> Identity (Last Int))
-> (Identity (Last Int) -> Int) -> Config -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
  let indAddRaw :: Int
indAddRaw = case BrIndent
indent of
        BrIndent
BrIndentNone      -> Int
0
        BrIndent
BrIndentRegular   -> Int
indAmount
        BrIndentSpecial Int
i -> Int
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.
  IndentPolicy
indPolicy <- m Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk m Config -> (Config -> IndentPolicy) -> m IndentPolicy
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout (Config -> CLayoutConfig Identity)
-> (CLayoutConfig Identity -> Identity (Last IndentPolicy))
-> Config
-> Identity (Last IndentPolicy)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> CLayoutConfig Identity -> Identity (Last IndentPolicy)
forall (f :: * -> *). CLayoutConfig f -> f (Last IndentPolicy)
_lconfig_indentPolicy (Config -> Identity (Last IndentPolicy))
-> (Identity (Last IndentPolicy) -> IndentPolicy)
-> Config
-> IndentPolicy
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Identity (Last IndentPolicy) -> IndentPolicy
forall a b. Coercible a b => Identity a -> b
confUnpack
  Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ if IndentPolicy
indPolicy IndentPolicy -> IndentPolicy -> Bool
forall a. Eq a => a -> a -> Bool
== IndentPolicy
IndentPolicyMultiple
    then
      let indAddMultiple1 :: Int
indAddMultiple1 =
            Int
indAddRaw Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((AltCurPos -> Int
_acp_indent AltCurPos
acp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indAddRaw) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
indAmount)
          indAddMultiple2 :: Int
indAddMultiple2 = if Int
indAddMultiple1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
            then Int
indAddMultiple1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indAmount
            else Int
indAddMultiple1
      in  Int
indAddMultiple2
    else Int
indAddRaw