module Network.Transport.Tests.Traced
( MonadS(..)
, return
, (>>=)
, (>>)
, fail
, ifThenElse
, Showable(..)
, Traceable(..)
, traceShow
) where
import Prelude hiding
( (>>=)
, return
, fail
, (>>)
#if ! MIN_VERSION_base(4,6,0)
, catch
#endif
)
import qualified Prelude
import Control.Exception (catches, Handler(..), SomeException, throwIO, Exception(..), IOException)
import Control.Applicative ((<$>))
import Data.Typeable (Typeable)
import Data.Maybe (catMaybes)
import Data.ByteString (ByteString)
import Data.Int (Int32, Int64)
import Data.Word (Word32, Word64)
import Control.Concurrent.MVar (MVar)
class MonadS m where
returnS :: a -> m a
bindS :: Traceable a => m a -> (a -> m b) -> m b
failS :: String -> m a
seqS :: m a -> m b -> m b
(>>=) :: (MonadS m, Traceable a) => m a -> (a -> m b) -> m b
>>= :: forall (m :: * -> *) a b.
(MonadS m, Traceable a) =>
m a -> (a -> m b) -> m b
(>>=) = forall (m :: * -> *) a b.
(MonadS m, Traceable a) =>
m a -> (a -> m b) -> m b
bindS
(>>) :: MonadS m => m a -> m b -> m b
>> :: forall (m :: * -> *) a b. MonadS m => m a -> m b -> m b
(>>) = forall (m :: * -> *) a b. MonadS m => m a -> m b -> m b
seqS
return :: MonadS m => a -> m a
return :: forall (m :: * -> *) a. MonadS m => a -> m a
return = forall (m :: * -> *) a. MonadS m => a -> m a
returnS
fail :: MonadS m => String -> m a
fail :: forall (m :: * -> *) a. MonadS m => String -> m a
fail = forall (m :: * -> *) a. MonadS m => String -> m a
failS
data Showable = forall a. Show a => Showable a
instance Show Showable where
show :: Showable -> String
show (Showable a
x) = forall a. Show a => a -> String
show a
x
mapShowable :: (forall a. Show a => a -> Showable) -> Showable -> Showable
mapShowable :: (forall a. Show a => a -> Showable) -> Showable -> Showable
mapShowable forall a. Show a => a -> Showable
f (Showable a
x) = forall a. Show a => a -> Showable
f a
x
traceShow :: Show a => a -> Maybe Showable
traceShow :: forall a. Show a => a -> Maybe Showable
traceShow = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Showable
Showable
class Traceable a where
trace :: a -> Maybe Showable
instance (Traceable a, Traceable b) => Traceable (Either a b) where
trace :: Either a b -> Maybe Showable
trace (Left a
x) = ((forall a. Show a => a -> Showable) -> Showable -> Showable
mapShowable forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Showable
Showable forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. a -> Either a b
Left :: forall c. c -> Either c ())) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Traceable a => a -> Maybe Showable
trace a
x
trace (Right b
y) = ((forall a. Show a => a -> Showable) -> Showable -> Showable
mapShowable forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Showable
Showable forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. b -> Either a b
Right :: forall c. c -> Either () c)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Traceable a => a -> Maybe Showable
trace b
y
instance (Traceable a, Traceable b) => Traceable (a, b) where
trace :: (a, b) -> Maybe Showable
trace (a
x, b
y) = case (forall a. Traceable a => a -> Maybe Showable
trace a
x, forall a. Traceable a => a -> Maybe Showable
trace b
y) of
(Maybe Showable
Nothing, Maybe Showable
Nothing) -> forall a. Maybe a
Nothing
(Just Showable
t1, Maybe Showable
Nothing) -> forall a. Show a => a -> Maybe Showable
traceShow Showable
t1
(Maybe Showable
Nothing, Just Showable
t2) -> forall a. Show a => a -> Maybe Showable
traceShow Showable
t2
(Just Showable
t1, Just Showable
t2) -> forall a. Show a => a -> Maybe Showable
traceShow (Showable
t1, Showable
t2)
instance (Traceable a, Traceable b, Traceable c) => Traceable (a, b, c) where
trace :: (a, b, c) -> Maybe Showable
trace (a
x, b
y, c
z) = case (forall a. Traceable a => a -> Maybe Showable
trace a
x, forall a. Traceable a => a -> Maybe Showable
trace b
y, forall a. Traceable a => a -> Maybe Showable
trace c
z) of
(Maybe Showable
Nothing, Maybe Showable
Nothing, Maybe Showable
Nothing) -> forall a. Maybe a
Nothing
(Just Showable
t1, Maybe Showable
Nothing, Maybe Showable
Nothing) -> forall a. Show a => a -> Maybe Showable
traceShow Showable
t1
(Maybe Showable
Nothing, Just Showable
t2, Maybe Showable
Nothing) -> forall a. Show a => a -> Maybe Showable
traceShow Showable
t2
(Just Showable
t1, Just Showable
t2, Maybe Showable
Nothing) -> forall a. Show a => a -> Maybe Showable
traceShow (Showable
t1, Showable
t2)
(Maybe Showable
Nothing, Maybe Showable
Nothing, Just Showable
t3) -> forall a. Show a => a -> Maybe Showable
traceShow Showable
t3
(Just Showable
t1, Maybe Showable
Nothing, Just Showable
t3) -> forall a. Show a => a -> Maybe Showable
traceShow (Showable
t1, Showable
t3)
(Maybe Showable
Nothing, Just Showable
t2, Just Showable
t3) -> forall a. Show a => a -> Maybe Showable
traceShow (Showable
t2, Showable
t3)
(Just Showable
t1, Just Showable
t2, Just Showable
t3) -> forall a. Show a => a -> Maybe Showable
traceShow (Showable
t1, Showable
t2, Showable
t3)
instance Traceable a => Traceable (Maybe a) where
trace :: Maybe a -> Maybe Showable
trace Maybe a
Nothing = forall a. Show a => a -> Maybe Showable
traceShow (forall a. Maybe a
Nothing :: Maybe ())
trace (Just a
x) = (forall a. Show a => a -> Showable) -> Showable -> Showable
mapShowable (forall a. Show a => a -> Showable
Showable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Traceable a => a -> Maybe Showable
trace a
x
instance Traceable a => Traceable [a] where
trace :: [a] -> Maybe Showable
trace = forall a. Show a => a -> Maybe Showable
traceShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Traceable a => a -> Maybe Showable
trace
instance Traceable () where
trace :: () -> Maybe Showable
trace = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
instance Traceable Int where
trace :: Int -> Maybe Showable
trace = forall a. Show a => a -> Maybe Showable
traceShow
instance Traceable Int32 where
trace :: Int32 -> Maybe Showable
trace = forall a. Show a => a -> Maybe Showable
traceShow
instance Traceable Int64 where
trace :: Int64 -> Maybe Showable
trace = forall a. Show a => a -> Maybe Showable
traceShow
instance Traceable Word32 where
trace :: Word32 -> Maybe Showable
trace = forall a. Show a => a -> Maybe Showable
traceShow
instance Traceable Word64 where
trace :: Word64 -> Maybe Showable
trace = forall a. Show a => a -> Maybe Showable
traceShow
instance Traceable Bool where
trace :: Bool -> Maybe Showable
trace = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
instance Traceable ByteString where
trace :: ByteString -> Maybe Showable
trace = forall a. Show a => a -> Maybe Showable
traceShow
instance Traceable (MVar a) where
trace :: MVar a -> Maybe Showable
trace = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
instance Traceable [Char] where
trace :: String -> Maybe Showable
trace = forall a. Show a => a -> Maybe Showable
traceShow
instance Traceable IOException where
trace :: IOException -> Maybe Showable
trace = forall a. Show a => a -> Maybe Showable
traceShow
data TracedException = TracedException [String] SomeException
deriving Typeable
instance Exception TracedException
instance MonadS IO where
returnS :: forall a. a -> IO a
returnS = forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return
bindS :: forall a b. Traceable a => IO a -> (a -> IO b) -> IO b
bindS = \IO a
x a -> IO b
f -> IO a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= \a
a -> forall a. IO a -> [Handler a] -> IO a
catches (a -> IO b
f a
a) (forall a b. Traceable a => a -> [Handler b]
traceHandlers a
a)
failS :: forall a. String -> IO a
failS = forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail
seqS :: forall a b. IO a -> IO b -> IO b
seqS = forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(Prelude.>>)
instance Show TracedException where
show :: TracedException -> String
show (TracedException [String]
ts SomeException
ex) =
forall a. Show a => a -> String
show SomeException
ex forall a. [a] -> [a] -> [a]
++ String
"\nTrace:\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, String
t) -> forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
"\t" forall a. [a] -> [a] -> [a]
++ String
t) (forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..] :: [Int]) (forall a. Int -> [a] -> [a]
take Int
10 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [String]
ts)))
traceHandlers :: Traceable a => a -> [Handler b]
traceHandlers :: forall a b. Traceable a => a -> [Handler b]
traceHandlers a
a = case forall a. Traceable a => a -> Maybe Showable
trace a
a of
Maybe Showable
Nothing -> [ forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \SomeException
ex -> forall e a. Exception e => e -> IO a
throwIO (SomeException
ex :: SomeException) ]
Just Showable
t -> [ forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \(TracedException [String]
ts SomeException
ex) -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [String] -> SomeException -> TracedException
TracedException (forall a. Show a => a -> String
show Showable
t forall a. a -> [a] -> [a]
: [String]
ts) SomeException
ex
, forall a e. Exception e => (e -> IO a) -> Handler a
Handler forall a b. (a -> b) -> a -> b
$ \SomeException
ex -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [String] -> SomeException -> TracedException
TracedException [forall a. Show a => a -> String
show Showable
t] (SomeException
ex :: SomeException)
]
ifThenElse :: Bool -> a -> a -> a
ifThenElse :: forall a. Bool -> a -> a -> a
ifThenElse Bool
True a
x a
_ = a
x
ifThenElse Bool
False a
_ a
y = a
y