oi-0.0.4: sample/talk.hs

{-# 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