{-# LINE 1 "libraries/ghci/GHCi/Utils.hsc" #-}
{-# LANGUAGE CPP #-}
module GHCi.Utils
  ( getGhcHandle
  , readGhcHandle
  )
where

import Prelude
import Foreign.C
import GHC.IO.Handle (Handle())

{-# LINE 26 "libraries/ghci/GHCi/Utils.hsc" #-}
import System.Posix

{-# LINE 28 "libraries/ghci/GHCi/Utils.hsc" #-}

-- | Gets a GHC Handle File description from the given OS Handle or POSIX fd.


{-# LINE 52 "libraries/ghci/GHCi/Utils.hsc" #-}
getGhcHandle :: CInt -> IO Handle
getGhcHandle :: CInt -> IO Handle
getGhcHandle CInt
fd     = Fd -> IO Handle
fdToHandle (Fd -> IO Handle) -> Fd -> IO Handle
forall a b. (a -> b) -> a -> b
$ CInt -> Fd
Fd CInt
fd

{-# LINE 55 "libraries/ghci/GHCi/Utils.hsc" #-}

-- | Read a handle passed on the command-line and prepare it to be used with the IO manager
readGhcHandle :: String -> IO Handle
readGhcHandle :: String -> IO Handle
readGhcHandle String
s = do

{-# LINE 68 "libraries/ghci/GHCi/Utils.hsc" #-}
  let fd :: CInt
fd = String -> CInt
forall a. Read a => String -> a
Prelude.read String
s

{-# LINE 70 "libraries/ghci/GHCi/Utils.hsc" #-}
  getGhcHandle fd