@@ -21,15 +21,21 @@ import qualified Control.Concurrent.MVar as M
2121import qualified Control.Concurrent.Chan as C
2222import System.Directory (getModificationTime)
2323import Network.Wai.Handler.SimpleServer (parseRequest, sendResponse)
24+import Control.Monad (filterM)
25+
26+import Control.Arrow ((&&&))
27+import System.Directory (doesDirectoryExist,
28+ doesFileExist, getDirectoryContents)
29+import Control.Applicative ((<$>))
2430
2531type FunctionName = String
2632
27−run :: Port -> ModuleName -> FunctionName -> IO ()
28−run port modu func = do
33+run :: Port -> ModuleName -> FunctionName -> [FilePath] -> IO ()
34+run port modu func dirs = do
2935 queue <- C.newChan
3036 mqueue <- M.newMVar queue
3137 startApp queue $ loadingApp Nothing
32− _ <- forkIO $ fillApp modu func mqueue
38+ _ <- forkIO $ fillApp modu func mqueue dirs
3339 run' port mqueue
3440
3541startApp :: Queue -> Handler -> IO ()
@@ -41,7 +47,7 @@ startApp queue withApp = do
4147 case msession of
4248 Nothing -> return ()
4349 Just (req, onRes) -> do
44− void $ forkIO $ (handle onErr $ app req) >>= onRes
50+ void $ forkIO $ (E.handle onErr $ app req) >>= onRes
4551 go app
4652 onErr :: SomeException -> IO Response
4753 onErr e = return
@@ -50,13 +56,13 @@ startApp queue withApp = do
5056 $ "Exception thrown while running application\n\n" ++ show e
5157 void x = x >> return ()
5258
53−fillApp :: String -> String -> M.MVar Queue -> IO ()
54−fillApp modu func mqueue =
59+fillApp :: String -> String -> M.MVar Queue -> [FilePath] -> IO ()
60+fillApp modu func mqueue dirs =
5561 go Nothing []
5662 where
5763 constSE :: x -> SomeException -> x
5864 constSE = const
59− getTimes = handle (constSE $ return []) . mapM getModificationTime
65+ getTimes = E.handle (constSE $ return []) . mapM getModificationTime
6066 go prevError prevFiles = do
6167 toReload <-
6268 if null prevFiles
@@ -79,7 +85,9 @@ fillApp modu func mqueue =
7985 putStrLn $ "Compile failed: " ++ show err
8086 loadingApp' (Just $ toException err) mqueue
8187 return (Just $ toException err, [])
82− Right (app, files) -> do
88+ Right (app, files') -> E.handle onInitErr $ do
89+ files'' <- mapM fileList dirs
90+ let files = concat $ files' : files''
8391 putStrLn "Interpreting success, new app loaded"
8492 E.handle onInitErr $ do
8593 swapApp app mqueue
@@ -90,6 +98,26 @@ fillApp modu func mqueue =
9098 loadingApp' (Just e) mqueue
9199 return (Just e, [])
92100
101+fileList :: FilePath -> IO [FilePath]
102+fileList top = do
103+ ex <- doesDirectoryExist top
104+ if ex then fileList' top "" else return []
105+
106+fileList' :: FilePath -> FilePath -> IO [FilePath]
107+fileList' realTop top = do
108+ let prefix1 = top ++ "/"
109+ prefix2 = realTop ++ prefix1
110+ allContents <- filter notHidden <$> getDirectoryContents prefix2
111+ let all' = map ((++) prefix1 &&& (++) prefix2) allContents
112+ files <- map snd <$> filterM (doesFileExist . snd) all'
113+ dirs <- filterM (doesDirectoryExist . snd) all' >>=
114+ mapM (fileList' realTop . fst)
115+ return $ concat $ files : dirs
116+
117+notHidden :: FilePath -> Bool
118+notHidden ('.':_) = False
119+notHidden _ = True
120+
93121loadingApp' :: Maybe SomeException -> M.MVar Queue -> IO ()
94122loadingApp' err mqueue = swapApp (loadingApp err) mqueue
95123