{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances #-}
module Debug.TraceCall.IODeep where

import Control.Monad.Trans
import Debug.TraceCall.Base

class TCDeepIO a where
  tcDeepIO :: TraceData -> Int -> (TraceData -> a) -> a -> a

instance (Show a, MonadIO m) => TCDeepIO (m a) where
  tcDeepIO td _ c v = do v <- c td
                         liftIO $ putStrLn $ traceResult td (show v)
                         return v

instance (TADeepIO a, TCDeepIO r) => TCDeepIO (a -> r) where
  tcDeepIO (TraceData fun as ctx) i c f a =
    case taDeepIO ("<<function-" ++ show i ++ ">>") a of
      Left s   -> tcDeepIO (TraceData fun (as ++ [s]) ctx) i (\td -> c td a) (f a)
      Right ca -> tcDeepIO (TraceData fun (as ++ ["<<function-" ++ show i ++ ">>"]) ctx) (i + 1) (\td -> c td (ca td)) (f a)


class TADeepIO a where
  taDeepIO :: String -> a -> Either String (TraceData -> a)

instance (Show a) => TADeepIO a where
  taDeepIO _ = Left . show

instance (TCDeepIO (a -> r)) => TADeepIO (a -> r) where
  taDeepIO s f = Right $ \td -> tcDeepIO (TraceData s [] $ Just td) 0 (const f) f


traceCallDeep :: (TCDeepIO a) => String -> a -> a
traceCallDeep s f = tcDeepIO (TraceData s [] Nothing) 0 (const f) f