{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module Test.Sandwich.Formatters.Print.CallStacks where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import GHC.Stack
import System.IO (Handle)
import Test.Sandwich.Formatters.Print.Color
import Test.Sandwich.Formatters.Print.Printing
import Test.Sandwich.Formatters.Print.Types


printCallStack :: (
  MonadReader (PrintFormatter, Int, Handle) m, MonadIO m
  ) => CallStack -> m ()
printCallStack :: forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
CallStack -> m ()
printCallStack CallStack
cs = [([Char], SrcLoc)] -> (([Char], SrcLoc) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CallStack -> [([Char], SrcLoc)]
getCallStack CallStack
cs) ([Char], SrcLoc) -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
([Char], SrcLoc) -> m ()
printCallStackLine

printCallStackLine :: (
  MonadReader (PrintFormatter, Int, Handle) m, MonadIO m
  ) => (String, SrcLoc) -> m ()
printCallStackLine :: forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
([Char], SrcLoc) -> m ()
printCallStackLine ([Char]
f, (SrcLoc {Int
[Char]
srcLocPackage :: [Char]
srcLocModule :: [Char]
srcLocFile :: [Char]
srcLocStartLine :: Int
srcLocStartCol :: Int
srcLocEndLine :: Int
srcLocEndCol :: Int
srcLocPackage :: SrcLoc -> [Char]
srcLocModule :: SrcLoc -> [Char]
srcLocFile :: SrcLoc -> [Char]
srcLocStartLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocEndCol :: SrcLoc -> Int
..})) = do
  Colour Float -> [Char] -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> [Char] -> m ()
pic Colour Float
logFunctionColor [Char]
f

  [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
[Char] -> m ()
p [Char]
" called at "
  Colour Float -> [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> [Char] -> m ()
pc Colour Float
logFilenameColor [Char]
srcLocFile
  [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
[Char] -> m ()
p [Char]
":"
  Colour Float -> [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> [Char] -> m ()
pc Colour Float
logLineColor (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
srcLocStartLine)
  [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
[Char] -> m ()
p [Char]
":"
  Colour Float -> [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> [Char] -> m ()
pc Colour Float
logChColor (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
srcLocStartCol)
  [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
[Char] -> m ()
p [Char]
" in "
  Colour Float -> [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> [Char] -> m ()
pc Colour Float
logPackageColor [Char]
srcLocPackage
  [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
[Char] -> m ()
p [Char]
":"
  Colour Float -> [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> [Char] -> m ()
pc Colour Float
logModuleColor [Char]
srcLocModule
  [Char] -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
[Char] -> m ()
p [Char]
"\n"

logFunctionColor :: Colour Float
logFunctionColor = Colour Float
solarizedMagenta
logFilenameColor :: Colour Float
logFilenameColor = Colour Float
solarizedViolet
logModuleColor :: Colour Float
logModuleColor = Colour Float
solarizedMagenta
logPackageColor :: Colour Float
logPackageColor = Colour Float
solarizedGreen
logLineColor :: Colour Float
logLineColor = Colour Float
solarizedCyan
logChColor :: Colour Float
logChColor = Colour Float
solarizedOrange