ghc/lib/haskell-1.3/LibPosix.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
   3 %
   4 \section[LibPosix]{Haskell 1.3 POSIX bindings}
   5
   6 \begin{code}
   7 module LibPosix  (
   8     LibPosixDB..,
   9     LibPosixErr..,
  10     LibPosixFiles..,
  11     LibPosixIO..,
  12     LibPosixProcEnv..,
  13     LibPosixProcPrim..,
  14     LibPosixTTY..,
  15
  16     runProcess,
  17
  18     ByteCount(..),
  19     Channel(..),
  20     ClockTick(..),
  21     EpochTime(..),
  22     FileOffset(..),
  23     GroupID(..),
  24     Limit(..),
  25     LinkCount(..),
  26     ProcessID(..),
  27     ProcessGroupID(..),
  28     UserID(..),
  29
  30     ExitCode,
  31
  32     -- make interface complete:
  33     setCurrentDirectory{-pragmas-}, getCurrentDirectory{-pragmas-}
  34
  35     )  where
  36
  37 import LibPosixDB
  38 import LibPosixErr
  39 import LibPosixFiles
  40 import LibPosixIO
  41 import LibPosixProcEnv
  42 import LibPosixProcPrim
  43 import LibPosixTTY
  44 import LibPosixUtil
  45
  46 -- runProcess is our candidate for the high-level OS-independent primitive
  47 -- If accepted, it will be moved out of LibPosix into LibSystem.
  48
  49 import LibDirectory     ( setCurrentDirectory, getCurrentDirectory{-pragmas-} )
  50
  51 import PreludeGlaST
  52 import PreludePrimIO    ( takeMVar, putMVar, _MVar )
  53 import PreludeStdIO
  54
  55 runProcess :: FilePath                      -- Command
  56            -> [String]                      -- Arguments
  57            -> Maybe [(String, String)]      -- Environment
  58            -> Maybe FilePath                -- Working directory
  59            -> Maybe Handle                  -- stdin
  60            -> Maybe Handle                  -- stdout
  61            -> Maybe Handle                  -- stderr
  62            -> IO ()
  63 runProcess path args env dir stdin stdout stderr =
  64     forkProcess >>= \ pid ->
  65     case pid of
  66       Nothing -> doTheBusiness
  67       Just x  -> return ()
  68   where
  69     doTheBusiness :: IO ()
  70     doTheBusiness =
  71         maybeChangeWorkingDirectory     >>
  72         maybeDup2 0 stdin               >>
  73         maybeDup2 1 stdout              >>
  74         maybeDup2 2 stderr              >>
  75         executeFile path True args env  >>
  76         syserr "runProcess"
  77
  78     maybeChangeWorkingDirectory :: IO ()
  79     maybeChangeWorkingDirectory =
  80         case dir of
  81           Nothing -> return ()
  82           Just x  -> setCurrentDirectory x
  83
  84     maybeDup2 :: Int -> Maybe Handle -> IO ()
  85     maybeDup2 dest h =
  86         case h of Nothing -> return ()
  87                   Just x  -> handleFD x >>= \ src ->
  88                              dupChannelTo src dest >>
  89                              return ()
  90
  91     handleFD :: Handle -> IO Channel
  92     handleFD handle =
  93         takeMVar handle                             >>= \ htype ->
  94         putMVar handle htype                        >>
  95         case htype of
  96           _ErrorHandle ioError -> failWith ioError
  97           _ClosedHandle -> failWith (IllegalOperation "handle is closed")
  98           _SemiClosedHandle _ _ -> failWith (IllegalOperation "handle is closed")
  99           other ->
 100             _casm_ ``%r = fileno((FILE *)%0);'' (_filePtr other)
 101                                                     `thenPrimIO` \ fd ->
 102             return fd
 103
 104 \end{code}