#define INSERTTRACES 0

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeApplications #-}
#if !INSERTTRACES
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
#endif

module Language.Haskell.Brittany.Internal.BackendUtils
  ( layoutWriteAppend
  , layoutWriteAppendMultiline
  , layoutWriteNewlineBlock
  , layoutWriteNewline
  , layoutWriteEnsureNewlineBlock
  , layoutWriteEnsureBlock
  , layoutWithAddBaseCol
  , layoutWithAddBaseColBlock
  , layoutWithAddBaseColN
  , layoutWithAddBaseColNBlock
  , layoutBaseYPushCur
  , layoutBaseYPop
  , layoutIndentLevelPushCur
  , layoutIndentLevelPop
  , layoutWriteEnsureAbsoluteN
  , layoutAddSepSpace
  , layoutSetCommentCol
  , layoutMoveToCommentPos
  , layoutIndentRestorePostComment
  , moveToExactAnn
  , moveToY
  , ppmMoveToExactLoc
  , layoutWritePriorComments
  , layoutWritePostComments
  , layoutRemoveIndentLevelLinger
  )
where


#include "prelude.inc"

import           Language.Haskell.Brittany.Internal.Types
import           Language.Haskell.Brittany.Internal.Config.Types
import           Language.Haskell.GHC.ExactPrint.Types ( AnnKey
                                                       , Annotation
                                                       , KeywordId
                                                       )

import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
import           Language.Haskell.Brittany.Internal.Utils

import           GHC ( Located, GenLocated(L), moduleNameString )



traceLocal
  :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m, Show a)
  => a
  -> m ()
#if INSERTTRACES
traceLocal x = do
  mGet >>= tellDebugMessShow @LayoutState
  tellDebugMessShow x
#else
traceLocal :: a -> m ()
traceLocal a
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif


layoutWriteAppend
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => Text
  -> m ()
layoutWriteAppend :: Text -> m ()
layoutWriteAppend Text
t = do
  ([Char], Text) -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutWriteAppend", Text
t)
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  case LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state of
    Right Int
i -> do
#if INSERTTRACES
      tellDebugMessShow ("  inserted newlines: ", i)
#endif
      Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
i (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Builder -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Builder
Text.Builder.fromString ([Char] -> Builder) -> [Char] -> Builder
forall a b. (a -> b) -> a -> b
$ [Char]
"\n"
    Left{} -> do
#if INSERTTRACES
      tellDebugMessShow ("  inserted no newlines")
#endif
      () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  let spaces :: Int
spaces = case LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state of
        Just Int
i -> Int
i
        Maybe Int
Nothing -> Int
0
#if INSERTTRACES
  tellDebugMessShow ("  inserted spaces: ", spaces)
#endif
  Builder -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder
Text.Builder.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
spaces Char
' ')
  Builder -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder
Text.Builder.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text
t
  (LayoutState -> LayoutState) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((LayoutState -> LayoutState) -> m ())
-> (LayoutState -> LayoutState) -> m ()
forall a b. (a -> b) -> a -> b
$ \LayoutState
s -> LayoutState
s
    { _lstate_curYOrAddNewline :: Either Int Int
_lstate_curYOrAddNewline = Int -> Either Int Int
forall a b. a -> Either a b
Left (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ case LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
s of
        Left Int
c -> Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
Text.length Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaces
        Right{} -> Text -> Int
Text.length Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spaces
    , _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace = Maybe Int
forall a. Maybe a
Nothing
    }

layoutWriteAppendSpaces
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => Int
  -> m ()
layoutWriteAppendSpaces :: Int -> m ()
layoutWriteAppendSpaces Int
i = do
  ([Char], Int) -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutWriteAppendSpaces", Int
i)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
    LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (LayoutState -> m ()) -> LayoutState -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState
state
      { _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
i (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state
      }

layoutWriteAppendMultiline
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => [Text]
  -> m ()
layoutWriteAppendMultiline :: [Text] -> m ()
layoutWriteAppendMultiline [Text]
ts = do
  ([Char], [Text]) -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutWriteAppendMultiline", [Text]
ts)
  case [Text]
ts of
    []     -> Text -> m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
Text -> m ()
layoutWriteAppend ([Char] -> Text
Text.pack [Char]
"") -- need to write empty, too.
    (Text
l:[Text]
lr) -> do
      Text -> m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
Text -> m ()
layoutWriteAppend Text
l
      [Text]
lr [Text] -> (Text -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \Text
x -> do
        m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutWriteNewline
        Text -> m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
Text -> m ()
layoutWriteAppend Text
x

-- adds a newline and adds spaces to reach the base column.
layoutWriteNewlineBlock
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => m ()
layoutWriteNewlineBlock :: m ()
layoutWriteNewlineBlock = do
  [Char] -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutWriteNewlineBlock")
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (LayoutState -> m ()) -> LayoutState -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState
state { _lstate_curYOrAddNewline :: Either Int Int
_lstate_curYOrAddNewline = Int -> Either Int Int
forall a b. b -> Either a b
Right Int
1
               , _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace      = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ LayoutState -> Int
lstate_baseY LayoutState
state
               }

-- layoutMoveToIndentCol :: ( MonadMultiState LayoutState m
--                     , MonadMultiWriter (Seq String) m) => Int -> m ()
-- layoutMoveToIndentCol i = do
-- #if INSERTTRACES
--   tellDebugMessShow ("layoutMoveToIndentCol", i)
-- #endif
--   state <- mGet
--   mSet $ state
--     { _lstate_addSepSpace = Just
--                           $ if isJust $ _lstate_addNewline state
--         then i 
--         else _lstate_indLevelLinger state + i - _lstate_curY state
--     }

layoutSetCommentCol
  :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
layoutSetCommentCol :: m ()
layoutSetCommentCol = do
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  let col :: Int
col = case LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state of
        Left Int
i  -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state)
        Right{} -> LayoutState -> Int
lstate_baseY LayoutState
state
  ([Char], Int) -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutSetCommentCol", Int
col)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Int -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ LayoutState -> Maybe Int
_lstate_commentCol LayoutState
state)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet LayoutState
state { _lstate_commentCol :: Maybe Int
_lstate_commentCol = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
col }

-- This is also used to move to non-comments in a couple of places. Seems
-- to be harmless so far..
layoutMoveToCommentPos
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => Int
  -> Int
  -> Int
  -> m ()
layoutMoveToCommentPos :: Int -> Int -> Int -> m ()
layoutMoveToCommentPos Int
y Int
x Int
commentLines = do
  ([Char], Int, Int, Int) -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutMoveToCommentPos", Int
y, Int
x, Int
commentLines)
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet LayoutState
state
    { _lstate_curYOrAddNewline :: Either Int Int
_lstate_curYOrAddNewline = case LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state of
      Left Int
i  -> if Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int -> Either Int Int
forall a b. a -> Either a b
Left Int
i else Int -> Either Int Int
forall a b. b -> Either a b
Right Int
y
      Right{} -> Int -> Either Int Int
forall a b. b -> Either a b
Right Int
y
    , _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace      =
      Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ if Maybe Int -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isJust (LayoutState -> Maybe Int
_lstate_commentCol LayoutState
state)
        then case LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state of
          Left{}  -> if Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
x else LayoutState -> Int
_lstate_indLevelLinger LayoutState
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
          Right{} -> LayoutState -> Int
_lstate_indLevelLinger LayoutState
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
        else if Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
x else LayoutState -> Int
_lstate_indLevelLinger LayoutState
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
    , _lstate_commentCol :: Maybe Int
_lstate_commentCol       =
      Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ case LayoutState -> Maybe Int
_lstate_commentCol LayoutState
state of
        Just Int
existing -> Int
existing
        Maybe Int
Nothing -> case LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state of
          Left Int
i  -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state)
          Right{} -> LayoutState -> Int
lstate_baseY LayoutState
state
    , _lstate_commentNewlines :: Int
_lstate_commentNewlines =
        LayoutState -> Int
_lstate_commentNewlines LayoutState
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
commentLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    }

-- | does _not_ add spaces to again reach the current base column.
layoutWriteNewline
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => m ()
layoutWriteNewline :: m ()
layoutWriteNewline = do
  [Char] -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutWriteNewline")
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (LayoutState -> m ()) -> LayoutState -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState
state
    { _lstate_curYOrAddNewline :: Either Int Int
_lstate_curYOrAddNewline = case LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state of
      Left{}  -> Int -> Either Int Int
forall a b. b -> Either a b
Right Int
1
      Right Int
i -> Int -> Either Int Int
forall a b. b -> Either a b
Right (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    , _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace      = Maybe Int
forall a. Maybe a
Nothing
    }

_layoutResetCommentNewlines :: MonadMultiState LayoutState m => m ()
_layoutResetCommentNewlines :: m ()
_layoutResetCommentNewlines = do
  (LayoutState -> LayoutState) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((LayoutState -> LayoutState) -> m ())
-> (LayoutState -> LayoutState) -> m ()
forall a b. (a -> b) -> a -> b
$ \LayoutState
state -> LayoutState
state { _lstate_commentNewlines :: Int
_lstate_commentNewlines = Int
0 }

layoutWriteEnsureNewlineBlock
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => m ()
layoutWriteEnsureNewlineBlock :: m ()
layoutWriteEnsureNewlineBlock = do
  [Char] -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutWriteEnsureNewlineBlock")
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (LayoutState -> m ()) -> LayoutState -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState
state
    { _lstate_curYOrAddNewline :: Either Int Int
_lstate_curYOrAddNewline = case LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state of
      Left{}  -> Int -> Either Int Int
forall a b. b -> Either a b
Right Int
1
      Right Int
i -> Int -> Either Int Int
forall a b. b -> Either a b
Right (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
i
    , _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace      = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ LayoutState -> Int
lstate_baseY LayoutState
state
    , _lstate_commentCol :: Maybe Int
_lstate_commentCol       = Maybe Int
forall a. Maybe a
Nothing
    }

layoutWriteEnsureAbsoluteN
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => Int
  -> m ()
layoutWriteEnsureAbsoluteN :: Int -> m ()
layoutWriteEnsureAbsoluteN Int
n = do
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  let diff :: Int
diff = case (LayoutState -> Maybe Int
_lstate_commentCol LayoutState
state, LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state) of
        (Just Int
c , Either Int Int
_      ) -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c
        (Maybe Int
Nothing, Left Int
i ) -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
        (Maybe Int
Nothing, Right{}) -> Int
n
  ([Char], Int, Int) -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutWriteEnsureAbsoluteN", Int
n, Int
diff)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
diff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (LayoutState -> m ()) -> LayoutState -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState
state { _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
diff -- this always sets to
                                            -- at least (Just 1), so we won't
                                            -- overwrite any old value in any
                                            -- bad way.
                 }

layoutBaseYPushInternal
  :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m)
  => Int
  -> m ()
layoutBaseYPushInternal :: Int -> m ()
layoutBaseYPushInternal Int
i = do
  ([Char], Int) -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutBaseYPushInternal", Int
i)
  (LayoutState -> LayoutState) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((LayoutState -> LayoutState) -> m ())
-> (LayoutState -> LayoutState) -> m ()
forall a b. (a -> b) -> a -> b
$ \LayoutState
s -> LayoutState
s { _lstate_baseYs :: [Int]
_lstate_baseYs = Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: LayoutState -> [Int]
_lstate_baseYs LayoutState
s }

layoutBaseYPopInternal
  :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
layoutBaseYPopInternal :: m ()
layoutBaseYPopInternal = do
  [Char] -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutBaseYPopInternal")
  (LayoutState -> LayoutState) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((LayoutState -> LayoutState) -> m ())
-> (LayoutState -> LayoutState) -> m ()
forall a b. (a -> b) -> a -> b
$ \LayoutState
s -> LayoutState
s { _lstate_baseYs :: [Int]
_lstate_baseYs = [Int] -> [Int]
forall a. [a] -> [a]
List.tail ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ LayoutState -> [Int]
_lstate_baseYs LayoutState
s }

layoutIndentLevelPushInternal
  :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m)
  => Int
  -> m ()
layoutIndentLevelPushInternal :: Int -> m ()
layoutIndentLevelPushInternal Int
i = do
  ([Char], Int) -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutIndentLevelPushInternal", Int
i)
  (LayoutState -> LayoutState) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((LayoutState -> LayoutState) -> m ())
-> (LayoutState -> LayoutState) -> m ()
forall a b. (a -> b) -> a -> b
$ \LayoutState
s -> LayoutState
s { _lstate_indLevelLinger :: Int
_lstate_indLevelLinger = LayoutState -> Int
lstate_indLevel LayoutState
s
                    , _lstate_indLevels :: [Int]
_lstate_indLevels      = Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: LayoutState -> [Int]
_lstate_indLevels LayoutState
s
                    }

layoutIndentLevelPopInternal
  :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
layoutIndentLevelPopInternal :: m ()
layoutIndentLevelPopInternal = do
  [Char] -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutIndentLevelPopInternal")
  (LayoutState -> LayoutState) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((LayoutState -> LayoutState) -> m ())
-> (LayoutState -> LayoutState) -> m ()
forall a b. (a -> b) -> a -> b
$ \LayoutState
s -> LayoutState
s { _lstate_indLevelLinger :: Int
_lstate_indLevelLinger = LayoutState -> Int
lstate_indLevel LayoutState
s
                    , _lstate_indLevels :: [Int]
_lstate_indLevels      = [Int] -> [Int]
forall a. [a] -> [a]
List.tail ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ LayoutState -> [Int]
_lstate_indLevels LayoutState
s
                    }

layoutRemoveIndentLevelLinger :: ( MonadMultiState LayoutState m
             , MonadMultiWriter (Seq String) m
             ) => m ()
layoutRemoveIndentLevelLinger :: m ()
layoutRemoveIndentLevelLinger = do
#if INSERTTRACES
  tellDebugMessShow ("layoutRemoveIndentLevelLinger")
#endif
  (LayoutState -> LayoutState) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((LayoutState -> LayoutState) -> m ())
-> (LayoutState -> LayoutState) -> m ()
forall a b. (a -> b) -> a -> b
$ \LayoutState
s -> LayoutState
s { _lstate_indLevelLinger :: Int
_lstate_indLevelLinger = LayoutState -> Int
lstate_indLevel LayoutState
s
                    }

layoutWithAddBaseCol
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiReader Config m
     , MonadMultiWriter (Seq String) m
     )
  => m ()
  -> m ()
layoutWithAddBaseCol :: m () -> m ()
layoutWithAddBaseCol m ()
m = do
#if INSERTTRACES
  tellDebugMessShow ("layoutWithAddBaseCol")
#endif
  Int
amount <- m (CConfig Identity)
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk m (CConfig Identity) -> (CConfig Identity -> Int) -> m Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CConfig Identity -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout (CConfig Identity -> CLayoutConfig Identity)
-> (CLayoutConfig Identity -> Identity (Last Int))
-> CConfig Identity
-> 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 (CConfig Identity -> Identity (Last Int))
-> (Identity (Last Int) -> Int) -> CConfig Identity -> 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
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  Int -> m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutBaseYPushInternal (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState -> Int
lstate_baseY LayoutState
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amount
  m ()
m
  m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutBaseYPopInternal

layoutWithAddBaseColBlock
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiReader Config m
     , MonadMultiWriter (Seq String) m
     )
  => m ()
  -> m ()
layoutWithAddBaseColBlock :: m () -> m ()
layoutWithAddBaseColBlock m ()
m = do
#if INSERTTRACES
  tellDebugMessShow ("layoutWithAddBaseColBlock")
#endif
  Int
amount <- m (CConfig Identity)
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk m (CConfig Identity) -> (CConfig Identity -> Int) -> m Int
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CConfig Identity -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout (CConfig Identity -> CLayoutConfig Identity)
-> (CLayoutConfig Identity -> Identity (Last Int))
-> CConfig Identity
-> 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 (CConfig Identity -> Identity (Last Int))
-> (Identity (Last Int) -> Int) -> CConfig Identity -> 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
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  Int -> m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutBaseYPushInternal (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState -> Int
lstate_baseY LayoutState
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amount
  m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutWriteEnsureBlock
  m ()
m
  m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutBaseYPopInternal

layoutWithAddBaseColNBlock
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => Int
  -> m ()
  -> m ()
layoutWithAddBaseColNBlock :: Int -> m () -> m ()
layoutWithAddBaseColNBlock Int
amount m ()
m = do
  ([Char], Int) -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutWithAddBaseColNBlock", Int
amount)
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  Int -> m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutBaseYPushInternal (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState -> Int
lstate_baseY LayoutState
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amount
  m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutWriteEnsureBlock
  m ()
m
  m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutBaseYPopInternal

layoutWriteEnsureBlock
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => m ()
layoutWriteEnsureBlock :: m ()
layoutWriteEnsureBlock = do
  [Char] -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutWriteEnsureBlock")
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  let
    diff :: Int
diff = case (LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state, LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state) of
      (Maybe Int
Nothing, Left Int
i ) -> LayoutState -> Int
lstate_baseY LayoutState
state Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
      (Maybe Int
Nothing, Right{}) -> LayoutState -> Int
lstate_baseY LayoutState
state
      (Just Int
sp, Left Int
i ) -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
sp (LayoutState -> Int
lstate_baseY LayoutState
state Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
      (Just Int
sp, Right{}) -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
sp (LayoutState -> Int
lstate_baseY LayoutState
state)
  -- when (diff>0) $ layoutWriteNewlineBlock
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
diff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (LayoutState -> m ()) -> LayoutState -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState
state { _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
diff }

layoutWithAddBaseColN
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => Int
  -> m ()
  -> m ()
layoutWithAddBaseColN :: Int -> m () -> m ()
layoutWithAddBaseColN Int
amount m ()
m = do
#if INSERTTRACES
  tellDebugMessShow ("layoutWithAddBaseColN", amount)
#endif
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  Int -> m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutBaseYPushInternal (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState -> Int
lstate_baseY LayoutState
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amount
  m ()
m
  m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutBaseYPopInternal

layoutBaseYPushCur
  :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
layoutBaseYPushCur :: m ()
layoutBaseYPushCur = do
  [Char] -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutBaseYPushCur")
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  case LayoutState -> Maybe Int
_lstate_commentCol LayoutState
state of
    Maybe Int
Nothing ->
      case (LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state, LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state) of
        (Left Int
i , Just Int
j ) -> Int -> m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutBaseYPushInternal (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j)
        (Left Int
i , Maybe Int
Nothing) -> Int -> m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutBaseYPushInternal Int
i
        (Right{}, Maybe Int
_      ) -> Int -> m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutBaseYPushInternal (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState -> Int
lstate_baseY LayoutState
state
    Just Int
cCol -> Int -> m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutBaseYPushInternal Int
cCol

layoutBaseYPop
  :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
layoutBaseYPop :: m ()
layoutBaseYPop = do
  [Char] -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutBaseYPop")
  m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutBaseYPopInternal

layoutIndentLevelPushCur
  :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
layoutIndentLevelPushCur :: m ()
layoutIndentLevelPushCur = do
  [Char] -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutIndentLevelPushCur")
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  let y :: Int
y = case (LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state, LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state) of
        (Left Int
i , Just Int
j ) -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j
        (Left Int
i , Maybe Int
Nothing) -> Int
i
        (Right{}, Just Int
j ) -> Int
j
        (Right{}, Maybe Int
Nothing) -> Int
0
  Int -> m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutIndentLevelPushInternal Int
y

layoutIndentLevelPop
  :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m) => m ()
layoutIndentLevelPop :: m ()
layoutIndentLevelPop = do
  [Char] -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"layoutIndentLevelPop")
  m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutIndentLevelPopInternal
  -- why are comment indentations relative to the previous indentation on
  -- the first node of an additional indentation, and relative to the outer
  -- indentation after the last node of some indented stuff? sure does not
  -- make sense.
  m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutRemoveIndentLevelLinger

layoutAddSepSpace :: (MonadMultiState LayoutState m
  , MonadMultiWriter (Seq String) m)
   => m ()
layoutAddSepSpace :: m ()
layoutAddSepSpace = do
#if INSERTTRACES
  tellDebugMessShow ("layoutAddSepSpace")
#endif
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (LayoutState -> m ()) -> LayoutState -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState
state
    { _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state }

-- TODO: when refactoring is complete, the other version of this method
-- can probably be removed.
moveToExactAnn
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiReader (Map AnnKey Annotation) m
     , MonadMultiWriter (Seq String) m
     )
  => AnnKey
  -> m ()
moveToExactAnn :: AnnKey -> m ()
moveToExactAnn AnnKey
annKey = do
  ([Char], AnnKey) -> m ()
forall (m :: * -> *) a.
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m,
 Show a) =>
a -> m ()
traceLocal ([Char]
"moveToExactAnn", AnnKey
annKey)
  Map AnnKey Annotation
anns <- m (Map AnnKey Annotation)
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
  case AnnKey -> Map AnnKey Annotation -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
annKey Map AnnKey Annotation
anns of
    Maybe Annotation
Nothing  -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Annotation
ann -> do
      -- curY <- mGet <&> _lstate_curY
      let ExactPrint.DP (Int
y, Int
_x) = Annotation -> DeltaPos
ExactPrint.annEntryDelta Annotation
ann
      -- mModify $ \state -> state { _lstate_addNewline = Just x }
      Int -> m ()
forall (m :: * -> *). MonadMultiState LayoutState m => Int -> m ()
moveToY Int
y

moveToY :: MonadMultiState LayoutState m => Int -> m ()
moveToY :: Int -> m ()
moveToY Int
y = (LayoutState -> LayoutState) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((LayoutState -> LayoutState) -> m ())
-> (LayoutState -> LayoutState) -> m ()
forall a b. (a -> b) -> a -> b
$ \LayoutState
state ->
  let upd :: Either Int Int
upd = case LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state of
        Left  Int
i -> if Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int -> Either Int Int
forall a b. a -> Either a b
Left Int
i else Int -> Either Int Int
forall a b. b -> Either a b
Right Int
y
        Right Int
i -> Int -> Either Int Int
forall a b. b -> Either a b
Right (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
y Int
i
  in  LayoutState
state
        { _lstate_curYOrAddNewline :: Either Int Int
_lstate_curYOrAddNewline = Either Int Int
upd
        , _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace      = if Either Int Int -> Bool
forall a b. Either a b -> Bool
Data.Either.isRight Either Int Int
upd
                                       then
                                         LayoutState -> Maybe Int
_lstate_commentCol LayoutState
state
                                         Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state
                                         Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just (LayoutState -> Int
lstate_baseY LayoutState
state)
                                       else Maybe Int
forall a. Maybe a
Nothing
        , _lstate_commentCol :: Maybe Int
_lstate_commentCol       = Maybe Int
forall a. Maybe a
Nothing
        }
-- fixMoveToLineByIsNewline :: MonadMultiState
--                                                   LayoutState m => Int -> m Int
-- fixMoveToLineByIsNewline x = do
--   newLineState <- mGet <&> _lstate_isNewline
--   return $ if newLineState == NewLineStateYes
--     then x-1
--     else x

ppmMoveToExactLoc
  :: MonadMultiWriter Text.Builder.Builder m
  => ExactPrint.DeltaPos
  -> m ()
ppmMoveToExactLoc :: DeltaPos -> m ()
ppmMoveToExactLoc (ExactPrint.DP (Int
x, Int
y)) = do
  Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
x (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Builder -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Builder
Text.Builder.fromString [Char]
"\n"
  Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
y (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Builder -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Builder
Text.Builder.fromString [Char]
" "

-- TODO: update and use, or clean up. Currently dead code.
layoutWritePriorComments
  :: ( Data.Data.Data ast
     , MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiWriter (Seq String) m
     )
  => Located ast
  -> m ()
layoutWritePriorComments :: Located ast -> m ()
layoutWritePriorComments Located ast
ast = do
  Maybe [(Comment, DeltaPos)]
mAnn <- do
    LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
    let key :: AnnKey
key  = Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.mkAnnKey Located ast
ast
    let anns :: Map AnnKey Annotation
anns = LayoutState -> Map AnnKey Annotation
_lstate_comments LayoutState
state
    let mAnn :: Maybe [(Comment, DeltaPos)]
mAnn = Annotation -> [(Comment, DeltaPos)]
ExactPrint.annPriorComments (Annotation -> [(Comment, DeltaPos)])
-> Maybe Annotation -> Maybe [(Comment, DeltaPos)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnKey -> Map AnnKey Annotation -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
key Map AnnKey Annotation
anns
    LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (LayoutState -> m ()) -> LayoutState -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState
state
      { _lstate_comments :: Map AnnKey Annotation
_lstate_comments =
          (Annotation -> Annotation)
-> AnnKey -> Map AnnKey Annotation -> Map AnnKey Annotation
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\Annotation
ann -> Annotation
ann { annPriorComments :: [(Comment, DeltaPos)]
ExactPrint.annPriorComments = [] }) AnnKey
key Map AnnKey Annotation
anns
      }
    Maybe [(Comment, DeltaPos)] -> m (Maybe [(Comment, DeltaPos)])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(Comment, DeltaPos)]
mAnn
#if INSERTTRACES
  tellDebugMessShow ("layoutWritePriorComments", ExactPrint.mkAnnKey ast, mAnn)
#endif
  case Maybe [(Comment, DeltaPos)]
mAnn of
    Maybe [(Comment, DeltaPos)]
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [(Comment, DeltaPos)]
priors -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Comment, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Comment, DeltaPos)]
priors) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutSetCommentCol
      [(Comment, DeltaPos)]
priors [(Comment, DeltaPos)] -> ((Comment, DeltaPos) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \( ExactPrint.Comment [Char]
comment AnnSpan
_ Maybe AnnKeywordId
_
                      , ExactPrint.DP (Int
x, Int
y)
                      ) -> do
        Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
x m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutWriteNewline
        Int -> m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutWriteAppendSpaces Int
y
        [Text] -> m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
[Text] -> m ()
layoutWriteAppendMultiline ([Text] -> m ()) -> [Text] -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack [Char]
comment

-- TODO: update and use, or clean up. Currently dead code.
-- this currently only extracs from the `annsDP` field of Annotations.
-- per documentation, this seems sufficient, as the
-- "..`annFollowingComments` are only added by AST transformations ..".
layoutWritePostComments :: (Data.Data.Data ast,
                                               MonadMultiWriter Text.Builder.Builder m,
                                               MonadMultiState LayoutState m
                                               , MonadMultiWriter (Seq String) m)
                         => Located ast -> m ()
layoutWritePostComments :: Located ast -> m ()
layoutWritePostComments Located ast
ast = do
  Maybe [(Comment, DeltaPos)]
mAnn <- do
    LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
    let key :: AnnKey
key  = Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
ExactPrint.mkAnnKey Located ast
ast
    let anns :: Map AnnKey Annotation
anns = LayoutState -> Map AnnKey Annotation
_lstate_comments LayoutState
state
    let mAnn :: Maybe [(Comment, DeltaPos)]
mAnn = Annotation -> [(Comment, DeltaPos)]
ExactPrint.annFollowingComments (Annotation -> [(Comment, DeltaPos)])
-> Maybe Annotation -> Maybe [(Comment, DeltaPos)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnKey -> Map AnnKey Annotation -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnnKey
key Map AnnKey Annotation
anns
    LayoutState -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (LayoutState -> m ()) -> LayoutState -> m ()
forall a b. (a -> b) -> a -> b
$ LayoutState
state
      { _lstate_comments :: Map AnnKey Annotation
_lstate_comments =
          (Annotation -> Annotation)
-> AnnKey -> Map AnnKey Annotation -> Map AnnKey Annotation
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\Annotation
ann -> Annotation
ann { annFollowingComments :: [(Comment, DeltaPos)]
ExactPrint.annFollowingComments = [] })
                     AnnKey
key
                     Map AnnKey Annotation
anns
      }
    Maybe [(Comment, DeltaPos)] -> m (Maybe [(Comment, DeltaPos)])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(Comment, DeltaPos)]
mAnn
#if INSERTTRACES
  tellDebugMessShow ("layoutWritePostComments", ExactPrint.mkAnnKey ast, mAnn)
#endif
  case Maybe [(Comment, DeltaPos)]
mAnn of
    Maybe [(Comment, DeltaPos)]
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [(Comment, DeltaPos)]
posts -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Comment, DeltaPos)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Comment, DeltaPos)]
posts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: * -> *).
(MonadMultiState LayoutState m, MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutSetCommentCol
      [(Comment, DeltaPos)]
posts [(Comment, DeltaPos)] -> ((Comment, DeltaPos) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \( ExactPrint.Comment [Char]
comment AnnSpan
_ Maybe AnnKeywordId
_
                      , ExactPrint.DP (Int
x, Int
y)
                      ) -> do
        Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
x m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutWriteNewline
        Text -> m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
Text -> m ()
layoutWriteAppend (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
y Char
' '
        (LayoutState -> LayoutState) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((LayoutState -> LayoutState) -> m ())
-> (LayoutState -> LayoutState) -> m ()
forall a b. (a -> b) -> a -> b
$ \LayoutState
s -> LayoutState
s { _lstate_addSepSpace :: Maybe Int
_lstate_addSepSpace = Maybe Int
forall a. Maybe a
Nothing }
        [Text] -> m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
[Text] -> m ()
layoutWriteAppendMultiline ([Text] -> m ()) -> [Text] -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
comment

layoutIndentRestorePostComment
  :: ( MonadMultiState LayoutState m
     , MonadMultiWriter Text.Builder.Builder m
     , MonadMultiWriter (Seq String) m
     )
  => m ()
layoutIndentRestorePostComment :: m ()
layoutIndentRestorePostComment = do
  LayoutState
state <- m LayoutState
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
  let mCommentCol :: Maybe Int
mCommentCol = LayoutState -> Maybe Int
_lstate_commentCol LayoutState
state
  let eCurYAddNL :: Either Int Int
eCurYAddNL  = LayoutState -> Either Int Int
_lstate_curYOrAddNewline LayoutState
state
#if INSERTTRACES
  tellDebugMessShow ("layoutIndentRestorePostComment", mCommentCol)
#endif
  (LayoutState -> LayoutState) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((LayoutState -> LayoutState) -> m ())
-> (LayoutState -> LayoutState) -> m ()
forall a b. (a -> b) -> a -> b
$ \LayoutState
s -> LayoutState
s { _lstate_commentCol :: Maybe Int
_lstate_commentCol = Maybe Int
forall a. Maybe a
Nothing
                    , _lstate_commentNewlines :: Int
_lstate_commentNewlines = Int
0
                    }
  case (Maybe Int
mCommentCol, Either Int Int
eCurYAddNL) of
    (Just Int
commentCol, Left{}) -> do
      m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
m ()
layoutWriteEnsureNewlineBlock
      Int -> m ()
forall (m :: * -> *).
(MonadMultiWriter Builder m, MonadMultiState LayoutState m,
 MonadMultiWriter (Seq [Char]) m) =>
Int -> m ()
layoutWriteEnsureAbsoluteN (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
commentCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (LayoutState -> Maybe Int
_lstate_addSepSpace LayoutState
state)
    (Maybe Int, Either Int Int)
_                              -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- layoutWritePriorCommentsRestore :: (Data.Data.Data ast,
--                                                MonadMultiWriter Text.Builder.Builder m,
--                                                MonadMultiState LayoutState m
--                                   , MonadMultiWriter (Seq String) m)
--                                 => Located ast -> m ()
-- layoutWritePriorCommentsRestore x = do
--   layoutWritePriorComments x
--   layoutIndentRestorePostComment
-- 
-- layoutWritePostCommentsRestore :: (Data.Data.Data ast,
--                                                MonadMultiWriter Text.Builder.Builder m,
--                                                MonadMultiState LayoutState m
--                                                , MonadMultiWriter (Seq String) m)
--                                 => Located ast -> m ()
-- layoutWritePostCommentsRestore x = do
--   layoutWritePostComments x
--   layoutIndentRestorePostComment