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