git.iko.soy/typeable/wai
on master help sign in
implement reload-on-demand functionality
2931fc6Patrick Palka
Network/Wai/Handler/DevelServer.hs+22−12
compare with master
unifiedsplit
@@ -20,6 +20,9 @@ import Control.Exception (Exception, SomeException, toException, fromException)
20import qualified Control.Exception as E
20import qualified Control.Exception as E
21import Control.Concurrent (forkIO, threadDelay)
21import Control.Concurrent (forkIO, threadDelay)
22
22
23+import Data.Maybe
24+import Control.Concurrent.MVar
25+
23import System.Directory (getModificationTime)
26import System.Directory (getModificationTime)
24import qualified Network.Wai.Handler.Warp as Warp
27import qualified Network.Wai.Handler.Warp as Warp
25import Network.Wai.Application.Devel
28import Network.Wai.Application.Devel
@@ -40,20 +43,26 @@ runNoWatch port modu func extras = do
40runQuit :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath])
43runQuit :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath])
41 -> IO ()
44 -> IO ()
42runQuit port modu func extras = do
45runQuit port modu func extras = do
46+ ev <- newEmptyMVar
43− _ <- forkIO $ run port modu func extras
47+ _ <- forkIO $ run port modu func extras (Just ev)
44− go
48+ go ev
45 where
49 where
46− go = do
50+ go ev = do
47 x <- getLine
51 x <- getLine
48 case x of
52 case x of
53+ 'q':_ -> do
49− 'q':_ -> putStrLn "Quitting, goodbye!"
54+ putStrLn "Quitting, goodbye!"
55+ 'r':_ -> do
56+ putStrLn "Forcing reinterpretation"
57+ _ <- tryPutMVar ev ()
50− _ -> go
58+ go ev
51−
59+ _ -> go ev
60+
52−run :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath])
61+run :: Int -> ModuleName -> FunctionName -> (FilePath -> IO [FilePath]) -> Maybe (MVar ())
53 -> IO ()
62 -> IO ()
54−run port modu func extras = do
63+run port modu func extras mev = do
55 ah <- initAppHolder
64 ah <- initAppHolder
56− _ <- forkIO $ fillApp modu func extras ah
65+ _ <- forkIO $ fillApp modu func extras ah mev
57 Warp.run port $ toApp ah
66 Warp.run port $ toApp ah
58
67
59{-
68{-
@@ -85,13 +94,14 @@ constSE :: x -> SomeException -> x
85constSE = const
94constSE = const
86
95
87fillApp :: String -> String
96fillApp :: String -> String
88− -> (FilePath -> IO [FilePath]) -> AppHolder -> IO ()
97+ -> (FilePath -> IO [FilePath]) -> AppHolder -> Maybe (MVar ()) -> IO ()
89−fillApp modu func dirs ah =
98+fillApp modu func dirs ah mev =
90 go Nothing []
99 go Nothing []
91 where
100 where
92 go prevError prevFiles = do
101 go prevError prevFiles = do
102+ forceReload <- maybe (return False) (fmap isJust . tryTakeMVar) mev
93 toReload <-
103 toReload <-
94− if null prevFiles
104+ if forceReload || null prevFiles
95 then return True
105 then return True
96 else do
106 else do
97 times <- getTimes $ map fst prevFiles
107 times <- getTimes $ map fst prevFiles