wai-handler-devel 0.0.2 → 0.1.0

raw patch · 3 files changed

+69/−28 lines, 3 filesdep +sendfiledep +utf8-stringPVP ok

version bump matches the API change (PVP)

Dependencies added: sendfile, utf8-string

API changes (from Hackage documentation)

Files

• Network/Wai/Handler/DevelServer.hs +53/−18
• wai-handler-devel.cabal +10/−8
• wai-handler-devel.hs +6/−2

@@ -6,6 +6,7 @@ import Language.Haskell.Interpreter import Network.Wai +import qualified Data.ByteString.Lazy.UTF8 as U import qualified Data.ByteString.Lazy.Char8 as L8 import Network     ( listenOn, accept, sClose, PortID(PortNumber), Socket@@ -15,21 +16,26 @@ import qualified Control.Exception as E import System.IO (Handle, hClose) import Control.Concurrent (forkIO, threadDelay)-import Control.Monad (forM)  import qualified Control.Concurrent.MVar as M import qualified Control.Concurrent.Chan as C import System.Directory (getModificationTime) import Network.Wai.Handler.SimpleServer (parseRequest, sendResponse)+import Control.Monad (filterM) +import Control.Arrow ((&&&))+import System.Directory (doesDirectoryExist,+                         doesFileExist, getDirectoryContents)+import Control.Applicative ((<$>))+ type FunctionName = String -run :: Port -> ModuleName -> FunctionName -> IO ()-run port modu func = do+run :: Port -> ModuleName -> FunctionName -> [FilePath] -> IO ()+run port modu func dirs = do     queue <- C.newChan     mqueue <- M.newMVar queue     startApp queue $ loadingApp Nothing-    _ <- forkIO $ fillApp modu func mqueue+    _ <- forkIO $ fillApp modu func mqueue dirs     run' port mqueue  startApp :: Queue -> Handler -> IO ()@@ -41,21 +47,28 @@         case msession of             Nothing -> return ()             Just (req, onRes) -> do-                res <- app req-                -- FIXME exceptions?-                onRes res+                void $ forkIO $ (E.handle onErr $ app req) >>= onRes                 go app+    onErr :: SomeException -> IO Response+    onErr e = return+            $ Response status500 [("Content-Type", "text/plain; charset=utf-8")]+            $ ResponseLBS $ U.fromString+            $ "Exception thrown while running application\n\n" ++ show e+    void x = x >> return () -fillApp :: String -> String -> M.MVar Queue -> IO ()-fillApp modu func mqueue =+fillApp :: String -> String -> M.MVar Queue -> [FilePath] -> IO ()+fillApp modu func mqueue dirs =     go Nothing []   where+    constSE :: x -> SomeException -> x+    constSE = const+    getTimes = E.handle (constSE $ return []) . mapM getModificationTime     go prevError prevFiles = do         toReload <-             if null prevFiles                 then return True                 else do-                    times <- mapM (getModificationTime . fst) prevFiles+                    times <- getTimes $ map fst prevFiles                     return $ times /= map snd prevFiles         (newError, newFiles) <-             if toReload@@ -72,19 +85,39 @@                 putStrLn $ "Compile failed: " ++ show err                 loadingApp' (Just $ toException err) mqueue                 return (Just $ toException err, [])-            Right (app, files) -> do+            Right (app, files') -> E.handle onInitErr $ do+                files'' <- mapM fileList dirs+                let files = concat $ files' : files''                 putStrLn "Interpreting success, new app loaded"                 E.handle onInitErr $ do                     swapApp app mqueue-                    files' <- forM files $ \f -> do-                        t <- getModificationTime f-                        return (f, t)-                    return (Nothing, files')+                    times <- getTimes files+                    return (Nothing, zip files times)     onInitErr e = do         putStrLn $ "Error initializing application: " ++ show e         loadingApp' (Just e) mqueue         return (Just e, []) +fileList :: FilePath -> IO [FilePath]+fileList top = do+    ex <- doesDirectoryExist top+    if ex then fileList' top "" else return []++fileList' :: FilePath -> FilePath -> IO [FilePath]+fileList' realTop top = do+    let prefix1 = top ++ "/"+        prefix2 = realTop ++ prefix1+    allContents <- filter notHidden <$> getDirectoryContents prefix2+    let all' = map ((++) prefix1 &&& (++) prefix2) allContents+    files <- map snd <$> filterM (doesFileExist . snd) all'+    dirs <- filterM (doesDirectoryExist . snd) all' >>=+            mapM (fileList' realTop . fst)+    return $ concat $ files : dirs++notHidden :: FilePath -> Bool+notHidden ('.':_) = False+notHidden _ = True+ loadingApp' :: Maybe SomeException -> M.MVar Queue -> IO () loadingApp' err mqueue = swapApp (loadingApp err) mqueue @@ -99,9 +132,11 @@ loadingApp :: Maybe SomeException -> Handler loadingApp err f =     f $ const $ return $ Response status200-        [ ("Content-Type", "text/plain")-        , ("Refresh", "1")-        ] $ ResponseLBS $ L8.pack $ toMessage err+        ( ("Content-Type", "text/plain")+        : case err of+            Nothing -> [("Refresh", "1")]+            Just _ -> []+        ) $ ResponseLBS $ L8.pack $ toMessage err   where     toMessage Nothing = "Loading code changes, please wait"     toMessage (Just err') = "Error loading code: " ++ show err'

@@ -1,5 +1,5 @@ Name:                wai-handler-devel-Version:             0.0.2+Version:             0.1.0 Synopsis:            WAI server that automatically reloads code after modification. Description:         This handler automatically reloads your source code upon any changes. It works by using the hint package, essentially embedding GHC inside the handler. The handler (both the executable and library) takes three arguments: the port to listen on, the module name containing the application function, and the name of the function.                      .@@ -21,13 +21,15 @@     location:        git://github.com/snoyberg/wai-handler-devel.git  Library-  Build-Depends:     base >= 3 && < 5,-                     wai >= 0.2.1 && < 0.3,-                     wai-extra >= 0.2.3 && < 0.3,-                     directory >= 1.0 && < 1.1,-                     network >= 2.2 && < 2.3,-                     bytestring >= 0.9 && < 0.10,-                     hint >= 0.3.2.3 && < 0.4+  Build-Depends:     base >= 3 && < 5+                   , wai >= 0.2.1 && < 0.3+                   , wai-extra >= 0.2.3 && < 0.3+                   , directory >= 1.0 && < 1.1+                   , sendfile >= 0.6 && < 0.8+                   , network >= 2.2 && < 2.3+                   , bytestring >= 0.9 && < 0.10+                   , hint >= 0.3.2.3 && < 0.4+                   , utf8-string >= 0.3 && < 0.4   Exposed-modules:   Network.Wai.Handler.DevelServer   ghc-options:       -Wall 

@@ -7,19 +7,23 @@     { port :: Int     , moduleName :: String     , function :: String+    , yesod :: Bool     }     deriving (Show, Data, Typeable)  main :: IO () main = do-    Devel p m f <- cmdArgs Devel+    Devel p m f y <- cmdArgs Devel         { port = 3000 &= argPos 0 &= typ "PORT"         , moduleName = "" &= argPos 1 &= typ "MODULE"         , function = "" &= argPos 2 &= typ "FUNCTION"+        , yesod = False &= help "Monitor typical Yesod folders (hamlet, etc)"         } &= summary "WAI development web server"-    forkIO $ run p m f+    _ <- forkIO $ run p m f $ folders y     go   where+    folders False = []+    folders True = ["hamlet", "cassius", "julius"]     go = do         x <- getLine         case x of