module IHaskell.IPython.Stdin (
fixStdin,
recordParentHeader,
recordKernelProfile
) where
import Control.Concurrent
import Control.Applicative ((<$>))
import Control.Concurrent.Chan
import Control.Monad
import GHC.IO.Handle
import GHC.IO.Handle.Types
import System.IO
import System.Posix.IO
import System.IO.Unsafe
import qualified Data.Map as Map
import IHaskell.IPython.Types
import IHaskell.IPython.ZeroMQ
import IHaskell.IPython.Message.UUID as UUID
stdinInterface :: MVar ZeroMQStdin
stdinInterface = unsafePerformIO newEmptyMVar
fixStdin :: String -> IO ()
fixStdin dir = do
profile <- read <$> readFile (dir ++ "/.kernel-profile")
interface <- serveStdin profile
putMVar stdinInterface interface
void $ forkIO $ stdinOnce dir
stdinOnce :: String -> IO ()
stdinOnce dir = do
(readEnd, writeEnd) <- createPipe
newStdin <- fdToHandle readEnd
stdinInput <- fdToHandle writeEnd
hSetBuffering newStdin NoBuffering
hSetBuffering stdinInput NoBuffering
oldStdin <- hDuplicate stdin
hDuplicateTo newStdin stdin
loop stdinInput oldStdin newStdin
where
loop stdinInput oldStdin newStdin = do
let FileHandle _ mvar = stdin
threadDelay $ 150 * 1000
empty <- isEmptyMVar mvar
if not empty
then loop stdinInput oldStdin newStdin
else do
line <- getInputLine dir
hPutStr stdinInput $ line ++ "\n"
loop stdinInput oldStdin newStdin
getInputLine :: String -> IO String
getInputLine dir = do
StdinChannel req rep <- readMVar stdinInterface
uuid <- UUID.random
parentHeader <- read <$> readFile (dir ++ "/.last-req-header")
let header = MessageHeader {
username = username parentHeader,
identifiers = identifiers parentHeader,
parentHeader = Just parentHeader,
messageId = uuid,
sessionId = sessionId parentHeader,
metadata = Map.fromList [],
msgType = InputRequestMessage
}
let msg = RequestInput header ""
writeChan req msg
InputReply _ value <- readChan rep
return value
recordParentHeader :: String -> MessageHeader -> IO ()
recordParentHeader dir header =
writeFile (dir ++ "/.last-req-header") $ show header
recordKernelProfile :: String -> Profile -> IO ()
recordKernelProfile dir profile =
writeFile (dir ++ "/.kernel-profile") $ show profile