-- | Printer combinators related to print strings.
module HIndent.Pretty.Combinators.String
  ( string
  , space
  , newline
  , blankline
  , comma
  , dot
  ) where

import Control.Monad.RWS
import qualified Data.ByteString.Builder as S
import GHC.Stack
import HIndent.Config
import HIndent.Printer

-- | This function prints the given string.
--
-- The string must not include '\n's. Use 'newline' to print them.
string :: HasCallStack => String -> Printer ()
string :: HasCallStack => String -> Printer ()
string String
x
  | Char
'\n' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
x =
    String -> Printer ()
forall a. HasCallStack => String -> a
error (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$
    String
"You tried to print " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Use `newline` to print '\\n's."
  | Bool
otherwise = do
    Bool
eol <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psEolComment
    Bool
hardFail <- (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psFitOnOneLine
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
eol Printer ()
newline
    PrintState
st <- Printer PrintState
forall s (m :: * -> *). MonadState s m => m s
get
    let indentSpaces :: String
indentSpaces =
          if PrintState -> Bool
psNewline PrintState
st
            then Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ PrintState -> Int64
psIndentLevel PrintState
st) Char
' '
            else String
""
        out :: String
out = String
indentSpaces String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
x
        psColumn' :: Int64
psColumn' = PrintState -> Int64
psColumn PrintState
st Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
out)
        columnFits :: Bool
columnFits = Int64
psColumn' Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Config -> Int64
configMaxColumns (PrintState -> Config
psConfig PrintState
st)
    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hardFail (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Bool -> Printer ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
columnFits
    (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
      (\PrintState
s ->
         PrintState
s
           { psOutput :: Builder
psOutput = PrintState -> Builder
psOutput PrintState
st Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
S.stringUtf8 String
out
           , psNewline :: Bool
psNewline = Bool
False
           , psEolComment :: Bool
psEolComment = Bool
False
           , psColumn :: Int64
psColumn = Int64
psColumn'
           })

-- | Equivalent to 'string " "'.
space :: Printer ()
space :: Printer ()
space = HasCallStack => String -> Printer ()
String -> Printer ()
string String
" "

-- | Equivalent to 'string ","'.
comma :: Printer ()
comma :: Printer ()
comma = HasCallStack => String -> Printer ()
String -> Printer ()
string String
","

-- | Equivalent to 'string "."'.
dot :: Printer ()
dot :: Printer ()
dot = HasCallStack => String -> Printer ()
String -> Printer ()
string String
"."

-- | This function prints a '\n'.
--
-- Always call this function to print it because printing it requires
-- special treatment. Do not call 'string' instead.
newline :: Printer ()
newline :: Printer ()
newline = do
  (PrintState -> Bool) -> Printer Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrintState -> Bool
psFitOnOneLine Printer Bool -> (Bool -> Printer ()) -> Printer ()
forall a b. Printer a -> (a -> Printer b) -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Printer ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Printer ()) -> (Bool -> Bool) -> Bool -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
  (PrintState -> PrintState) -> Printer ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
    (\PrintState
s ->
       PrintState
s
         { psOutput :: Builder
psOutput = PrintState -> Builder
psOutput PrintState
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
S.stringUtf8 String
"\n"
         , psNewline :: Bool
psNewline = Bool
True
         , psLine :: Int64
psLine = PrintState -> Int64
psLine PrintState
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
         , psEolComment :: Bool
psEolComment = Bool
False
         , psColumn :: Int64
psColumn = Int64
0
         })

-- | Equivalent to 'newline >> newline'.
blankline :: Printer ()
blankline :: Printer ()
blankline = Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline