Idris2/tests/idris2/real001/MakeChans.idr

84 lines
2.3 KiB
Idris
Raw Normal View History

module Main
import Channel
import Linear
data Cmd = Add | Append
Utils : Protocol ()
Utils
= do cmd <- Request Cmd
case cmd of
Add => do Request (Int, Int)
Respond Int
Done
Append => do Request (String, String)
Respond String
Done
utilServer : (1 chan : Server Utils) -> Any IO ()
utilServer chan
= do cmd @@ chan <- recv chan
case cmd of
Add => do (x, y) @@ chan <- recv chan
chan <- send chan (x + y)
close chan
Append => do (x, y) @@ chan <- recv chan
chan <- send chan (x ++ y)
close chan
MakeUtils : Protocol ()
MakeUtils = do cmd <- Request Bool
if cmd
then do Respond (Client Utils); Loop MakeUtils
else Done
sendUtils : (1 chan : Server MakeUtils) -> Any IO ()
sendUtils chan
= do cmd @@ chan <- recv chan
if cmd
then do cchan <- Channel.fork utilServer
chan <- send chan cchan
sendUtils chan
else close chan
getUtilsChan : (1 chan : Client MakeUtils) ->
One IO (Client Utils, Client MakeUtils)
getUtilsChan chan
= do chan <- send chan True
cchan @@ chan <- recv chan
pure (cchan, chan)
closeUtilsChan : (1 chan : Client MakeUtils) ->
Any IO ()
closeUtilsChan chan
= do chan <- send chan False
close chan
doThings : Any IO ()
doThings
= do -- lift $ printLn "Starting"
schan <- Channel.fork sendUtils
res <- getUtilsChan schan
let (uchan1, schan) = res
lift $ printLn "Got Chan 1"
(uchan2, schan) <- getUtilsChan schan
lift $ printLn "Got Chan 2"
closeUtilsChan schan
uchan1 <- send uchan1 Add
uchan2 <- send uchan2 Append
uchan2 <- send uchan2 ("aaa", "bbb")
res @@ uchan2 <- recv uchan2
close uchan2
lift $ printLn res
uchan1 <- send uchan1 (40, 54)
res @@ uchan1 <- recv uchan1
close uchan1
lift $ printLn res
main : IO ()
main = run doThings