module Debug.Traced
( Traced, traced, named, nameTraced
, unknown, unTraced, tracedD
, TracedD, unTracedD
, Traceable
, liftT, liftFun, Liftable
, showAsExp, showAsExpFull
, reShare, simplify
, ifT, (%==), (%/=), (%<), (%<=), (%>), (%>=)
, (%&&), (%||), tnot
, TracedExp, tracedExp, namedExp
) where
import Data.Typeable (Typeable)
import Debug.Traced.Internal
ifT :: (Traceable a) => Traced Bool -> Traced a -> Traced a -> Traced a
ifT c t e = apply (unTraced $ if b then t else e) "ifT" Nonfix $
tracedD c : if b then [tracedD t, none] else [none, tracedD e] where
none = tracedD u
u = unknown "..." `asTypeOf` t
b = unTraced c
infix 4 %==, %/=, %<, %<=, %>, %>=
(%==), (%/=) :: (Traceable a, Eq a) => Traced a -> Traced a -> Traced Bool
(%==) = binOp (==) ("==", Infix 4)
(%/=) = binOp (/=) ("/=", Infix 4)
(%<), (%<=), (%>), (%>=) :: (Traceable a, Ord a) => Traced a -> Traced a -> Traced Bool
(%<) = binOp (<) ("<", Infix 4)
(%<=) = binOp (<=) ("<=", Infix 4)
(%>) = binOp (>) (">", Infix 4)
(%>=) = binOp (>=) (">=", Infix 4)
infixr 3 %&&
infixr 2 %||
(%&&) :: Traced Bool -> Traced Bool -> Traced Bool
(%&&) = binOp (&&) ("&&", InfixR 3)
(%||) :: Traced Bool -> Traced Bool -> Traced Bool
(%||) = binOp (&&) ("||", InfixR 2)
tnot :: Traced Bool -> Traced Bool
tnot = unOp not "not"
newtype TracedExp a = TracedExp (Traced a) deriving
( Typeable, Eq, Ord, Num, Fractional, Integral
, Enum, Real, RealFrac, Floating, RealFloat
)
instance (Traceable a, Show a) => Show (TracedExp a) where
show (TracedExp x) = showAsExpFull x
tracedExp :: (Traceable a) => a -> TracedExp a
tracedExp = TracedExp . traced
namedExp :: (Traceable a) => String -> a -> TracedExp a
namedExp s = TracedExp . named s