-- | Getters to fetch current status and printer information.
module HIndent.Pretty.Combinators.Getter
  ( startingColumn
  , printerLength
  ) where

import Control.Monad.RWS hiding (state)
import Data.Int
import HIndent.Pretty.Combinators.String
import HIndent.Printer

-- | Returns the column from which a new string is printed. It may be
-- different from 'psColumn' immediately after printing a comment.
startingColumn :: Printer Int64
startingColumn :: Printer Int64
startingColumn = do
  PrintState
before <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
  HasCallStack => String -> Printer ()
String -> Printer ()
string String
""
  PrintState
after <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
  PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
before
  Int64 -> Printer Int64
forall a. a -> Printer a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Printer Int64) -> Int64 -> Printer Int64
forall a b. (a -> b) -> a -> b
$ PrintState -> Int64
psColumn PrintState
after

-- Returns how many characters the printer moved the cursor horizontally.
-- The returned value maybe negative if the printer prints multiple lines
-- and the column of the last position is less than before.
printerLength :: Printer a -> Printer Int64
printerLength :: forall a. Printer a -> Printer Int64
printerLength Printer a
p = do
  PrintState
before <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
  a
_ <- Printer a
p
  PrintState
after <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
  PrintState -> Printer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PrintState
before
  Int64 -> Printer Int64
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Printer Int64) -> Int64 -> Printer Int64
forall a b. (a -> b) -> a -> b
$ PrintState -> Int64
psColumn PrintState
after Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- PrintState -> Int64
psColumn PrintState
before