diff --git a/buck-multiplex-worker/BUCK b/buck-multiplex-worker/BUCK index 0d9534ef..823fb11e 100644 --- a/buck-multiplex-worker/BUCK +++ b/buck-multiplex-worker/BUCK @@ -1 +1 @@ -export_file("Main.hs", visibility = ["PUBLIC"]) +[export_file(f + ".hs", visibility = ["PUBLIC"]) for f in ["Main", "Message", "Pool", "Server", "Util", "Worker"]] diff --git a/comm/src/Message.hs b/buck-multiplex-worker/Message.hs similarity index 100% rename from comm/src/Message.hs rename to buck-multiplex-worker/Message.hs diff --git a/server/lib/Pool.hs b/buck-multiplex-worker/Pool.hs similarity index 100% rename from server/lib/Pool.hs rename to buck-multiplex-worker/Pool.hs diff --git a/server/lib/Server.hs b/buck-multiplex-worker/Server.hs similarity index 100% rename from server/lib/Server.hs rename to buck-multiplex-worker/Server.hs diff --git a/comm/src/Util.hs b/buck-multiplex-worker/Util.hs similarity index 100% rename from comm/src/Util.hs rename to buck-multiplex-worker/Util.hs diff --git a/server/lib/Worker.hs b/buck-multiplex-worker/Worker.hs similarity index 100% rename from server/lib/Worker.hs rename to buck-multiplex-worker/Worker.hs diff --git a/buck-multiplex-worker/buck-multiplex-worker.cabal b/buck-multiplex-worker/buck-multiplex-worker.cabal index 91ba09f2..7df5a8c9 100644 --- a/buck-multiplex-worker/buck-multiplex-worker.cabal +++ b/buck-multiplex-worker/buck-multiplex-worker.cabal @@ -8,18 +8,33 @@ build-type: Simple executable multiplex-worker main-is: Main.hs + other-modules: + Message + Pool + Server + Util + Worker hs-source-dirs: . ghc-options: -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages -threaded -rtsopts -with-rtsopts=-N build-depends: base ==4.*, + binary, + bytestring, containers, + deepseq, + directory, + extra, + filepath, ghc, - ghc-persistent-worker-comm, ghc-persistent-worker-plugin, - ghc-persistent-worker-server, + network, + optparse-applicative, + process, stm, text, + time, transformers, + unix, vector, buck-worker default-language: GHC2021 diff --git a/cabal.project b/cabal.project index 0f6a61a2..404d2cef 100644 --- a/cabal.project +++ b/cabal.project @@ -1,7 +1,4 @@ packages: ./plugin - ./comm - ./server - ./client ./instrument ./buck-worker ./buck-multiplex-worker diff --git a/client/CHANGELOG.md b/client/CHANGELOG.md deleted file mode 100644 index e69de29b..00000000 diff --git a/client/LICENSE b/client/LICENSE deleted file mode 100644 index e69de29b..00000000 diff --git a/client/app/Client.hs b/client/app/Client.hs deleted file mode 100644 index d84155e6..00000000 --- a/client/app/Client.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main (main) where - -import qualified Control.Exception as E -import qualified Data.ByteString.Char8 as C -import qualified Data.ByteString.Lazy as L -import Data.Binary (encode) -import Data.Foldable (foldMap) -import Data.Int (Int32) -import Data.List (isPrefixOf, lookup, partition, stripPrefix) -import Data.Monoid (First (..)) -import Message - ( TargetId (..), - Msg (..), - Request (..), - Response (..), - recvMsg, - sendMsg, - unwrapMsg, - wrapMsg - ) -import Network.Socket - ( Family (AF_UNIX), - SockAddr (SockAddrUnix), - Socket, - SocketType (Stream), - close, - connect, - socket, - withSocketsDo, - ) -import Network.Socket.ByteString (recv, sendAll) -import System.Environment (getArgs, getEnv, getEnvironment) -import System.Exit (exitFailure) -import System.IO (hFlush, hPutStrLn, stderr, stdout) - -data WorkerConfig = WorkerConfig - { workerConfigSocket :: String, - workerConfigTargetId :: Maybe TargetId, - workerConfigClose :: Bool - } - deriving (Show) - -splitArgs :: [String] -> ([String], [String]) -splitArgs = partition ("--worker-" `isPrefixOf`) - -getWorkerConfig :: [String] -> Maybe WorkerConfig -getWorkerConfig args = do - socket <- getFirst $ foldMap (First . stripPrefix "--worker-socket=") args - let mid = getFirst $ foldMap (First . stripPrefix "--worker-target-id=") args - willClose = any ("--worker-close" `isPrefixOf`) args - pure WorkerConfig - { workerConfigSocket = socket, - workerConfigTargetId = TargetId <$> mid, - workerConfigClose = willClose - } - -main :: IO () -main = do - args <- getArgs - let (workerArgs, ghcArgs) = splitArgs args - mConf = getWorkerConfig workerArgs - hPutStrLn stderr (show mConf) - hPutStrLn stderr (show args) - hFlush stderr - case mConf of - Nothing -> do - hPutStrLn stderr "ghc-persistent-worker-client: Please pass --worker-socket=(socket file path)." - exitFailure - Just conf -> do - let sockPath = workerConfigSocket conf - mid = workerConfigTargetId conf - willClose = workerConfigClose conf - env <- getEnvironment - process sockPath mid willClose env ghcArgs - -process :: FilePath -> Maybe TargetId -> Bool -> [(String, String)] -> [String] -> IO () -process socketPath mid willClose env args = runClient socketPath $ \s -> do - let req = Request - { requestWorkerTargetId = mid, - requestWorkerClose = willClose, - requestEnv = env, - requestArgs = args - } - let msg = wrapMsg req - sendMsg s msg - -- - msg' <- recvMsg s - let Response res ss_out ss_err = unwrapMsg msg' - mapM_ (hPutStrLn stdout) ss_out - hFlush stdout - mapM_ (hPutStrLn stderr) ss_err - hFlush stderr - -runClient :: FilePath -> (Socket -> IO a) -> IO a -runClient fp client = withSocketsDo $ E.bracket (open fp) close client - where - open fp = E.bracketOnError (socket AF_UNIX Stream 0) close $ \sock -> do - connect sock (SockAddrUnix fp) - return sock diff --git a/client/ghc-persistent-worker-client.cabal b/client/ghc-persistent-worker-client.cabal deleted file mode 100644 index d77fa20c..00000000 --- a/client/ghc-persistent-worker-client.cabal +++ /dev/null @@ -1,27 +0,0 @@ -cabal-version: 3.4 -name: ghc-persistent-worker-client -version: 0.1.0.0 --- synopsis: --- description: -license: MIT -license-file: LICENSE -author: Ian-Woo Kim -maintainer: ianwookim@gmail.com --- copyright: -category: Development -build-type: Simple -extra-doc-files: CHANGELOG.md --- extra-source-files: - -common warnings - ghc-options: -Wall - -executable Client - main-is: Client.hs - hs-source-dirs: app - build-depends: base, - binary, - bytestring, - ghc-persistent-worker-comm, - network - default-language: GHC2021 diff --git a/comm/CHANGELOG.md b/comm/CHANGELOG.md deleted file mode 100644 index e69de29b..00000000 diff --git a/comm/LICENSE b/comm/LICENSE deleted file mode 100644 index e69de29b..00000000 diff --git a/comm/ghc-persistent-worker-comm.cabal b/comm/ghc-persistent-worker-comm.cabal deleted file mode 100644 index bbaca00a..00000000 --- a/comm/ghc-persistent-worker-comm.cabal +++ /dev/null @@ -1,35 +0,0 @@ -cabal-version: 3.4 -name: ghc-persistent-worker-comm -version: 0.1.0.0 --- synopsis: --- description: -license: MIT -license-file: LICENSE -author: Ian-Woo Kim -maintainer: ianwookim@gmail.com --- copyright: -category: Development -build-type: Simple -extra-doc-files: CHANGELOG.md --- extra-source-files: - -common warnings - ghc-options: -Wall - -library - import: warnings - exposed-modules: Message - Util - - build-depends: base >=4.19, - binary, - bytestring, - containers, - deepseq, - filepath, - network, - time, - transformers, - unix - hs-source-dirs: src - default-language: GHC2021 diff --git a/comm/src/BUCK b/comm/src/BUCK deleted file mode 100644 index 2473bae0..00000000 --- a/comm/src/BUCK +++ /dev/null @@ -1 +0,0 @@ -[export_file(f, visibility = ["PUBLIC"]) for f in ["Message.hs"]] diff --git a/plugin/src/Internal/Cache.hs b/plugin/src/Internal/Cache.hs index bc674007..07a772bb 100644 --- a/plugin/src/Internal/Cache.hs +++ b/plugin/src/Internal/Cache.hs @@ -39,7 +39,7 @@ import GHC.Utils.Outputable (SDoc, comma, doublePrec, fsep, hang, nest, punctuat import Internal.Log (Log, logd) import System.Environment (lookupEnv) -#if __GLASGOW_HASKELL__ >= 911 +#if __GLASGOW_HASKELL__ >= 911 || defined(MWB) import Data.IORef (IORef, newIORef) import qualified Data.Map.Lazy as LazyMap @@ -61,6 +61,8 @@ import GHC.Unit.Module.Graph (ModuleGraphNode (..), mgModSummaries', mkModuleGra #endif +import GHC.Unit.Module.Graph (ModuleGraph, unionMG) + data ModuleArtifacts = ModuleArtifacts { iface :: ModIface, @@ -183,7 +185,7 @@ data BinPath = } deriving stock (Eq, Show) -#if __GLASGOW_HASKELL__ >= 911 +#if __GLASGOW_HASKELL__ >= 911 || defined(MWB) data FinderState = FinderState { @@ -539,7 +541,7 @@ report logVar workerId target cache = do workerDesc wid = text (" (" ++ wid ++ ")") -#if __GLASGOW_HASKELL__ >= 911 +#if __GLASGOW_HASKELL__ >= 911 || defined(MWB) -- | This replacement of the Finder implementation has the sole purpose of recording some cache stats, for now. -- While its mutable state is allocated separately and shared across sessions, this doesn't really make a difference at @@ -598,7 +600,7 @@ newFinderCache _ Cache {finder = FinderState {cache}} _ = pure cache withHscState :: HscEnv -> (MVar OrigNameCache -> MVar (Maybe LoaderState) -> MVar SymbolMap -> IO a) -> IO (Maybe a) withHscState HscEnv {hsc_interp, hsc_NC = NameCache {nsNames}} use = -#if __GLASGOW_HASKELL__ >= 911 +#if __GLASGOW_HASKELL__ >= 911 || defined(MWB) for hsc_interp \ Interp {interpLoader = Loader {loader_state}, interpLookupSymbolCache} -> liftIO $ use nsNames loader_state interpLookupSymbolCache #else @@ -683,7 +685,6 @@ storeIface _ _ = storeHug :: HscEnv -> Cache -> IO Cache storeHug hsc_env cache = do - -- dbgp (hang (text "Storing HUG:") 2 (showHugShort merged)) pure cache {hug = Just merged} where merged = maybe id (unitEnv_union mergeHugs) cache.hug hsc_env.hsc_unit_env.ue_home_unit_graph diff --git a/plugin/src/Internal/MakeFile.hs b/plugin/src/Internal/MakeFile.hs index 70e93d4b..077dff6f 100644 --- a/plugin/src/Internal/MakeFile.hs +++ b/plugin/src/Internal/MakeFile.hs @@ -67,7 +67,7 @@ import GHC.Unit (homeUnitId) import GHC.Utils.Panic.Plain #endif -#if !defined(BUCK) +#if !defined(MWB) depJSON :: DynFlags -> Maybe FilePath depJSON _ = Nothing diff --git a/plugin/src/Internal/MakeFile/JSON.hs b/plugin/src/Internal/MakeFile/JSON.hs index 278183e1..15370304 100644 --- a/plugin/src/Internal/MakeFile/JSON.hs +++ b/plugin/src/Internal/MakeFile/JSON.hs @@ -36,7 +36,7 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import System.FilePath (normalise) -#if !defined(BUCK) +#if !defined(MWB) import GHC.Data.FastString (lexicalCompareFS) instance Ord PackageId where diff --git a/server/CHANGELOG.md b/server/CHANGELOG.md deleted file mode 100644 index e69de29b..00000000 diff --git a/server/LICENSE b/server/LICENSE deleted file mode 100644 index e69de29b..00000000 diff --git a/server/app/Main.hs b/server/app/Main.hs deleted file mode 100644 index ee22f916..00000000 --- a/server/app/Main.hs +++ /dev/null @@ -1,54 +0,0 @@ -module Main where - -import Control.Concurrent.STM (newTVarIO) -import Control.Monad (replicateM_) -import qualified Data.IntMap as IM -import Options.Applicative (Parser, (<**>)) -import qualified Options.Applicative as OA -import Pool (Pool (..)) -import Server (runServer, serve, spawnWorker) - --- cli args -data Option = Option - { optionNumWorkers :: Int, - optionGHC :: FilePath, - optionSocket :: FilePath, - optionPkgDbs :: [FilePath] - } - -p_option :: Parser Option -p_option = - Option - <$> OA.option OA.auto - ( OA.long "num" - <> OA.short 'n' - <> OA.help "number of workers" - ) - <*> OA.strOption - ( OA.long "ghc" - <> OA.help "GHC path" - ) - <*> OA.strOption - ( OA.long "socket-file" - <> OA.help "UNIX socket file accepting compilation requests" - ) - <*> OA.many (OA.strOption (OA.long "package-db" <> OA.help "Package DB Path")) - -main :: IO () -main = do - opts <- OA.execParser (OA.info (p_option <**> OA.helper) OA.fullDesc) - let n = optionNumWorkers opts - ghcPath = optionGHC opts - socketPath = optionSocket opts - dbPaths = optionPkgDbs opts - let thePool = Pool - { poolLimit = n, - poolNewWorkerId = 1, - poolNewJobId = 1, - poolStatus = IM.empty, - poolHandles = [] - } - - poolRef <- newTVarIO thePool - replicateM_ n $ spawnWorker False ghcPath dbPaths poolRef - runServer socketPath (serve ghcPath dbPaths poolRef) diff --git a/server/ghc-persistent-worker-server.cabal b/server/ghc-persistent-worker-server.cabal deleted file mode 100644 index 1c2d5607..00000000 --- a/server/ghc-persistent-worker-server.cabal +++ /dev/null @@ -1,56 +0,0 @@ -cabal-version: 3.4 -name: ghc-persistent-worker-server -version: 0.1.0.0 --- synopsis: --- description: -license: MIT -license-file: LICENSE -author: Ian-Woo Kim -maintainer: ianwookim@gmail.com --- copyright: -category: Development -build-type: Simple -extra-doc-files: CHANGELOG.md - -library - ghc-options: -Wall -Werror - hs-source-dirs: lib - exposed-modules: Pool - Server - Worker - build-depends: base >=4.19, - binary, - bytestring, - containers, - directory, - extra, - filepath, - ghc-persistent-worker-comm, - network, - optparse-applicative, - process, - stm, - transformers, - unix - default-language: GHC2021 - -executable Server - main-is: Main.hs - ghc-options: -Wall -Werror - hs-source-dirs: app - build-depends: base >=4.19, - binary, - bytestring, - containers, - directory, - extra, - filepath, - ghc-persistent-worker-comm, - ghc-persistent-worker-server, - network, - optparse-applicative, - process, - stm, - transformers, - unix - default-language: GHC2021 diff --git a/server/lib/BUCK b/server/lib/BUCK deleted file mode 100644 index 021491be..00000000 --- a/server/lib/BUCK +++ /dev/null @@ -1 +0,0 @@ -[export_file(f + ".hs", visibility = ["PUBLIC"]) for f in ["Server", "Pool", "Worker"]]