-- |
-- 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
        (s
ds, Session m s
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 (Either a b
mx, Wire s a Identity () b
w) = Wire s a Identity () b
-> s
-> Either a ()
-> Identity (Either a b, Wire s a Identity () b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s a Identity () b
w' s
ds (() -> Either a ()
forall a b. b -> Either a b
Right ())
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            Char -> IO ()
putChar Char
'\r'
            String -> IO ()
putStr ((a -> String) -> (b -> String) -> Either a b -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
ex -> String
"I: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
ex) b -> String
forall a. Show a => a -> String
show Either a b
mx)
            String -> IO ()
putStr String
"\027[K"
            Handle -> IO ()
hFlush Handle
stdout
        Session m s -> Wire s a Identity () b -> m b
loop Session m s
s Wire s a Identity () b
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
        (s
ds, Session m s
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'
        (Either a b
mx, Wire s a m' () b
w) <- m' (Either a b, Wire s a m' () b)
-> m (Either a b, Wire s a m' () b)
forall a. m' a -> m a
run (Wire s a m' () b
-> s -> Either a () -> m' (Either a b, Wire s a m' () b)
forall (m :: * -> *) s e a b.
Monad m =>
Wire s e m a b -> s -> Either e a -> m (Either e b, Wire s e m a b)
stepWire Wire s a m' () b
w' s
ds (() -> Either a ()
forall a b. b -> Either a b
Right ()))
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            Char -> IO ()
putChar Char
'\r'
            String -> IO ()
putStr ((a -> String) -> (b -> String) -> Either a b -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
ex -> String
"I: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
ex) b -> String
forall a. Show a => a -> String
show Either a b
mx)
            String -> IO ()
putStr String
"\027[K"
            Handle -> IO ()
hFlush Handle
stdout
        Session m s -> Wire s a m' () b -> m b
loop Session m s
s Wire s a m' () b
w