IPC

IPC.hs

module IPC where

import           Control.Monad        (forever)
import           Data.Char            (toUpper)
import           GHC.IO.Handle.FD     (fdToHandle)
import           Prelude
import           System.IO            (BufferMode (..), hGetLine, hPrint,
                                       hPutStrLn, hSetBuffering)
import           System.Posix.Process (forkProcess)
import           System.Process       (createPipeFd)
import           Text.Read            (readEither)

-- | Example using two processes
--
-- We want server/client to read only the messages that each should care about
-- In order to realize this, we need two proccesses with each of them providing
-- read/write handle.
--
-- These processes will then pass each others handle respectively and use it to
-- communicate with each other.
--
-- Server will take client's write handle and server's read handle.
--
-- Client will take server's write handle and client's read handle.
--
-- This allows the two proccesses to send the message to the other while
-- reading the response that other had sent.
exampleWithProcess :: IO ()
exampleWithProcess = do
    (readFd, writeFd) <- createPipeFd
    clientReadHndl    <- fdToHandle readFd
    clientWriteHndl   <- fdToHandle writeFd

    hSetBuffering clientReadHndl LineBuffering
    hSetBuffering clientWriteHndl LineBuffering


    processId <- forkProcess $ do
        (readFd, writeFd) <- createPipeFd
        readHndl          <- fdToHandle readFd
        hSetBuffering readHndl LineBuffering

        -- Pass fd to parent process
        hPrint clientWriteHndl $ show writeFd

        forever $ do
            msg <- hGetLine readHndl
            hPutStrLn clientWriteHndl (map toUpper msg)


    -- Use these functions so you don't pass the wrong handle by mistake
    let readClientMessage :: IO String
        readClientMessage = hGetLine clientReadHndl

    -- Recieve fd from child
    serverWriteFd <- readClientMessage

    putStrLn serverWriteFd

    -- Error thrown here.
    serverWriteHandle <- either error fdToHandle (readEither serverWriteFd)

    hSetBuffering serverWriteHandle LineBuffering

    -- Communication starts here
    forever $ do
        input   <- getLine
        started <- hPutStrLn serverWriteHandle input
        msg     <- readClientMessage
        print msg