content: {-# LANGUAGE NoImplicitPrelude, OverloadedStrings, DoAndIfThenElse #-}
  
  -- | This module provides a way in which the Haskell standard input may be forwarded to the IPython
  -- frontend and thus allows the notebook to use the standard input.
  --
  -- This relies on the implementation of file handles in GHC, and is generally unsafe and terrible.
  -- However, it is difficult to find another way to do it, as file handles are generally meant to
  -- point to streams and files, and not networked communication protocols.
  --
  -- In order to use this module, it must first be initialized with two things. First of all, in order
  -- to know how to communicate with the IPython frontend, it must know the kernel profile used for
  -- communication. For this, use @recordKernelProfile@ once the profile is known. Both this and
  -- @recordParentHeader@ take a directory name where they can store this data.
  --
  --
  -- Finally, the module must know what @execute_request@ message is currently being replied to (which
  -- will request the input). Thus, every time the language kernel receives an @execute_request@
  -- message, it should inform this module via @recordParentHeader@, so that the module may generate
  -- messages with an appropriate parent header set. If this is not done, the IPython frontends will
  -- not recognize the target of the communication.
  --
  -- Finally, in order to activate this module, @fixStdin@ must be called once. It must be passed the
  -- same directory name as @recordParentHeader@ and @recordKernelProfile@. Note that if this is being
  -- used from within the GHC API, @fixStdin@ /must/ be called from within the GHC session not from
  -- the host code.
  module IHaskell.IPython.Stdin (fixStdin, recordParentHeader, recordKernelProfile) where
  
  import           IHaskellPrelude
  
  import           Control.Concurrent
  import           Control.Applicative ((<$>))
  import           GHC.IO.Handle
  import           GHC.IO.Handle.Types
  import           System.FilePath ((</>))
  import           System.Posix.IO
  import           System.IO.Unsafe
  
  import           IHaskell.IPython.Types
  import           IHaskell.IPython.ZeroMQ
  import           IHaskell.IPython.Message.UUID as UUID
  
  stdinInterface :: MVar ZeroMQStdin
  {-# NOINLINE stdinInterface #-}
  stdinInterface = unsafePerformIO newEmptyMVar
  
  -- | Manipulate standard input so that it is sourced from the IPython frontend. This function is
  -- build on layers of deep magical hackery, so be careful modifying it.
  fixStdin :: String -> IO ()
  fixStdin dir = do
    -- Initialize the stdin interface.
    let fpath = dir </> ".kernel-profile"
    profile <- fromMaybe (error $ "fixStdin: Failed reading " ++ fpath)
                . readMay <$> readFile fpath
    interface <- serveStdin profile
    putMVar stdinInterface interface
    void $ forkIO $ stdinOnce dir
  
  stdinOnce :: String -> IO ()
  stdinOnce dir = do
    -- Create a pipe using and turn it into handles.
    (readEnd, writeEnd) <- createPipe
    newStdin <- fdToHandle readEnd
    stdinInput <- fdToHandle writeEnd
    hSetBuffering newStdin NoBuffering
    hSetBuffering stdinInput NoBuffering
  
    -- Store old stdin and swap in new stdin.
    oldStdin <- hDuplicate stdin
    hDuplicateTo newStdin stdin
  
    loop stdinInput oldStdin newStdin
  
    where
      loop stdinInput oldStdin newStdin = do
        let FileHandle _ mvar = stdin
        threadDelay $ 150 * 1000
        e <- isEmptyMVar mvar
        if not e
          then loop stdinInput oldStdin newStdin
          else do
            line <- getInputLine dir
            hPutStr stdinInput $ line ++ "\n"
            loop stdinInput oldStdin newStdin
  
  -- | Get a line of input from the IPython frontend.
  getInputLine :: String -> IO String
  getInputLine dir = do
    StdinChannel req rep <- readMVar stdinInterface
  
    -- Send a request for input.
    uuid <- UUID.random
    let fpath = dir </> ".last-req-header"
    parentHdr <- fromMaybe (error $ "getInputLine: Failed reading " ++ fpath)
                  . readMay <$> readFile fpath
    let hdr = MessageHeader (mhIdentifiers parentHdr) (Just parentHdr) mempty
                uuid (mhSessionId parentHdr) (mhUsername parentHdr) InputRequestMessage
                []
    let msg = RequestInput hdr ""
    writeChan req msg
  
    -- Get the reply.
    InputReply _ value <- readChan rep
    return value
  
  recordParentHeader :: String -> MessageHeader -> IO ()
  recordParentHeader dir hdr =
    writeFile (dir ++ "/.last-req-header") $ show hdr
  
  recordKernelProfile :: String -> Profile -> IO ()
  recordKernelProfile dir profile =
    writeFile (dir ++ "/.kernel-profile") $ show profile
  