hood-0.3.1: Debugging by observing in place

Safe HaskellNone
LanguageHaskell98

Debug.Hood.Observe

Contents

Synopsis

The main Hood API

observe :: Observable a => String -> a -> a Source #

observe observes data structures in flight.

An example of use is map (+1) . observe "intermeduate" . map (+2)

In this example, we observe the value that flows from the producer map (+2) to the consumer map (+1).

observe can also observe functions as well a structural values.

newtype Observer Source #

Constructors

O (forall a. Observable a => String -> a -> a) 

type Observing a = a -> a Source #

class Observable a where Source #

The Observable class defines how data types are observed. For Generic data types, this can be derived. For example:

  data MyType = MyConstr Int String deriving Generic
  instance Observable MyType

Methods

observer :: a -> Parent -> a Source #

observer :: (Generic a, GObservable (Rep a)) => a -> Parent -> a Source #

observers :: String -> (Observer -> a) -> a Source #

Instances

Observable Bool Source # 

Methods

observer :: Bool -> Parent -> Bool Source #

observers :: String -> (Observer -> Bool) -> Bool Source #

Observable Char Source # 

Methods

observer :: Char -> Parent -> Char Source #

observers :: String -> (Observer -> Char) -> Char Source #

Observable Double Source # 

Methods

observer :: Double -> Parent -> Double Source #

observers :: String -> (Observer -> Double) -> Double Source #

Observable Float Source # 

Methods

observer :: Float -> Parent -> Float Source #

observers :: String -> (Observer -> Float) -> Float Source #

Observable Int Source # 

Methods

observer :: Int -> Parent -> Int Source #

observers :: String -> (Observer -> Int) -> Int Source #

Observable Integer Source # 
Observable () Source # 

Methods

observer :: () -> Parent -> () Source #

observers :: String -> (Observer -> ()) -> () Source #

Observable Dynamic Source # 
Observable SomeException Source # 
Observable a => Observable [a] Source # 

Methods

observer :: [a] -> Parent -> [a] Source #

observers :: String -> (Observer -> [a]) -> [a] Source #

Observable a => Observable (Maybe a) Source # 

Methods

observer :: Maybe a -> Parent -> Maybe a Source #

observers :: String -> (Observer -> Maybe a) -> Maybe a Source #

Observable a => Observable (IO a) Source # 

Methods

observer :: IO a -> Parent -> IO a Source #

observers :: String -> (Observer -> IO a) -> IO a Source #

(Observable a, Observable b) => Observable (a -> b) Source # 

Methods

observer :: (a -> b) -> Parent -> a -> b Source #

observers :: String -> (Observer -> a -> b) -> a -> b Source #

(Observable a, Observable b) => Observable (Either a b) Source # 

Methods

observer :: Either a b -> Parent -> Either a b Source #

observers :: String -> (Observer -> Either a b) -> Either a b Source #

(Observable a, Observable b) => Observable (a, b) Source # 

Methods

observer :: (a, b) -> Parent -> (a, b) Source #

observers :: String -> (Observer -> (a, b)) -> (a, b) Source #

(Ix a, Observable a, Observable b) => Observable (Array a b) Source # 

Methods

observer :: Array a b -> Parent -> Array a b Source #

observers :: String -> (Observer -> Array a b) -> Array a b Source #

(Observable a, Observable b, Observable c) => Observable (a, b, c) Source # 

Methods

observer :: (a, b, c) -> Parent -> (a, b, c) Source #

observers :: String -> (Observer -> (a, b, c)) -> (a, b, c) Source #

(Observable a, Observable b, Observable c, Observable d) => Observable (a, b, c, d) Source # 

Methods

observer :: (a, b, c, d) -> Parent -> (a, b, c, d) Source #

observers :: String -> (Observer -> (a, b, c, d)) -> (a, b, c, d) Source #

(Observable a, Observable b, Observable c, Observable d, Observable e) => Observable (a, b, c, d, e) Source # 

Methods

observer :: (a, b, c, d, e) -> Parent -> (a, b, c, d, e) Source #

observers :: String -> (Observer -> (a, b, c, d, e)) -> (a, b, c, d, e) Source #

runO :: IO a -> IO () Source #

The main entry point; run some IO code, and debug inside it.

An example of using this debugger is

runO (print [ observe "+1" (+1) x | x <- observe "xs" [1..3]])
[2,3,4]
 -- +1
  {  1  -> 2
  }
 -- +1
  {  2  -> 3
  }
 -- +1
  {  3  -> 4
  }
 -- xs
  1 : 2 : 3 : []

Which says, the return is [2,3,4], there were 3 calls to +1 (showing arguments and results), and xs, which was the list 1 : 2 : 3 : [].

printO :: Show a => a -> IO () Source #

print a value, with debugging

putStrO :: String -> IO () Source #

print a string, with debugging

For advanced users, that want to render their own datatypes.

(<<) :: Observable a => ObserverM (a -> b) -> a -> ObserverM b infixl 9 Source #

thunk :: Observable a => a -> ObserverM a Source #

send :: String -> ObserverM a -> Parent -> a Source #

observeBase :: Show a => a -> Parent -> a Source #

observeOpaque :: String -> a -> Parent -> a Source #

For users that want to write there own render drivers.

debugO :: IO a -> IO [CDS] Source #

run some code and return the CDS structure (for when you want to write your own debugger).

data CDS Source #

Instances

Eq CDS Source # 

Methods

(==) :: CDS -> CDS -> Bool #

(/=) :: CDS -> CDS -> Bool #

Ord CDS Source # 

Methods

compare :: CDS -> CDS -> Ordering #

(<) :: CDS -> CDS -> Bool #

(<=) :: CDS -> CDS -> Bool #

(>) :: CDS -> CDS -> Bool #

(>=) :: CDS -> CDS -> Bool #

max :: CDS -> CDS -> CDS #

min :: CDS -> CDS -> CDS #

Show CDS Source # 

Methods

showsPrec :: Int -> CDS -> ShowS #

show :: CDS -> String #

showList :: [CDS] -> ShowS #

type CDSSet = [CDS] Source #