Created
February 21, 2019 04:12
-
-
Save HirotoShioi/a0222e19c5dd2746ae04d3a2ba88c1c0 to your computer and use it in GitHub Desktop.
IPC
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment