{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
-- |

module Test.Sandwich.Formatters.Print.CallStacks where

import Control.Monad
import GHC.Stack
import Test.Sandwich.Formatters.Print.Color
import Test.Sandwich.Formatters.Print.Printing


printCallStack :: 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 :: ([Char], SrcLoc) -> m ()
printCallStackLine ([Char]
f, (SrcLoc {Int
[Char]
srcLocPackage :: SrcLoc -> [Char]
srcLocModule :: SrcLoc -> [Char]
srcLocFile :: SrcLoc -> [Char]
srcLocStartLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocEndCol :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: [Char]
srcLocModule :: [Char]
srcLocPackage :: [Char]
..})) = 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