diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2023-01-12 10:11:58 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-02-17 15:59:16 -0500 |
commit | a203ad854ffee802e6bf0aca26e6c9a99bec3865 (patch) | |
tree | 0340d9fa199490961e97ea24c6574077f37f0d7b /utils/iserv | |
parent | be0b7209c6aef22798fc4ba7baacd2099b5cb494 (diff) | |
download | haskell-a203ad854ffee802e6bf0aca26e6c9a99bec3865.tar.gz |
Merge libiserv with ghci
`libiserv` serves no purpose. As it depends on `ghci` and doesn't have
more dependencies than the `ghci` package, its code could live in the
`ghci` package too.
This commit also moves most of the code from the `iserv` program into
the `ghci` package as well so that it can be reused. This is especially
useful for the implementation of TH for the JS backend (#22261, !9779).
Diffstat (limited to 'utils/iserv')
-rw-r--r-- | utils/iserv/iserv.cabal.in | 6 | ||||
-rw-r--r-- | utils/iserv/src/Main.hs | 87 |
2 files changed, 3 insertions, 90 deletions
diff --git a/utils/iserv/iserv.cabal.in b/utils/iserv/iserv.cabal.in index 46a0357a63..2460963d8c 100644 --- a/utils/iserv/iserv.cabal.in +++ b/utils/iserv/iserv.cabal.in @@ -18,9 +18,6 @@ Description: compiling Template Haskell, by spawning a separate delegate (so called runner on the javascript vm) and evaluating the splices there. - . - To use iserv with cross compilers, please see @libraries/libiserv@ - and @utils/iserv-proxy@. Category: Development build-type: Simple @@ -39,8 +36,7 @@ Executable iserv bytestring >= 0.10 && < 0.12, containers >= 0.5 && < 0.7, deepseq >= 1.4 && < 1.5, - ghci == @ProjectVersionMunged@, - libiserv == @ProjectVersionMunged@ + ghci == @ProjectVersionMunged@ if os(windows) Cpp-Options: -DWINDOWS diff --git a/utils/iserv/src/Main.hs b/utils/iserv/src/Main.hs index 4c622f85a9..c455ea1f01 100644 --- a/utils/iserv/src/Main.hs +++ b/utils/iserv/src/Main.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP, GADTs #-} - -- | -- The Remote GHCi server. -- @@ -8,88 +6,7 @@ -- module Main (main) where -import IServ (serv) - -import GHCi.Message -import GHCi.Signals -import GHCi.Utils - -import Control.Exception -import Control.Concurrent (threadDelay) -import Control.Monad -import Data.IORef -import System.Environment -import System.Exit -import Text.Printf -#if defined(WINDOWS) -import Foreign.Ptr (wordPtrToPtr) -# if defined(__IO_MANAGER_WINIO__) -import GHC.IO.SubSystem ((<!>)) -import GHC.Event.Windows (associateHandle') -# endif -#endif - -dieWithUsage :: IO a -dieWithUsage = do - prog <- getProgName - die $ prog ++ ": " ++ msg - where -#if defined(WINDOWS) - msg = "usage: iserv <write-handle> <read-handle> [-v]" -#else - msg = "usage: iserv <write-fd> <read-fd> [-v]" -#endif +import GHCi.Server (defaultServer) main :: IO () -main = do - args <- getArgs - (outh, inh, rest) <- - case args of - arg0:arg1:rest -> do -#if defined(WINDOWS) - let wfd1 = wordPtrToPtr (read arg0) - rfd2 = wordPtrToPtr (read arg1) -# if defined(__IO_MANAGER_WINIO__) - -- register the handles we received with - -- our I/O manager otherwise we can't use - -- them correctly. - return () <!> (do - associateHandle' wfd1 - associateHandle' rfd2) -# endif -#else - let wfd1 = read arg0 - rfd2 = read arg1 -#endif - inh <- getGhcHandle rfd2 - outh <- getGhcHandle wfd1 - return (outh, inh, rest) - _ -> dieWithUsage - - (verbose, rest') <- case rest of - "-v":rest' -> return (True, rest') - _ -> return (False, rest) - - (wait, rest'') <- case rest' of - "-wait":rest'' -> return (True, rest'') - _ -> return (False, rest') - - unless (null rest'') $ - dieWithUsage - - when verbose $ - printf "GHC iserv starting (in: %s; out: %s)\n" (show inh) (show outh) - installSignalHandlers - lo_ref <- newIORef Nothing - let pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref} - - when wait $ do - when verbose $ - putStrLn "Waiting 3s" - threadDelay 3000000 - - uninterruptibleMask $ serv verbose hook pipe - - where hook = return -- empty hook - -- we cannot allow any async exceptions while communicating, because - -- we will lose sync in the protocol, hence uninterruptibleMask. +main = defaultServer |