packages feed

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
@@ -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