{-|
Module      : Debug.Hoed.Notrace
Description : Lighweight algorithmic debugging based on observing intermediate values.
Copyright   : (c) 2016 Maarten Faddegon
License     : BSD3
Maintainer  : hoed@maartenfaddegon.nl
Stability   : experimental
Portability : POSIX

Hoed is a tracer and debugger for the programming language Haskell.

This is a drop-in replacement of the Debug.Hoed.Pure or Debug.Hoed.Stk modules and disables tracing (all functions are variations of id).

Read more about Hoed on its project homepage <https://wiki.haskell.org/Hoed>.

Papers on the theory behind Hoed can be obtained via <http://maartenfaddegon.nl/#pub>.

I am keen to hear about your experience with Hoed: where did you find it useful and where would you like to see improvement? You can send me an e-mail at hoed@maartenfaddegon.nl, or use the github issue tracker <https://github.com/MaartenFaddegon/hoed/issues>.
-}

{-# LANGUAGE DefaultSignatures, CPP #-}

module Debug.NoHoed
( observe
, runO
, printO
, testO
, observeBase
, Observable(..)
, Parent(..)
, Generic(..)
, send
, ObserverM(..)
, (<<)
) where
import GHC.Generics
import System.IO.Unsafe
import Control.Monad

observe :: String -> a -> a
observe _ = id

runO :: IO a -> IO ()
runO program = do
  program
  return ()

printO :: (Show a) => a -> IO ()
printO expr = print expr

testO :: Show a => (a->Bool) -> a -> IO ()
testO p x = putStrLn $ if (p x) then "Passed 1 test."
                                else " *** Failed! Falsifiable: " ++ show x

data Parent = Parent
class Observable a where
        observer  :: a -> Parent -> a 
        default observer :: (Generic a) => a -> Parent -> a
        observer x _ = x

        constrain :: a -> a -> a
        default constrain :: (Generic a) => a -> a -> a
        constrain x _ = x

observeBase :: a -> Parent -> a 
observeBase x _ = x

constrainBase :: a -> a -> a
constrainBase x _ = x

newtype ObserverM a = ObserverM { runMO :: Int -> Int -> (a,Int) }

instance Functor ObserverM where
    fmap  = liftM

#if __GLASGOW_HASKELL__ >= 710
instance Applicative ObserverM where
    pure  = return
    (<*>) = ap
#endif

instance Monad ObserverM where
        return a = ObserverM (\ c i -> (a,i))
        fn >>= k = ObserverM (\ c i ->
                case runMO fn c i of
                  (r,i2) -> runMO (k r) c i2
                )

(<<) :: (Observable a) => ObserverM (a -> b) -> a -> ObserverM b
fn << a = do {fn' <- fn; return (fn' a)}

send :: String -> ObserverM a -> Parent -> a
send _ fn context =
  unsafePerformIO $ do { let (r,portCount) = runMO fn 0 0
                       ; return r
                       }

instance Observable Int where
  observer  = observeBase
  constrain = constrainBase
                                 
instance Observable Bool where
  observer  = observeBase
  constrain = constrainBase
                                 
instance Observable Integer where
  observer  = observeBase
  constrain = constrainBase
                                 
instance Observable Float where
  observer  = observeBase
  constrain = constrainBase
                                 
instance Observable Double where
  observer  = observeBase
  constrain = constrainBase
                                 
instance Observable Char where
  observer  = observeBase
  constrain = constrainBase
                                 
instance Observable () where
  observer  = observeBase
  constrain = constrainBase

instance (Observable a) => Observable [a] where
  observer  = observeBase
  constrain = constrainBase