@@ -1,7 +1,7 @@
11{-# LANGUAGE DeriveDataTypeable #-}
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE OverloadedStrings #-}
4−module Network.Wai.Handler.DevelServer (run) where
4+module Network.Wai.Handler.DevelServer (run, runNoWatch) where
55
66import Language.Haskell.Interpreter
77import Network.Wai
@@ -32,6 +32,14 @@ import Data.List (nub)
3232
3333type FunctionName = String
3434
35+runNoWatch :: Port -> ModuleName -> FunctionName -> [FilePath] -> IO ()
36+runNoWatch port modu func dirs = do
37+ queue <- C.newChan
38+ mqueue <- M.newMVar queue
39+ startApp queue $ loadingApp Nothing
40+ reload modu func mqueue dirs Nothing
41+ run' port mqueue
42+
3543run :: Port -> ModuleName -> FunctionName -> [FilePath] -> IO ()
3644run port modu func dirs = do
3745 queue <- C.newChan
@@ -58,13 +66,14 @@ startApp queue withApp = do
5866 $ "Exception thrown while running application\n\n" ++ show e
5967 void x = x >> return ()
6068
69+getTimes = E.handle (constSE $ return []) . mapM getModificationTime
70+constSE :: x -> SomeException -> x
71+constSE = const
72+
6173fillApp :: String -> String -> M.MVar Queue -> [FilePath] -> IO ()
6274fillApp modu func mqueue dirs =
6375 go Nothing []
6476 where
65− constSE :: x -> SomeException -> x
66− constSE = const
67− getTimes = E.handle (constSE $ return []) . mapM getModificationTime
6877 go prevError prevFiles = do
6978 toReload <-
7079 if null prevFiles
@@ -74,35 +83,38 @@ fillApp modu func mqueue dirs =
7483 return $ times /= map snd prevFiles
7584 (newError, newFiles) <-
7685 if toReload
77− then reload prevError
86+ then reload modu func mqueue dirs prevError
7887 else return (prevError, prevFiles)
7988 threadDelay 1000000
8089 go newError newFiles
81− reload prevError = do
82− case prevError of
83− Nothing -> putStrLn "Attempting to interpret your app..."
84− _ -> return ()
85− loadingApp' prevError mqueue
86− res <- theapp modu func
87− case res of
88− Left err -> do
89− if show (Just err) /= show prevError
90− then putStrLn $ "Compile failed: " ++ showInterpError err
91− else return ()
92− loadingApp' (Just $ toException err) mqueue
93− return (Just $ toException err, [])
94− Right (app, files') -> E.handle onInitErr $ do
95− files'' <- mapM fileList dirs
96− let files = concat $ files' : files''
97− putStrLn "Interpreting success, new app loaded"
98− E.handle onInitErr $ do
99− swapApp app mqueue
100− times <- getTimes files
101− return (Nothing, zip files times)
102− onInitErr e = do
103− putStrLn $ "Error initializing application: " ++ show e
104− loadingApp' (Just e) mqueue
105− return (Just e, [])
90+
91+-- reload :: String -> String -> M.MVar Queue -> [FilePath] -> Maybe SomeException -> IO (Maybe SomeException, [ClockTime])
92+reload modu func mqueue dirs prevError = do
93+ case prevError of
94+ Nothing -> putStrLn "Attempting to interpret your app..."
95+ _ -> return ()
96+ loadingApp' prevError mqueue
97+ res <- theapp modu func
98+ case res of
99+ Left err -> do
100+ if show (Just err) /= show prevError
101+ then putStrLn $ "Compile failed: " ++ showInterpError err
102+ else return ()
103+ loadingApp' (Just $ toException err) mqueue
104+ return (Just $ toException err, [])
105+ Right (app, files') -> E.handle onInitErr $ do
106+ files'' <- mapM fileList dirs
107+ let files = concat $ files' : files''
108+ putStrLn "Interpreting success, new app loaded"
109+ E.handle onInitErr $ do
110+ swapApp app mqueue
111+ times <- getTimes files
112+ return (Nothing, zip files times)
113+ where
114+ onInitErr e = do
115+ putStrLn $ "Error initializing application: " ++ show e
116+ loadingApp' (Just e) mqueue
117+ return (Just e, [])
106118
107119showInterpError :: InterpreterError -> String
108120showInterpError (WontCompile errs) =