{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-export-lists #-}
module Debug.SimpleExpr.Utils.Traced
(
Traced (MkTraced, getTraced),
traced,
untraced,
addTraceUnary,
addTraceBinary,
addTraceTernary,
withTrace,
traceShow,
)
where
import Control.ExtendableMap (ExtandableMap (extendMap))
import Data.Hashable (Hashable)
import Debug.SimpleExpr.Utils.Algebra (AlgebraicPower ((^^)), MultiplicativeAction ((*|)))
import Debug.Trace (trace)
import GHC.Base (Eq, Functor (fmap), String, ($), (.), (<>))
import GHC.Int (Int, Int16, Int32, Int64, Int8)
import GHC.Integer (Integer)
import GHC.Natural (Natural)
import GHC.Num (Num)
import qualified GHC.Num as GN
import GHC.Show (Show (show))
import GHC.Word (Word, Word16, Word32, Word64, Word8)
import NumHask
( Additive (zero, (+)),
Distributive,
Divisive,
ExpField (exp, log, (**)),
FromInteger,
Integral,
Multiplicative,
Subtractive (negate, (-)),
TrigField (acos, acosh, asin, asinh, atan, atan2, atanh, cos, cosh, pi, sin, sinh),
fromInteger,
one,
zero,
(*),
(/),
)
newtype Traced a = MkTraced {forall a. Traced a -> a
getTraced :: a}
deriving (Traced a -> Traced a -> Bool
(Traced a -> Traced a -> Bool)
-> (Traced a -> Traced a -> Bool) -> Eq (Traced a)
forall a. Eq a => Traced a -> Traced a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Traced a -> Traced a -> Bool
== :: Traced a -> Traced a -> Bool
$c/= :: forall a. Eq a => Traced a -> Traced a -> Bool
/= :: Traced a -> Traced a -> Bool
Eq, Eq (Traced a)
Eq (Traced a) =>
(Int -> Traced a -> Int)
-> (Traced a -> Int) -> Hashable (Traced a)
Int -> Traced a -> Int
Traced a -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Hashable a => Eq (Traced a)
forall a. Hashable a => Int -> Traced a -> Int
forall a. Hashable a => Traced a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Traced a -> Int
hashWithSalt :: Int -> Traced a -> Int
$chash :: forall a. Hashable a => Traced a -> Int
hash :: Traced a -> Int
Hashable, (forall a b. (a -> b) -> Traced a -> Traced b)
-> (forall a b. a -> Traced b -> Traced a) -> Functor Traced
forall a b. a -> Traced b -> Traced a
forall a b. (a -> b) -> Traced a -> Traced b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Traced a -> Traced b
fmap :: forall a b. (a -> b) -> Traced a -> Traced b
$c<$ :: forall a b. a -> Traced b -> Traced a
<$ :: forall a b. a -> Traced b -> Traced a
Functor, Integer -> Traced a
(Integer -> Traced a) -> FromInteger (Traced a)
forall a. FromInteger a => Integer -> Traced a
forall a. (Integer -> a) -> FromInteger a
$cfromInteger :: forall a. FromInteger a => Integer -> Traced a
fromInteger :: Integer -> Traced a
FromInteger)
traced :: a -> Traced a
traced :: forall a. a -> Traced a
traced = a -> Traced a
forall a. a -> Traced a
MkTraced
untraced :: Traced a -> a
untraced :: forall a. Traced a -> a
untraced = Traced a -> a
forall a. Traced a -> a
getTraced
addTraceUnary :: (Show a) => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary :: forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
name a -> b
f (MkTraced a
x) =
String -> Traced b -> Traced b
forall a. String -> a -> a
trace (String
" <<< TRACING: Calculating " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" >>>") (Traced b -> Traced b) -> Traced b -> Traced b
forall a b. (a -> b) -> a -> b
$
b -> Traced b
forall a. a -> Traced a
MkTraced (b -> Traced b) -> b -> Traced b
forall a b. (a -> b) -> a -> b
$
a -> b
f a
x
addTraceBinary ::
(Show a, Show b) =>
String ->
(a -> b -> c) ->
Traced a ->
Traced b ->
Traced c
addTraceBinary :: forall a b c.
(Show a, Show b) =>
String -> (a -> b -> c) -> Traced a -> Traced b -> Traced c
addTraceBinary String
name a -> b -> c
f (MkTraced a
x) (MkTraced b
y) =
String -> Traced c -> Traced c
forall a. String -> a -> a
trace
( String
" <<< TRACING: Calculating "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" of "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
x
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" and "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> b -> String
forall a. Show a => a -> String
show b
y
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" >>>"
)
(Traced c -> Traced c) -> Traced c -> Traced c
forall a b. (a -> b) -> a -> b
$ c -> Traced c
forall a. a -> Traced a
MkTraced
(c -> Traced c) -> c -> Traced c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
x b
y
addTraceTernary ::
(Show a, Show b, Show c) =>
String ->
(a -> b -> c -> d) ->
Traced a ->
Traced b ->
Traced c ->
Traced d
addTraceTernary :: forall a b c d.
(Show a, Show b, Show c) =>
String
-> (a -> b -> c -> d)
-> Traced a
-> Traced b
-> Traced c
-> Traced d
addTraceTernary String
name a -> b -> c -> d
f (MkTraced a
x) (MkTraced b
y) (MkTraced c
z) =
String -> Traced d -> Traced d
forall a. String -> a -> a
trace
( String
" <<< TRACING: Calculating "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" of "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
x
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> b -> String
forall a. Show a => a -> String
show b
y
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", and "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> c -> String
forall a. Show a => a -> String
show c
z
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" >>>"
)
(Traced d -> Traced d) -> Traced d -> Traced d
forall a b. (a -> b) -> a -> b
$ d -> Traced d
forall a. a -> Traced a
MkTraced
(d -> Traced d) -> d -> Traced d
forall a b. (a -> b) -> a -> b
$ a -> b -> c -> d
f a
x b
y c
z
withTrace :: String -> Traced a -> Traced a
withTrace :: forall a. String -> Traced a -> Traced a
withTrace String
msg = String -> Traced a -> Traced a
forall a. String -> a -> a
trace (String
" <<< TRACING: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" >>>")
traceShow :: (Show a) => String -> Traced a -> Traced a
traceShow :: forall a. Show a => String -> Traced a -> Traced a
traceShow String
msg t :: Traced a
t@(MkTraced a
x) =
String -> Traced a -> Traced a
forall a. String -> a -> a
trace (String
" <<< TRACING: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" >>>") Traced a
t
instance (GN.Num a, Show a) => GN.Num (Traced a) where
+ :: Traced a -> Traced a -> Traced a
(+) = String -> (a -> a -> a) -> Traced a -> Traced a -> Traced a
forall a b c.
(Show a, Show b) =>
String -> (a -> b -> c) -> Traced a -> Traced b -> Traced c
addTraceBinary String
"(+)" a -> a -> a
forall a. Num a => a -> a -> a
(GN.+)
* :: Traced a -> Traced a -> Traced a
(*) = String -> (a -> a -> a) -> Traced a -> Traced a -> Traced a
forall a b c.
(Show a, Show b) =>
String -> (a -> b -> c) -> Traced a -> Traced b -> Traced c
addTraceBinary String
"(*)" a -> a -> a
forall a. Num a => a -> a -> a
(GN.*)
(-) = String -> (a -> a -> a) -> Traced a -> Traced a -> Traced a
forall a b c.
(Show a, Show b) =>
String -> (a -> b -> c) -> Traced a -> Traced b -> Traced c
addTraceBinary String
"(-)" a -> a -> a
forall a. Num a => a -> a -> a
(GN.-)
negate :: Traced a -> Traced a
negate = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"negate" a -> a
forall a. Num a => a -> a
GN.negate
abs :: Traced a -> Traced a
abs = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"abs" a -> a
forall a. Num a => a -> a
GN.abs
signum :: Traced a -> Traced a
signum = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"signum" a -> a
forall a. Num a => a -> a
GN.signum
fromInteger :: Integer -> Traced a
fromInteger = a -> Traced a
forall a. a -> Traced a
MkTraced (a -> Traced a) -> (Integer -> a) -> Integer -> Traced a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
GN.fromInteger
instance (Additive a, Show a) => Additive (Traced a) where
+ :: Traced a -> Traced a -> Traced a
(+) = String -> (a -> a -> a) -> Traced a -> Traced a -> Traced a
forall a b c.
(Show a, Show b) =>
String -> (a -> b -> c) -> Traced a -> Traced b -> Traced c
addTraceBinary String
"(+)" a -> a -> a
forall a. Additive a => a -> a -> a
(NumHask.+)
zero :: Traced a
zero = a -> Traced a
forall a. a -> Traced a
MkTraced a
forall a. Additive a => a
zero
instance (Subtractive a, Show a) => Subtractive (Traced a) where
(-) = String -> (a -> a -> a) -> Traced a -> Traced a -> Traced a
forall a b c.
(Show a, Show b) =>
String -> (a -> b -> c) -> Traced a -> Traced b -> Traced c
addTraceBinary String
"(-)" a -> a -> a
forall a. Subtractive a => a -> a -> a
(NumHask.-)
negate :: Traced a -> Traced a
negate = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"negate" a -> a
forall a. Subtractive a => a -> a
NumHask.negate
instance (Multiplicative a, Show a) => Multiplicative (Traced a) where
* :: Traced a -> Traced a -> Traced a
(*) = String -> (a -> a -> a) -> Traced a -> Traced a -> Traced a
forall a b c.
(Show a, Show b) =>
String -> (a -> b -> c) -> Traced a -> Traced b -> Traced c
addTraceBinary String
"(*)" a -> a -> a
forall a. Multiplicative a => a -> a -> a
(NumHask.*)
one :: Traced a
one = a -> Traced a
forall a. a -> Traced a
MkTraced a
forall a. Multiplicative a => a
one
instance (Divisive a, Show a) => Divisive (Traced a) where
/ :: Traced a -> Traced a -> Traced a
(/) = String -> (a -> a -> a) -> Traced a -> Traced a -> Traced a
forall a b c.
(Show a, Show b) =>
String -> (a -> b -> c) -> Traced a -> Traced b -> Traced c
addTraceBinary String
"(/)" a -> a -> a
forall a. Divisive a => a -> a -> a
(/)
instance (ExpField a, Show a) => ExpField (Traced a) where
exp :: Traced a -> Traced a
exp = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"exp" a -> a
forall a. ExpField a => a -> a
exp
log :: Traced a -> Traced a
log = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"log" a -> a
forall a. ExpField a => a -> a
log
** :: Traced a -> Traced a -> Traced a
(**) = String -> (a -> a -> a) -> Traced a -> Traced a -> Traced a
forall a b c.
(Show a, Show b) =>
String -> (a -> b -> c) -> Traced a -> Traced b -> Traced c
addTraceBinary String
"(**)" a -> a -> a
forall a. ExpField a => a -> a -> a
(**)
instance (TrigField a, Show a) => TrigField (Traced a) where
sin :: Traced a -> Traced a
sin = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"sin" a -> a
forall a. TrigField a => a -> a
sin
cos :: Traced a -> Traced a
cos = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"cos" a -> a
forall a. TrigField a => a -> a
cos
pi :: Traced a
pi = a -> Traced a
forall a. a -> Traced a
MkTraced a
forall a. TrigField a => a
pi
asin :: Traced a -> Traced a
asin = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"asin" a -> a
forall a. TrigField a => a -> a
asin
acos :: Traced a -> Traced a
acos = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"acos" a -> a
forall a. TrigField a => a -> a
acos
atan :: Traced a -> Traced a
atan = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"atan" a -> a
forall a. TrigField a => a -> a
atan
atan2 :: Traced a -> Traced a -> Traced a
atan2 = String -> (a -> a -> a) -> Traced a -> Traced a -> Traced a
forall a b c.
(Show a, Show b) =>
String -> (a -> b -> c) -> Traced a -> Traced b -> Traced c
addTraceBinary String
"atan2" a -> a -> a
forall a. TrigField a => a -> a -> a
atan2
sinh :: Traced a -> Traced a
sinh = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"sinh" a -> a
forall a. TrigField a => a -> a
sinh
cosh :: Traced a -> Traced a
cosh = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"cosh" a -> a
forall a. TrigField a => a -> a
cosh
asinh :: Traced a -> Traced a
asinh = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"asinh" a -> a
forall a. TrigField a => a -> a
asinh
acosh :: Traced a -> Traced a
acosh = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"acosh" a -> a
forall a. TrigField a => a -> a
acosh
atanh :: Traced a -> Traced a
atanh = String -> (a -> a) -> Traced a -> Traced a
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"atanh" a -> a
forall a. TrigField a => a -> a
atanh
instance (Show a) => Show (Traced a) where
show :: Traced a -> String
show (MkTraced a
a) = a -> String
forall a. Show a => a -> String
show a
a
instance
(Show b, AlgebraicPower a b) =>
AlgebraicPower a (Traced b)
where
Traced b
x ^^ :: Traced b -> a -> Traced b
^^ a
n = String -> (b -> b) -> Traced b -> Traced b
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"(^^)" (b -> a -> b
forall a b. AlgebraicPower a b => b -> a -> b
^^ a
n) Traced b
x
instance
(Show b, MultiplicativeAction a b) =>
MultiplicativeAction a (Traced b)
where
a
n *| :: a -> Traced b -> Traced b
*| Traced b
x = String -> (b -> b) -> Traced b -> Traced b
forall a b. Show a => String -> (a -> b) -> Traced a -> Traced b
addTraceUnary String
"(*|)" (a
n a -> b -> b
forall a b. MultiplicativeAction a b => a -> b -> b
*|) Traced b
x
instance
(ExtandableMap a b c d) =>
ExtandableMap a b (Traced c) (Traced d)
where
extendMap :: (a -> b) -> Traced c -> Traced d
extendMap a -> b
f (MkTraced c
x) = d -> Traced d
forall a. a -> Traced a
MkTraced (d -> Traced d) -> d -> Traced d
forall a b. (a -> b) -> a -> b
$ (a -> b) -> c -> d
forall a b c d. ExtandableMap a b c d => (a -> b) -> c -> d
extendMap a -> b
f c
x