import Control.Wire
import Prelude hiding ((.), id)
import Control.Wire.Core (mkGen_)
import Control.Wire.Unsafe.Event (Event (..))

import Control.Monad
import Control.Concurrent
import System.IO


-- The Wires --

-- filters only specific key events
keyA, keyQ :: Wire s () IO (MVar Char) (Event Char)
keyQ = filterE (== 'q') . keyEvent
keyA = filterE (== 'a') . keyEvent

testWire1, testWire2 :: Wire s () IO (MVar Char) Char
testWire1 = hold . keyEvent -- works fine, I get a 'stream' of Chars, every
                            -- time I press a key the stream reacts correctly
testWire2 = hold . (keyQ &> keyA)
        -- I would expect this to ignore non 'q'/'a' keypresses (ok) and
        -- react similarly to testWire1 (i.e. every time I press 'q' or 'a'
        -- the behaviour changes accordingly.
        -- But it doesn't work like that: 'q' works, 'a' does not


-- IO --

-- creates input mvar, runs wire
main :: IO ()
main =  do mv <- input
           runNetwork clockSession_ testWire2 mv

-- creates an endless loop of getChar, which will be stored in a MVar
-- returns said MVar
input :: IO (MVar Char)
input =  do hSetBuffering stdout NoBuffering
            hSetEcho stdin False
            mv <- newEmptyMVar
            forkIO (forever $ looperino mv)
            return mv
    where looperino m = do c <- getChar
                           if c == 'x' then error "exited"
                                       else tryPutMVar m c


-- Netwire Plumbing --

keyEvent :: Wire s () IO (MVar Char) (Event Char)
keyEvent = mkGen_ f
    where
          f :: MVar Char -> IO (Either () (Event Char))
          f r = tryTakeMVar r >>= \mmv ->
                case mmv of
                  Nothing -> return $ Right NoEvent
                  Just c  -> putStrLn ("pop: " ++ [c]) >>
                             return (Right (Event c))

runNetwork :: (Show b) => Session IO s -> Wire s () IO (MVar Char) b ->
                          MVar Char -> IO ()
runNetwork s w mv =
        do (st, s') <- stepSession s
           (wr, w') <- stepWire w st (Right mv)
           disp wr
           threadDelay (10^6) -- for debugging purposes
           runNetwork s' w' mv
    where
          disp :: (Show l, Show r) => Either l r -> IO ()
          disp (Left _)  = return ()
          disp (Right a) = putStr (show a)