-- |
-- Copyright  : (c) Ivan Perez, 2017-2022
-- License    : BSD-style (see the LICENSE file in the distribution)
-- Maintainer : ivan.perez@keera.co.uk
--
-- Debug FRP networks by inspecting their behaviour inside.
module FRP.Yampa.Debug where

-- External imports
import Debug.Trace      (trace)
import FRP.Yampa        (SF, arr)
import System.IO.Unsafe (unsafePerformIO)

-- | Signal Function that prints the value passing through using 'trace'.
traceSF :: Show a => SF a a
traceSF :: forall a. Show a => SF a a
traceSF = forall a. (a -> String) -> SF a a
traceSFWith forall a. Show a => a -> String
show

-- | Signal Function that prints the value passing through using 'trace', and a
-- customizable 'show' function.
traceSFWith :: (a -> String) -> SF a a
traceSFWith :: forall a. (a -> String) -> SF a a
traceSFWith a -> String
f = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\a
x -> forall a. String -> a -> a
trace (a -> String
f a
x) a
x)

-- | Execute an IO action using 'unsafePerformIO' at every step, and ignore the
-- result.
traceSFWithIO :: (a -> IO b) -> SF a a
traceSFWithIO :: forall a b. (a -> IO b) -> SF a a
traceSFWithIO a -> IO b
f = forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\a
x -> forall a. IO a -> a
unsafePerformIO (a -> IO b
f a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
x))