@@ -94,6 +94,10 @@ import Data.Word (Word)
9494import Data.Either (partitionEithers)
9595import Control.DeepSeq
9696
97+import Control.Concurrent.Async (race)
98+import System.FSNotify (withManager, watchDir)
99+import System.FSNotify.Devel (allEvents, doAllEvents)
100+
97101import Numeric ( readHex )
98102
99103import Debug.Trace
@@ -126,10 +130,8 @@ repl orig mods efile
126130 do ms <- H.catch (lift $ processInput input orig mods efile)
127131 (ctrlC (return (Just mods)))
128132 case ms of
129− Just mods -> let efile' = case mods of
130− [] -> efile
131− (e:_) -> e in
132− repl orig mods efile'
133+ Just mods -> let efile' = fromMaybe efile (listToMaybe mods)
134+ in repl orig mods efile'
133135 Nothing -> return ()
134136-- ctrlC)
135137-- ctrlC
@@ -154,15 +156,13 @@ repl orig mods efile
154156
155157-- | Run the REPL server
156158startServer :: PortID -> IState -> [FilePath] -> Idris ()
157−startServer port orig fn_in = do tid <- runIO $ forkOS (serverLoop port)
159+startServer port orig fn_in = do tid <- runIO $ forkIO (serverLoop port)
158160 return ()
159161 where serverLoop port = withSocketsDo $
160162 do sock <- listenOnLocalhost port
161163 loop fn orig { idris_colourRepl = False } sock
162164
163− fn = case fn_in of
164− (f:_) -> f
165− _ -> ""
165+ fn = fromMaybe "" (listToMaybe fn_in)
166166
167167 loop fn ist sock
168168 = do (h,_,_) <- accept sock
@@ -276,9 +276,7 @@ idemode h orig mods
276276 i <- getIState
277277 putIState $ i { idris_outputmode = (IdeMode id h) }
278278 idrisCatch -- to report correct id back!
279− (do let fn = case mods of
280− (f:_) -> f
281− _ -> ""
279+ (do let fn = fromMaybe "" (listToMaybe mods)
282280 case IdeMode.sexpToCommand sexp of
283281 Just cmd -> runIdeModeCommand h id orig fn mods cmd
284282 Nothing -> iPrintError "did not understand" )
@@ -677,30 +675,54 @@ lit f = case splitExtension f of
677675 (_, ".lidr") -> True
678676 _ -> False
679677
678+reload :: IState -> [FilePath] -> Idris (Maybe [FilePath])
679+reload orig inputs = do
680+ i <- getIState
681+ -- The $!! here prevents a space leak on reloading.
682+ -- This isn't a solution - but it's a temporary stopgap.
683+ -- See issue #2386
684+ putIState $!! orig { idris_options = idris_options i
685+ , idris_colourTheme = idris_colourTheme i
686+ , imported = imported i
687+ }
688+ clearErr
689+ fmap Just $ loadInputs inputs Nothing
690+
691+watch :: IState -> [FilePath] -> Idris (Maybe [FilePath])
692+watch orig inputs = do
693+ let inputSet = S.fromList inputs
694+ let dirs = nub $ map takeDirectory inputs
695+ resp <- runIO $ do
696+ signal <- newEmptyMVar
697+ withManager $ \mgr -> do
698+ forM_ dirs $ \dir ->
699+ watchDir mgr dir (allEvents $ flip S.member inputSet) (doAllEvents $ putMVar signal)
700+ race getLine (takeMVar signal)
701+ case resp of
702+ Left _ -> return (Just inputs) -- canceled, so nop
703+ Right _ -> reload orig inputs >> watch orig inputs
704+
680705processInput :: String ->
681706 IState -> [FilePath] -> FilePath -> Idris (Maybe [FilePath])
682707processInput cmd orig inputs efile
683708 = do i <- getIState
684709 let opts = idris_options i
685710 let quiet = opt_quiet opts
686− let fn = case inputs of
687− (f:_) -> f
688− _ -> ""
711+ let fn = fromMaybe "" (listToMaybe inputs)
689712 c <- colourise
690713 case parseCmd i "(input)" cmd of
691714 Failure err -> do iputStrLn $ show (fixColour c err)
692715 return (Just inputs)
693716 Success (Right Reload) ->
694− -- The $!! here prevents a space leak on reloading.
695− -- This isn't a solution - but it's a temporary stopgap.
696− -- See issue #2386
697− do putIState $!! orig { idris_options = idris_options i
698− , idris_colourTheme = idris_colourTheme i
699− , imported = imported i
700− }
701− clearErr
702− mods <- loadInputs inputs Nothing
703− return (Just mods)
717+ reload orig inputs
718+ Success (Right Watch) ->
719+ if null inputs then
720+ do iputStrLn "No loaded files to watch."
721+ return (Just inputs)
722+ else
723+ do iputStrLn efile
724+ iputStrLn $ "Watching for .idr changes in " ++ show inputs ++ ", press enter to cancel."
725+ watch orig inputs
704726 Success (Right (Load f toline)) ->
705727 -- The $!! here prevents a space leak on reloading.
706728 -- This isn't a solution - but it's a temporary stopgap.