module Debug.NonInterleavedIO.Scoped (
putStrLn
) where
import Prelude hiding (putStrLn)
import Control.Monad.IO.Class
import Data.List (intercalate)
import Debug.NonInterleavedIO qualified as NIIO
import Debug.Provenance.Internal
import Debug.Provenance.Scope
putStrLn :: (HasCallStack, MonadIO m) => String -> m ()
putStrLn :: forall (m :: * -> *). (HasCallStack, MonadIO m) => String -> m ()
putStrLn String
str = do
scope <- m Scope
forall (m :: * -> *). MonadIO m => m Scope
getScope
here <- newInvocationFrom callSite
let prettyScope :: String
prettyScope = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
String
"["
, String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Invocation -> String) -> Scope -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Invocation -> String
prettyInvocation (Invocation
here Invocation -> Scope -> Scope
forall a. a -> [a] -> [a]
: Scope
scope)
, String
"]"
]
NIIO.putStrLn $
case lines str of
[String
one] -> String
prettyScope String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
one
[String]
many -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
prettyScope String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
many