Idris2/tests/idris2/real001/MakeChans.idr

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 (LPair (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