@@ -2,7 +2,6 @@
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE OverloadedStrings #-}
44{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE StandaloneDeriving #-}
65module Network.Wai.Handler.DevelServer
76 ( run
87 , runQuit
@@ -20,6 +19,10 @@ import Control.Exception (Exception, SomeException, toException, fromException)
2019import qualified Control.Exception as E
2120import Control.Concurrent (forkIO, threadDelay)
2221
22+import Data.Maybe
23+import Control.Monad
24+import Control.Concurrent.MVar
25+
2326import System.Directory (getModificationTime)
2427import qualified Network.Wai.Handler.Warp as Warp
2528import Network.Wai.Application.Devel
@@ -40,20 +43,25 @@ runNoWatch port modu func extras = do
4043runQuit :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath])
4144 -> IO ()
4245runQuit port modu func extras = do
43− _ <- forkIO $ run port modu func extras
44− go
46+ sig <- newEmptyMVar
47+ _ <- forkIO $ run port modu func extras (Just sig)
48+ go sig
4549 where
46− go = do
50+ go sig = do
4751 x <- getLine
4852 case x of
4953 'q':_ -> putStrLn "Quitting, goodbye!"
50− _ -> go
54+ 'r':_ -> do
55+ putStrLn "Forcing reinterpretation"
56+ _ <- tryPutMVar sig ()
57+ go sig
58+ _ -> go sig
5159
52−run :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath])
60+run :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath]) -> Maybe (MVar ())
5361 -> IO ()
54−run port modu func extras = do
62+run port modu func extras msig = do
5563 ah <- initAppHolder
56− _ <- forkIO $ fillApp modu func extras ah
64+ _ <- forkIO $ fillApp modu func extras ah msig
5765 Warp.run port $ toApp ah
5866
5967{-
@@ -85,13 +93,14 @@ constSE :: x -> SomeException -> x
8593constSE = const
8694
8795fillApp :: String -> String
88− -> (FilePath -> IO [FilePath]) -> AppHolder -> IO ()
89−fillApp modu func dirs ah =
96+ -> (FilePath -> IO [FilePath]) -> AppHolder -> Maybe (MVar ()) -> IO ()
97+fillApp modu func dirs ah msig =
9098 go Nothing []
9199 where
92100 go prevError prevFiles = do
101+ forceReload <- maybe (return False) (fmap isJust . tryTakeMVar) msig
93102 toReload <-
94− if null prevFiles
103+ if forceReload || null prevFiles
95104 then return True
96105 else do
97106 times <- getTimes $ map fst prevFiles
@@ -116,9 +125,8 @@ reload modu func extras prevError ah = do
116125 res <- theapp modu func
117126 case res of
118127 Left err -> do
119− if show (Just err) /= show prevError
120− then putStrLn $ "Compile failed: " ++ showInterpError err
121− else return ()
128+ when (show (Just err) /= show prevError) $
129+ putStrLn $ "Compile failed: " ++ showInterpError err
122130 loadingApp' (Just $ toException err) ah
123131 return (Just $ toException err, [])
124132 Right (app, files') -> E.handle onInitErr $ do