git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
[psc-ide] Adds polling option for psc-ide-server
460e8cbChristoph Hegemann
psc-ide-server/Main.hs+11−3
@@ -41,6 +41,7 @@ import Network.Socket hiding (PortNumber, Type,
41import Options.Applicative (ParseError (..))
41import Options.Applicative (ParseError (..))
42import qualified Options.Applicative as Opts
42import qualified Options.Applicative as Opts
43import System.Directory
43import System.Directory
44+import System.Info as SysInfo
44import System.FilePath
45import System.FilePath
45import System.IO hiding (putStrLn, print)
46import System.IO hiding (putStrLn, print)
46import System.IO.Error (isEOFError)
47import System.IO.Error (isEOFError)
@@ -66,12 +67,14 @@ data Options = Options
66 , optionsOutputPath :: FilePath
67 , optionsOutputPath :: FilePath
67 , optionsPort :: PortNumber
68 , optionsPort :: PortNumber
68 , optionsNoWatch :: Bool
69 , optionsNoWatch :: Bool
70+ , optionsPolling :: Bool
69 , optionsDebug :: Bool
71 , optionsDebug :: Bool
70− }
72+ } deriving (Show)
71
73
72main :: IO ()
74main :: IO ()
73main = do
75main = do
74− Options dir globs outputPath port noWatch debug <- Opts.execParser opts
76+ opts'@(Options dir globs outputPath port noWatch polling debug) <- Opts.execParser opts
77+ when debug (putText "Parsed Options:" *> print opts')
75 maybe (pure ()) setCurrentDirectory dir
78 maybe (pure ()) setCurrentDirectory dir
76 ideState <- newTVarIO emptyIdeState
79 ideState <- newTVarIO emptyIdeState
77 cwd <- getCurrentDirectory
80 cwd <- getCurrentDirectory
@@ -84,7 +87,7 @@ main = do
84 putText "psc-ide needs you to compile your project (for example by running pulp build)"
87 putText "psc-ide needs you to compile your project (for example by running pulp build)"
85
88
86 unless noWatch $
89 unless noWatch $
87− void (forkFinally (watcher ideState fullOutputPath) print)
90+ void (forkFinally (watcher polling ideState fullOutputPath) print)
88
91
89 let conf = Configuration {confDebug = debug, confOutputPath = outputPath, confGlobs = globs}
92 let conf = Configuration {confDebug = debug, confOutputPath = outputPath, confGlobs = globs}
90 env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}
93 env = IdeEnvironment {ideStateVar = ideState, ideConfiguration = conf}
@@ -98,12 +101,17 @@ main = do
98 <*> (fromIntegral <$>
101 <*> (fromIntegral <$>
99 Opts.option Opts.auto (Opts.long "port" `mappend` Opts.short 'p' `mappend` Opts.value (4242 :: Integer)))
102 Opts.option Opts.auto (Opts.long "port" `mappend` Opts.short 'p' `mappend` Opts.value (4242 :: Integer)))
100 <*> Opts.switch (Opts.long "no-watch")
103 <*> Opts.switch (Opts.long "no-watch")
104+ <*> flipIfWindows (Opts.switch (Opts.long "polling"))
101 <*> Opts.switch (Opts.long "debug")
105 <*> Opts.switch (Opts.long "debug")
102 opts = Opts.info (version <*> Opts.helper <*> parser) mempty
106 opts = Opts.info (version <*> Opts.helper <*> parser) mempty
103 version = Opts.abortOption
107 version = Opts.abortOption
104 (InfoMsg (showVersion Paths.version))
108 (InfoMsg (showVersion Paths.version))
105 (Opts.long "version" `mappend` Opts.help "Show the version number")
109 (Opts.long "version" `mappend` Opts.help "Show the version number")
106
110
111+ -- polling is the default on Windows and the flag turns it off. See
112+ -- #2209 and #2414 for explanations
113+ flipIfWindows = map (if SysInfo.os == "mingw32" then not else identity)
114+
107startServer :: PortNumber -> IdeEnvironment -> IO ()
115startServer :: PortNumber -> IdeEnvironment -> IO ()
108startServer port env = withSocketsDo $ do
116startServer port env = withSocketsDo $ do
109 sock <- listenOnLocalhost port
117 sock <- listenOnLocalhost port
psc-ide-server/README.md+2
@@ -23,6 +23,8 @@ It supports the following options:
23 project directory. Defaults to `output/`, relative to either the current
23 project directory. Defaults to `output/`, relative to either the current
24 directory or the directory specified by `-d`.
24 directory or the directory specified by `-d`.
25- `--debug`: Enables some logging meant for debugging
25- `--debug`: Enables some logging meant for debugging
26+- `--polling`: Uses polling instead of file system events to watch the externs
27+ files. This flag is reversed on Windows and polling is the default.
26- `--no-watch`: Disables the filewatcher
28- `--no-watch`: Disables the filewatcher
27- `--version`: Output psc-ide version
29- `--version`: Output psc-ide version
28
30
src/Language/PureScript/Ide/Watcher.hs+10−7
@@ -40,10 +40,13 @@ reloadFile ref ev = do
40
40
41-- | Installs filewatchers for the given directory and reloads ExternsFiles when
41-- | Installs filewatchers for the given directory and reloads ExternsFiles when
42-- they change on disc
42-- they change on disc
43−watcher :: TVar IdeState -> FilePath -> IO ()
43+watcher :: Bool -> TVar IdeState -> FilePath -> IO ()
44−watcher stateVar fp =
44+watcher polling stateVar fp =
45+ withManagerConf
45− withManagerConf (defaultConfig { confDebounce = NoDebounce }) $ \mgr -> do
46+ (defaultConfig { confDebounce = NoDebounce
47+ , confUsePolling = polling
48+ }) $ \mgr -> do
46− _ <- watchTree mgr fp
49+ _ <- watchTree mgr fp
47− (\ev -> takeFileName (eventPath ev) == "externs.json")
50+ (\ev -> takeFileName (eventPath ev) == "externs.json")
48− (reloadFile stateVar)
51+ (reloadFile stateVar)
49− forever (threadDelay 100000)
52+ forever (threadDelay 100000)