-- |
-- Module:     Control.Wire.Run
-- Copyright:  (c) 2013 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>

{-# LANGUAGE RankNTypes #-}

module Control.Wire.Run
    ( -- * Testing wires
      testWire,
      testWireM
    )
    where

import Control.Monad.IO.Class
import Control.Wire.Core
import Control.Wire.Session
import Data.Functor.Identity
import System.IO


-- | This function runs the given wire using the given state delta
-- generator.  It constantly shows the output of the wire on one line on
-- stdout.  Press Ctrl-C to abort.

testWire ::
    (MonadIO m, Show b, Show e)
    => Session m s
    -> (forall a. Wire s e Identity a b)
    -> m c
testWire :: forall (m :: * -> *) b e s c.
(MonadIO m, Show b, Show e) =>
Session m s -> (forall a. Wire s e Identity a b) -> m c
testWire Session m s
s0 forall a. Wire s e Identity a b
w0 = Session m s -> Wire s e Identity () b -> m c
forall {m :: * -> *} {a} {b} {s} {b}.
(MonadIO m, Show a, Show b) =>
Session m s -> Wire s a Identity () b -> m b
loop Session m s
s0 Wire s e Identity () b
forall a. Wire s e Identity a b
w0
    where
    loop :: Session m s -> Wire s a Identity () b -> m b
loop Session m s
s' Wire s a Identity () b
w' = do
        (ds, s) <- Session m s -> m (s, Session m s)
forall (m :: * -> *) s. Session m s -> m (s, Session m s)
stepSession Session m s
s'
        let Identity (mx, w) = stepWire w' ds (Right ())
        liftIO $ do
            putChar '\r'
            putStr (either (\a
ex -> String
"I: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
ex) show mx)
            putStr "\027[K"
            hFlush stdout
        loop s w


-- | This function runs the given wire using the given state delta
-- generator.  It constantly shows the output of the wire on one line on
-- stdout.  Press Ctrl-C to abort.

testWireM ::
    (Monad m', MonadIO m, Show b, Show e)
    => (forall a. m' a -> m a)
    -> Session m s
    -> (forall a. Wire s e m' a b)
    -> m c
testWireM :: forall (m' :: * -> *) (m :: * -> *) b e s c.
(Monad m', MonadIO m, Show b, Show e) =>
(forall a. m' a -> m a)
-> Session m s -> (forall a. Wire s e m' a b) -> m c
testWireM forall a. m' a -> m a
run Session m s
s0 forall a. Wire s e m' a b
w0 = Session m s -> Wire s e m' () b -> m c
forall {a} {b} {s} {b}.
(Show a, Show b) =>
Session m s -> Wire s a m' () b -> m b
loop Session m s
s0 Wire s e m' () b
forall a. Wire s e m' a b
w0
    where
    loop :: Session m s -> Wire s a m' () b -> m b
loop Session m s
s' Wire s a m' () b
w' = do
        (ds, s) <- Session m s -> m (s, Session m s)
forall (m :: * -> *) s. Session m s -> m (s, Session m s)
stepSession Session m s
s'
        (mx, w) <- run (stepWire w' ds (Right ()))
        liftIO $ do
            putChar '\r'
            putStr (either (\a
ex -> String
"I: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
ex) show mx)
            putStr "\027[K"
            hFlush stdout
        loop s w