{-# LANGUAGE TypeOperators #-} module Main where import Data.OI import Control.Parallel import System.Environment main :: IO () main = do { kbd1:scr1:kbd2:scr2:_ <- getArgs ; run (pmain kbd1 scr1 kbd2 scr2) } pmain :: FilePath -> FilePath -> FilePath -> FilePath -> ((String, [String], ()), (String, [String], ())) :-> () pmain kbd1 scr1 kbd2 scr2 r = let p1 = talk "Alice" kbd1 scr1 p2 = talk "Bob" kbd2 scr2 (is1,is2) = (p1 |><| p2) r in is1 `par` is2 (|><|) :: (q -> a :-> (p,c)) -> (p -> b :-> (q,d)) -> ((a,b) :-> (c,d)) (f |><| g) rasbs = case deTuple rasbs of (ras,rbs) -> (cs,ds) where { (xs,cs) = f ys ras; (ys,ds) = g xs rbs } talk :: String -- Talker name -> FilePath -> FilePath -> [String] -- Messages from the other end -> OI ( String -- Messages typed by the keyboard , [String] -- Oracles for merging messages , ()) -- Result of the process -> ([String] -- Messages to the other end ,()) -- Results of the process talk name kbd scr msg r = (ins,showscreen scr (mergeOI ins msg os) us) where (is,os,us) = deTriple r ins = map ((name ++ ": ")++) $ lines $ readkeyboard kbd is readkeyboard :: FilePath -> String :-> String readkeyboard = iooi . readFile showscreen :: FilePath -> [String] -> () :-> () showscreen s = iooi . writeFile s . unlines