ide-backend-common 0.10.1 → 0.10.1.1
raw patch · 10 files changed
+57/−468 lines, 10 filesdep −Win32dep −base64-bytestringdep −networkdep ~aesondep ~basePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies removed: Win32, base64-bytestring, network, process, time, unix-compat
Dependency ranges changed: aeson, base
API changes (from Hackage documentation)
- IdeSession.RPC.Sockets: ReadChannel :: PortID -> ReadChannel
- IdeSession.RPC.Sockets: WriteChannel :: PortID -> WriteChannel
- IdeSession.RPC.Sockets: acceptHandle :: Socket -> IO Handle
- IdeSession.RPC.Sockets: connectToPort :: PortID -> IO Handle
- IdeSession.RPC.Sockets: instance Data.Binary.Class.Binary IdeSession.RPC.Sockets.ReadChannel
- IdeSession.RPC.Sockets: instance Data.Binary.Class.Binary IdeSession.RPC.Sockets.WriteChannel
- IdeSession.RPC.Sockets: instance Data.Binary.Class.Binary Network.PortID
- IdeSession.RPC.Sockets: instance Data.Binary.Class.Binary Network.Socket.Types.PortNumber
- IdeSession.RPC.Sockets: instance GHC.Generics.Constructor IdeSession.RPC.Sockets.C1_0PortID
- IdeSession.RPC.Sockets: instance GHC.Generics.Constructor IdeSession.RPC.Sockets.C1_0PortNumber
- IdeSession.RPC.Sockets: instance GHC.Generics.Constructor IdeSession.RPC.Sockets.C1_0ReadChannel
- IdeSession.RPC.Sockets: instance GHC.Generics.Constructor IdeSession.RPC.Sockets.C1_0WriteChannel
- IdeSession.RPC.Sockets: instance GHC.Generics.Constructor IdeSession.RPC.Sockets.C1_1PortID
- IdeSession.RPC.Sockets: instance GHC.Generics.Constructor IdeSession.RPC.Sockets.C1_2PortID
- IdeSession.RPC.Sockets: instance GHC.Generics.Datatype IdeSession.RPC.Sockets.D1PortID
- IdeSession.RPC.Sockets: instance GHC.Generics.Datatype IdeSession.RPC.Sockets.D1PortNumber
- IdeSession.RPC.Sockets: instance GHC.Generics.Datatype IdeSession.RPC.Sockets.D1ReadChannel
- IdeSession.RPC.Sockets: instance GHC.Generics.Datatype IdeSession.RPC.Sockets.D1WriteChannel
- IdeSession.RPC.Sockets: instance GHC.Generics.Generic IdeSession.RPC.Sockets.ReadChannel
- IdeSession.RPC.Sockets: instance GHC.Generics.Generic IdeSession.RPC.Sockets.WriteChannel
- IdeSession.RPC.Sockets: instance GHC.Generics.Generic Network.PortID
- IdeSession.RPC.Sockets: instance GHC.Generics.Generic Network.Socket.Types.PortNumber
- IdeSession.RPC.Sockets: makeSocket :: IO Socket
- IdeSession.RPC.Sockets: newtype ReadChannel
- IdeSession.RPC.Sockets: newtype WriteChannel
- IdeSession.RPC.Sockets: portToString :: PortID -> String
- IdeSession.RPC.Sockets: stringToPort :: String -> PortID
- IdeSession.Types.Public: UpdateStatusErrorRestart :: Text -> UpdateStatus
- IdeSession.Types.Public: UpdateStatusFailedToRestart :: UpdateStatus
- IdeSession.Util: ReqRunConversation :: Pid -> WriteChannel -> ReadChannel -> FilePath -> ReqRunRpc
- IdeSession.Util: ReqRunUnsupported :: String -> ReqRunRpc
- IdeSession.Util: UnsupportedOnNonUnix :: String -> UnsupportedOnNonUnix
- IdeSession.Util: data ReqRunRpc
- IdeSession.Util: instance Data.Binary.Class.Binary IdeSession.Util.ReqRunRpc
- IdeSession.Util: instance GHC.Exception.Exception IdeSession.Util.UnsupportedOnNonUnix
- IdeSession.Util: instance GHC.Generics.Constructor IdeSession.Util.C1_0ReqRunRpc
- IdeSession.Util: instance GHC.Generics.Constructor IdeSession.Util.C1_1ReqRunRpc
- IdeSession.Util: instance GHC.Generics.Datatype IdeSession.Util.D1ReqRunRpc
- IdeSession.Util: instance GHC.Generics.Generic IdeSession.Util.ReqRunRpc
- IdeSession.Util: instance GHC.Show.Show IdeSession.Util.UnsupportedOnNonUnix
- IdeSession.Util: newtype UnsupportedOnNonUnix
- IdeSession.Util.PortableFiles: getFileStatus :: FilePath -> IO FileStatus
- IdeSession.Util.PortableFiles: modificationTime :: FileStatus -> EpochTime
- IdeSession.Util.PortableFiles: moduleNameToExeName :: String -> String
- IdeSession.Util.PortableFiles: setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()
- IdeSession.Util.PortableFiles: toExecutable :: String -> String
- IdeSession.Util.PortableIO: closeFd :: FileDescriptor -> IO ()
- IdeSession.Util.PortableIO: createPipe :: IO (FileDescriptor, FileDescriptor)
- IdeSession.Util.PortableIO: dup :: FileDescriptor -> IO FileDescriptor
- IdeSession.Util.PortableIO: dupTo :: FileDescriptor -> FileDescriptor -> IO FileDescriptor
- IdeSession.Util.PortableIO: fdToHandle :: FileDescriptor -> IOMode -> IO Handle
- IdeSession.Util.PortableIO: handleToFd :: Handle -> IO FileDescriptor
- IdeSession.Util.PortableIO: openWritableFile :: FilePath -> IO FileDescriptor
- IdeSession.Util.PortableIO: stdError :: FileDescriptor
- IdeSession.Util.PortableIO: stdInput :: FileDescriptor
- IdeSession.Util.PortableIO: stdOutput :: FileDescriptor
- IdeSession.Util.PortableIO: type FileDescriptor = Fd
- IdeSession.Util.PortableProcess: killProcessHandle :: ProcessHandle -> IO ()
- IdeSession.Util.PortableProcess: raiseSigKill :: IO ()
- IdeSession.Util.PortableProcess: sigKillExitCode :: Int
- IdeSession.Util.PortableProcess: sigKillProcess :: Pid -> IO ()
- IdeSession.Util.PortableProcess: sigTermProcess :: Pid -> IO ()
- IdeSession.Util.PortableProcess: type Pid = ProcessID
+ IdeSession.Types.Public: UpdateStatusCrashRestart :: Text -> UpdateStatus
+ IdeSession.Types.Public: UpdateStatusServerDied :: Text -> UpdateStatus
- IdeSession.RPC.Server: concurrentConversation :: Socket -> Socket -> FilePath -> (FilePath -> RpcConversation -> IO ()) -> IO ()
+ IdeSession.RPC.Server: concurrentConversation :: FilePath -> FilePath -> FilePath -> (FilePath -> RpcConversation -> IO ()) -> IO ()
- IdeSession.Util: swizzleStderr :: FileDescriptor -> IO a -> IO a
+ IdeSession.Util: swizzleStderr :: Fd -> IO a -> IO a
- IdeSession.Util: swizzleStdout :: FileDescriptor -> IO a -> IO a
+ IdeSession.Util: swizzleStdout :: Fd -> IO a -> IO a
Files
- ChangeLog.md +0/−3
- IdeSession/RPC/Server.hs +20/−13
- IdeSession/RPC/Sockets.hs +0/−77
- IdeSession/RPC/Stream.hs +9/−19
- IdeSession/Types/Public.hs +4/−15
- IdeSession/Util.hs +20/−42
- IdeSession/Util/PortableFiles.hs +0/−71
- IdeSession/Util/PortableIO.hs +0/−129
- IdeSession/Util/PortableProcess.hs +0/−81
- ide-backend-common.cabal +4/−18
− ChangeLog.md
@@ -1,3 +0,0 @@-## 0.10.1--* Fix build failure with pretty-show 1.6.9 due to orphan instances
IdeSession/RPC/Server.hs view
@@ -13,6 +13,8 @@ , hSetBuffering , BufferMode(BlockBuffering) )+import System.Posix.Types (Fd)+import System.Posix.IO (closeFd, fdToHandle) import Control.Monad (void) import qualified Control.Exception as Ex import Control.Concurrent (threadDelay)@@ -21,12 +23,9 @@ import Control.Concurrent.Async (Async, async) import Data.Binary (encode, decode) -import Network- import IdeSession.Util.BlockingOps (readChan, wait, waitAny) import IdeSession.RPC.API import IdeSession.RPC.Stream-import IdeSession.RPC.Sockets -------------------------------------------------------------------------------- -- Server-side API --@@ -44,24 +43,32 @@ -> [String] -- ^ Command line args -> IO () rpcServer handler args = do- let errorLog : ports = args- [request, response] = map stringToPort ports+ let readFd :: String -> Fd+ readFd fd = fromIntegral (read fd :: Int) - request' <- connectToPort request- response' <- connectToPort response+ let errorLog : fds = args+ [requestR, requestW, responseR, responseW] = map readFd fds - rpcServer' request' response' errorLog handler+ closeFd requestW+ closeFd responseR+ requestR' <- fdToHandle requestR+ responseW' <- fdToHandle responseW + rpcServer' requestR' responseW' errorLog handler+ -- | Start a concurrent conversation.-concurrentConversation :: Socket -- ^ input, stdin named pipe on unix- -> Socket -- ^ output, stdout named pipe on unix+concurrentConversation :: FilePath -- ^ stdin named pipe+ -> FilePath -- ^ stdout named pipe -> FilePath -- ^ log file for exceptions -> (FilePath -> RpcConversation -> IO ()) -> IO ()-concurrentConversation request response errorLog server = do- hin <- acceptHandle request- hout <- acceptHandle response+concurrentConversation requestR responseW errorLog server = do+ hin <- openPipeForReading requestR timeout+ hout <- openPipeForWriting responseW timeout rpcServer' hin hout errorLog server+ where+ timeout :: Int+ timeout = maxBound -- | Start the RPC server rpcServer' :: Handle -- ^ Input
− IdeSession/RPC/Sockets.hs
@@ -1,77 +0,0 @@-{-# LANGUAGE CPP, StandaloneDeriving, DeriveGeneric, DeriveDataTypeable #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}---- This module provies an interface for using sockets in RPC communication.-module IdeSession.RPC.Sockets (- portToString- , makeSocket- , connectToPort- , stringToPort- , acceptHandle- , ReadChannel(..)- , WriteChannel(..)-) where--import System.IO (Handle)--import GHC.Generics (Generic)-import Data.Typeable (Typeable)-import Data.Binary-import Network-import Data.ByteString.Lazy.Char8-import qualified Data.ByteString.Base64.Lazy as Base64-import Network.Socket hiding (close, sClose, accept, socketPort)--#ifdef VERSION_unix--- import Control.Exception--- import Control.Concurrent.MVar-import System.IO.Temp (createTempDirectory)-import System.FilePath ((</>))-import System.Directory (getTemporaryDirectory)-#endif--newtype ReadChannel = ReadChannel PortID deriving (Generic, Typeable)-newtype WriteChannel = WriteChannel PortID deriving (Generic, Typeable)--instance Binary ReadChannel-instance Binary WriteChannel---- Creating a socket with auto generated port (or file in case Unix domain--- sockets are used)-makeSocket :: IO Socket--#ifdef VERSION_unix-makeSocket = do- tmpDir <- getTemporaryDirectory- rpcDir <- createTempDirectory tmpDir "ide-backend-rpc."- let rpcFile = rpcDir </> "rpc"- s <- listenOn $ UnixSocket rpcFile- p <- socketPort s- return s---#else-{- On non-Unix we use a plain socket -}-makeSocket = listenOn $ PortNumber aNY_PORT-#endif--connectToPort :: PortID -> IO Handle-connectToPort = connectTo "localhost"--acceptHandle :: Socket -> IO Handle-acceptHandle s = do- (h, _, _) <- accept s- return h--portToString :: PortID -> String-portToString = unpack . Base64.encode . encode--stringToPort :: String -> PortID-stringToPort = decode . Base64.decodeLenient . pack---{- Orphans -}-deriving instance Generic PortID-deriving instance Generic PortNumber-instance Binary PortID-instance Binary PortNumber
IdeSession/RPC/Stream.hs view
@@ -7,7 +7,7 @@ ) where import Prelude hiding (take)-import System.IO (Handle, hIsEOF)+import System.IO (Handle) import qualified Control.Exception as Ex import qualified Data.ByteString.Lazy.Internal as BSL import qualified Data.ByteString as BSS@@ -31,30 +31,20 @@ go atEnd decoder = case decoder of Binary.Fail _ _ err -> do writeIORef st decoder- throwUserError $+ Ex.throwIO $ userError $ if atEnd- then "IdeSession.RPC.Stream ended, causing: " ++ err+ then "IdeSession.RPC.Stream ended, causing " ++ err else "IdeSession.RPC.Stream decode failure: " ++ err Binary.Partial k -> do- eof <- hIsEOF h- -- For some reason doing this check helps avoiding race conditions in- -- in various scenarios when the server is force terminated.- -- E.g., the tests in SessionRestart.hs- if eof then throwUserError "IdeSession.RPC.Stream input handle closed unexpectedly"- else do- mchunk <- Ex.try $ BSS.hGetSome h BSL.defaultChunkSize- case mchunk of- Left (ex :: Ex.SomeException) -> do- writeIORef st decoder- -- wrapping with a user error so that it's easier to catch later on- throwUserError $ "IdeSession.RPC.Stream ended unexpectedly, causing: " ++ show ex- Right chunk | BSS.null chunk -> go True . k $ Nothing- | otherwise -> go False . k $ Just chunk+ mchunk <- Ex.try $ BSS.hGetSome h BSL.defaultChunkSize+ case mchunk of+ Left ex -> do writeIORef st decoder+ Ex.throwIO (ex :: Ex.SomeException)+ Right chunk | BSS.null chunk -> go True . k $ Nothing+ | otherwise -> go False . k $ Just chunk Binary.Done unused _numConsumed a -> do writeIORef st $ contDecoder unused return a contDecoder :: BSS.ByteString -> Binary.Decoder a contDecoder = Binary.pushChunk (Binary.runGetIncremental Binary.get)-- throwUserError = Ex.throwIO . userError
IdeSession/Types/Public.hs view
@@ -255,23 +255,12 @@ -- | This type represents the status of the compilation from an IDE update. data UpdateStatus =- -- | Indicates that the server is restarting because it needs to to fulfil the- -- update.- UpdateStatusRequiredRestart- -- | Indicates that this update has caused the server to start again, since it- -- died last update.- | UpdateStatusErrorRestart Text- -- | Gives compilation progress updates.+ UpdateStatusFailed Text+ | UpdateStatusRequiredRestart+ | UpdateStatusCrashRestart Text+ | UpdateStatusServerDied Text | UpdateStatusProgress Progress-- -- | The update completed successfully. | UpdateStatusDone- -- | The update failed, yielding an error. No more status updates should come- -- after this.- | UpdateStatusFailed Text- -- The server tried to restart, but failed to restart. No more status updates- -- should come after this.- | UpdateStatusFailedToRestart deriving (Typeable, Generic, Eq, Show) {------------------------------------------------------------------------------
IdeSession/Util.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveFunctor, DeriveGeneric, DeriveDataTypeable, StandaloneDeriving, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveFunctor, DeriveGeneric, StandaloneDeriving, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module IdeSession.Util ( -- * Misc util@@ -21,11 +21,8 @@ , swizzleStderr , redirectStderr , captureOutput- , UnsupportedOnNonUnix(..)- , ReqRunRpc(..)-) where+ ) where -import Control.Exception import Control.Applicative ((<$>)) import Control.Monad (void, forM_, mplus) import Crypto.Classes (blockLength, initialCtx, updateCtx, finalize)@@ -40,25 +37,20 @@ import Data.Text (Text) import Data.Typeable (typeOf) import Foreign.C.Types (CFile)-import Foreign.Ptr (Ptr, castPtr, )+import Foreign.Ptr (Ptr, castPtr, nullPtr) import GHC.Generics (Generic) import GHC.IO (unsafeUnmask) import System.Directory (createDirectoryIfMissing, removeFile, renameFile)-import System.Environment (getEnvironment, setEnv, unsetEnv)+import System.Environment (getEnvironment) import System.FilePath (splitFileName, (<.>), (</>)) import System.FilePath (splitSearchPath, searchPathSeparator) import System.IO import System.IO.Error (isDoesNotExistError)-import Data.Typeable (Typeable)-import Network--import Foreign.Ptr (nullPtr) import System.IO.Temp (withSystemTempFile)-import IdeSession.Util.PortableIO-import IdeSession.RPC.Sockets-import IdeSession.Util.PortableProcess--import System.PosixCompat.Types (CPid(..))+import System.Posix (Fd)+import System.Posix.Env (setEnv, unsetEnv)+import System.Posix.IO+import System.Posix.Types (CPid(..)) import Text.Show.Pretty import qualified Control.Exception as Ex import qualified Data.Attoparsec.Text as Att@@ -70,6 +62,7 @@ import qualified Data.ByteString.Lazy as BSL import qualified Data.Text as Text import qualified Data.Text.Foreign as Text+import qualified System.Posix.Files as Files import IdeSession.Strict.Container import qualified IdeSession.Strict.Map as StrictMap@@ -177,14 +170,12 @@ forM_ curEnv $ \(var, _val) -> unsetEnv var -- Restore initial environment- forM_ initEnv $ \(var, val) -> setEnv var val- -- previously used the Posix setEnv, which had an explicit flag for overwrites (set to True)- -- not sure about the behavior of the portable version+ forM_ initEnv $ \(var, val) -> setEnv var val True -- Apply overrides forM_ overrides $ \(var, mVal) -> case mVal of- Just val -> setEnv var val -- see comment about setEnv above+ Just val -> setEnv var val True Nothing -> unsetEnv var relInclToOpts :: FilePath -> [FilePath] -> [String]@@ -267,17 +258,18 @@ {------------------------------------------------------------------------------- Manipulations with stdout and stderr. -------------------------------------------------------------------------------}-swizzleStdout :: FileDescriptor -> IO a -> IO a++swizzleStdout :: Fd -> IO a -> IO a swizzleStdout = swizzleHandle (stdout, stdOutput) -swizzleStderr :: FileDescriptor -> IO a -> IO a+swizzleStderr :: Fd -> IO a -> IO a swizzleStderr = swizzleHandle (stderr, stdError) -swizzleHandle :: (Handle, FileDescriptor) -> FileDescriptor -> IO a -> IO a+swizzleHandle :: (Handle, Fd) -> Fd -> IO a -> IO a swizzleHandle (targetHandle, targetFd) fd act = Ex.bracket swizzle unswizzle (\_ -> act) where- swizzle :: IO FileDescriptor+ swizzle :: IO Fd swizzle = do -- Flush existing handles hFlush targetHandle@@ -289,7 +281,7 @@ return backup - unswizzle :: FileDescriptor -> IO ()+ unswizzle :: Fd -> IO () unswizzle backup = do -- Flush handles again hFlush targetHandle@@ -301,10 +293,12 @@ redirectStderr :: FilePath -> IO a -> IO a redirectStderr fp act = do- Ex.bracket (openWritableFile fp)+ Ex.bracket (openFd fp WriteOnly (Just mode) defaultFileFlags) closeFd $ \errorLogFd -> swizzleStderr errorLogFd $ act+ where+ mode = Files.unionFileModes Files.ownerReadMode Files.ownerWriteMode captureOutput :: IO a -> IO (String, a) captureOutput act = do@@ -314,22 +308,6 @@ closeFd fd suppressed <- readFile fp return (suppressed, a)--{-------------------------------------------------------------------------------- Non-Unix compatibility--------------------------------------------------------------------------------}---- A data type for RPC communication when trying to run a @ReqRun@ value on the server--- Encoding the possibility that the action is not supported-data ReqRunRpc = ReqRunConversation Pid WriteChannel ReadChannel FilePath- | ReqRunUnsupported String- deriving (Generic, Typeable)--instance Binary ReqRunRpc--newtype UnsupportedOnNonUnix = UnsupportedOnNonUnix String- deriving (Typeable, Show)-instance Exception UnsupportedOnNonUnix {------------------------------------------------------------------------------- Orphans
− IdeSession/Util/PortableFiles.hs
@@ -1,71 +0,0 @@-{-# LANGUAGE CPP #-}-module IdeSession.Util.PortableFiles (- setFileTimes- , getFileStatus- , modificationTime- , toExecutable- , moduleNameToExeName-) where---import System.PosixCompat.Types-import System.PosixCompat.Files hiding (setFileTimes)--#ifdef VERSION_unix-import qualified System.Posix.Files as Posix-#else-import Foreign-import Data.Time.Clock.POSIX-import System.FilePath.Posix-import qualified System.Win32 as Win32-import Control.Exception (bracket)-#endif--setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()---- Converts a module name to and executable file name-moduleNameToExeName :: String -> String---- Converts a name of an a executable to the corresponding file name-toExecutable :: String -> String--#ifdef VERSION_unix--setFileTimes = Posix.setFileTimes--moduleNameToExeName = id--toExecutable = id--#else---- Unlike `utime`, which doesn't work for directories on Windows, this works for both for files and directories--- Mostly copied from @System.Directory@ 1.2.3.0-setFileTimes path atime mtime =- bracket (openFileHandle path' Win32.gENERIC_WRITE)- Win32.closeHandle $ \ handle ->- with (posixToWindowsTime atime) $ \ atime' ->- with (posixToWindowsTime mtime) $ \ mtime' ->- Win32.failIf_ not "setFileTimes" $- Win32.c_SetFileTime handle nullPtr atime' mtime'- where- path' = normalise path -- handle empty paths- windowsPosixEpochDifference :: Num a => a- windowsPosixEpochDifference = 116444736000000000- posixToWindowsTime :: EpochTime -> Win32.FILETIME- posixToWindowsTime t = Win32.FILETIME $- truncate ((realToFrac t :: POSIXTime) * 10000000 + windowsPosixEpochDifference)- openFileHandle :: String -> Win32.AccessMode -> IO Win32.HANDLE- openFileHandle p mode = Win32.createFile p mode share Nothing- Win32.oPEN_EXISTING flags Nothing- where share = Win32.fILE_SHARE_DELETE- .|. Win32.fILE_SHARE_READ- .|. Win32.fILE_SHARE_WRITE- flags = Win32.fILE_ATTRIBUTE_NORMAL- .|. Win32.fILE_FLAG_BACKUP_SEMANTICS -- required for directories---moduleNameToExeName = toExecutable--toExecutable e = e ++ ".exe"-#endif
− IdeSession/Util/PortableIO.hs
@@ -1,129 +0,0 @@-{-# LANGUAGE CPP, RecordWildCards #-}-module IdeSession.Util.PortableIO where--import System.IO (Handle, IOMode(..))--#ifdef VERSION_unix-import System.Posix.Types (Fd)-import qualified System.Posix.IO as Posix-import System.Posix.Files-#else-import Foreign.C.Error (throwErrnoIfMinus1_, throwErrnoIfMinus1)-import Foreign.C.Types (CInt(..), CUInt(..))-import Foreign.Ptr (Ptr)-import Foreign.Marshal.Array (allocaArray)-import Foreign.Storable (peek, peekElemOff)-import GHC.IO.FD (mkFD)-import GHC.IO.Device (IODeviceType(Stream))-import GHC.IO.Handle.FD (mkHandleFromFD)-import System.IO (openFile)--{- For the reimplementation of handleToFd from System.Posix.IO -}-import System.IO.Error-import GHC.IO.Handle.Internals-import GHC.IO.Handle.Types hiding (Handle)-import qualified GHC.IO.FD as FD-import GHC.IO.Exception-import Data.Typeable (cast)-#endif--#ifdef VERSION_unix-type FileDescriptor = Fd-#else-type FileDescriptor = CInt-#endif--createPipe :: IO (FileDescriptor, FileDescriptor)-fdToHandle :: FileDescriptor -> IOMode -> IO Handle-handleToFd :: Handle -> IO FileDescriptor-closeFd :: FileDescriptor -> IO ()--dup :: FileDescriptor -> IO FileDescriptor-dupTo :: FileDescriptor -> FileDescriptor -> IO FileDescriptor---- Opens, and possibly creates, the given file for writing-openWritableFile :: FilePath -> IO FileDescriptor--stdInput, stdOutput, stdError :: FileDescriptor--#ifdef VERSION_unix--createPipe = Posix.createPipe-fdToHandle fd _ = Posix.fdToHandle fd-handleToFd = Posix.handleToFd-closeFd = Posix.closeFd--dup = Posix.dup-dupTo = Posix.dupTo--openWritableFile fp = Posix.openFd fp Posix.WriteOnly (Just mode) Posix.defaultFileFlags- where- mode = unionFileModes ownerReadMode ownerWriteMode--stdInput = Posix.stdInput-stdOutput = Posix.stdOutput-stdError = Posix.stdError--#else--createPipe = allocaArray 2 $ \pfds -> do- throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 ({- _O_BINARY -} 32768)- readfd <- peek pfds- writefd <- peekElemOff pfds 1- return (readfd, writefd)--fdToHandle fd mode = do- (fd', deviceType) <- mkFD fd mode (Just (Stream, 0, 0)) False False- mkHandleFromFD fd' deviceType "" mode False Nothing--closeFd = throwErrnoIfMinus1_ "_close" . c__close--dup = throwErrnoIfMinus1 "_dup" . c__dup--dupTo fd1 fd2 = throwErrnoIfMinus1 "_dup2" $ c__dup2 fd1 fd2---- Previously this was a ccall to '_open' in 'io.h'--- TODO could this implementation work for the Unix version?-openWritableFile fp = openFile fp WriteMode >>= handleToFd--stdInput = 0-stdOutput = 1-stdError = 2--{- Copied from System.Posix.IO -}-handleToFd h@(FileHandle _ m) =- withHandle' "handleToFd" h m $ handleToFd' h-handleToFd h@(DuplexHandle _ r w) = do- _ <- withHandle' "handleToFd" h r $ handleToFd' h- withHandle' "handleToFd" h w $ handleToFd' h- -- for a DuplexHandle, make sure we mark both sides as closed,- -- otherwise a finalizer will come along later and close the other- -- side. (#3914)--handleToFd' :: Handle -> Handle__ -> IO (Handle__, FileDescriptor)-handleToFd' h h_@Handle__{haType=_,..} =- case cast haDevice of- Nothing -> ioError (ioeSetErrorString (mkIOError IllegalOperation- "handleToFd" (Just h) Nothing)- "handle is not a file descriptor")- Just fd -> do- -- converting a Handle into an Fd effectively means- -- letting go of the Handle; it is put into a closed- -- state as a result.- flushWriteBuffer h_- FD.release fd- return (Handle__{haType=ClosedHandle,..}, FD.fdFD fd)--foreign import ccall "io.h _pipe" c__pipe ::- Ptr CInt -> CUInt -> CInt -> IO CInt--foreign import ccall "io.h _close" c__close ::- CInt -> IO CInt--foreign import ccall "io.h _dup" c__dup ::- CInt -> IO CInt--foreign import ccall "io.h _dup2" c__dup2 ::- CInt -> CInt -> IO CInt--#endif
− IdeSession/Util/PortableProcess.hs
@@ -1,81 +0,0 @@-{-# LANGUAGE CPP #-}-module IdeSession.Util.PortableProcess where--import System.Process (ProcessHandle)--#ifdef VERSION_unix-import System.Posix.Signals-import System.Posix.Types-import System.Process.Internals (withProcessHandle, ProcessHandle__(..))-#else-import System.Process-import System.Process.Internals hiding (ProcessHandle)-import System.Win32 hiding (ProcessHandle)-#endif--#ifdef VERSION_unix-type Pid = ProcessID-#else-type Pid = ProcessId-#endif---- Attempts to kill the process, on Unix using sigKILL-sigKillProcess :: Pid -> IO ()---- Attempts to terminate the process, on Unix using sigTERM-sigTermProcess :: Pid -> IO ()---- Raises a sigKILL-raiseSigKill :: IO ()---- The exit code for sigKILL-sigKillExitCode :: Int---- If available sends a sigKill to the given process handle-killProcessHandle :: ProcessHandle -> IO ()---#ifdef VERSION_unix-sigKillProcess = signalProcess sigKILL-sigTermProcess = signalProcess sigTERM-raiseSigKill = raiseSignal sigKILL-sigKillExitCode = -9--killProcessHandle ph = withProcessHandle ph $ \p_ ->- case p_ of- ClosedHandle _ ->- leaveHandleAsIs p_- OpenHandle pID -> do- signalProcess sigKILL pID- leaveHandleAsIs p_- where- leaveHandleAsIs _p =-#if MIN_VERSION_process(1,2,0)- return ()-#else- return (_p, ())-#endif--#else--- On Windows, we just terminate, no special support for sigKILL-sigKillProcess = sigTermProcess-sigTermProcess pid = do- ptr <- openProcess pROCESS_TERMINATE False pid- ph <- mkProcessHandle ptr- terminateProcess ph--sigKillExitCode = 1---- On Windows, no special support for sigKill-killProcessHandle = terminateProcess--foreign import ccall unsafe "winbase.h GetCurrentProcessId"- c_GetCurrentProcessId :: IO DWORD--getCurrentPid :: IO Pid-getCurrentPid = c_GetCurrentProcessId--raiseSigKill = do- pid <- getCurrentPid- sigKillProcess pid-#endif
ide-backend-common.cabal view
@@ -1,5 +1,5 @@ name: ide-backend-common-version: 0.10.1+version: 0.10.1.1 synopsis: Shared library used be ide-backend and ide-backend-server description: Should not be used by end users license: MIT@@ -10,23 +10,19 @@ category: Development build-type: Simple cabal-version: >=1.10-extra-source-files: README.md ChangeLog.md+extra-source-files: README.md library exposed-modules: IdeSession.Util IdeSession.Util.BlockingOps IdeSession.Util.Logger IdeSession.Util.PrettyVal- IdeSession.Util.PortableProcess- IdeSession.Util.PortableIO- IdeSession.Util.PortableFiles IdeSession.GHC.API IdeSession.GHC.Requests IdeSession.GHC.Responses IdeSession.RPC.API IdeSession.RPC.Server IdeSession.RPC.Stream- IdeSession.RPC.Sockets IdeSession.Strict.Container IdeSession.Strict.IntMap IdeSession.Strict.List@@ -51,6 +47,7 @@ mtl >= 2.1 && < 2.3, async >= 2.0 && < 2.1, aeson >= 0.6.2 && < 0.10,+ unix >= 2.5 && < 2.8, temporary >= 1.1.2.4 && < 1.3, bytestring-trie >= 0.2 && < 0.3, text >= 0.11 && < 1.3,@@ -64,12 +61,7 @@ attoparsec >= 0.10 && < 0.14, template-haskell, pretty-show >= 1.3 && < 1.7,- monad-logger,- unix-compat >= 0.4.1.1 && < 0.4.2,- network,- process,- base64-bytestring-+ monad-logger -- GHC.Generics lived in `ghc-prim` for GHC 7.2 & GHC 7.4 if impl(ghc < 7.6)@@ -97,9 +89,3 @@ TypeSynonymInstances ghc-options: -Wall -fno-warn-unused-do-bind-- if os(windows)- build-depends: Win32,- time- else- build-depends: unix >= 2.5 && < 2.8