{-# LANGUAGE NoMonomorphismRestriction #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Debug.TraceCall.Exmaples
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  bram@typlab.com
-- Stability   :  provisional
-- Portability :  portable
--
-- This modules contains examples of how to use Debug.TraceCall
------------------------------------------------------------------------------
module Debug.TraceCall.Examples where

import Debug.TraceCall

-- | Creating a logged version of splitAt
logSplitAt :: (Show a) => Int -> [a] -> ([a], [a])
logSplitAt = unsafeTraceCall "splitAt" splitAt

logSplitAtEx = logSplitAt 4 [1..10]

-- | We don't have to create specialized versions, we can also
-- do this inline, on any function.
logSplitAtEx2 :: ([Int], [Int])
logSplitAtEx2 = unsafeTraceCall "splitAt" splitAt 4 [1..10]

-- | By default function arguments will be ignored
logMapEx :: [Float]
logMapEx = unsafeTraceCall "map" map sqrt [1..5]

-- | With the 'deep' version we can also trace the function
-- arguments
logMapDeepEx :: [Float]
logMapDeepEx = unsafeTraceCallDeep "map" map sqrt [1..5]

-- | The normal traceCall function operates within the IO monad
logReadFile :: String -> IO String
logReadFile = traceCall "readFile" readFile

-- | It is even possible to log closures

logClosure :: [Int]
logClosure = map (unsafeTraceCall "+1closure" (+1)) [1..5]