@@ -1,7 +1,6 @@
2module Main where
1module Main where
4−import Control.Monad (msum,guard)
3+import Control.Monad (msum,guard,when)
5import Control.Monad.Trans (MonadIO(liftIO))
4import Control.Monad.Trans (MonadIO(liftIO))
6import Data.List (isPrefixOf, isSuffixOf, (\\))
5import Data.List (isPrefixOf, isSuffixOf, (\\))
7import Data.Version (showVersion)
6import Data.Version (showVersion)
@@ -34,24 +33,37 @@ serve portNumber libLoc = do
34pageTitle :: String -> String
33pageTitle :: String -> String
35pageTitle = dropExtension . takeBaseName
34pageTitle = dropExtension . takeBaseName
36+defaultCacheDirectory = "elm-server-cache"
37serveElm :: FilePath -> ServerPartT IO Response
38serveElm :: FilePath -> ServerPartT IO Response
38serveElm fp = do
39serveElm fp = do
40+ fileExists <- liftIO $ doesFileExist file
39− guard (takeExtension fp == ".elm")
41+ guard $ fileExists && takeExtension fp == ".elm"
40− let file = tail fp
42+
41− args = [ "--make" ,"--runtime=" ++ runtime, "--cache-dir=elm-server-cache", file ]
42− (_, stdout, _, handle) <- liftIO $ createProcess $ (proc "elm" args) { std_out = CreatePipe }
43+ (_, stdout, _, handle) <- liftIO $ createProcess $
44+ (proc "elm" args) { std_out = CreatePipe }
43 exitCode <- liftIO $ waitForProcess handle
45 exitCode <- liftIO $ waitForProcess handle
47+ dirExists <- liftIO $ doesDirectoryExist defaultCacheDirectory
44− liftIO $ removeDirectoryRecursive "elm-server-cache"
48+ when dirExists $ liftIO $ removeDirectoryRecursive defaultCacheDirectory
45 case (exitCode, stdout) of
50 case (exitCode, stdout) of
51+ (ExitFailure 127, _) ->
52+ badRequest $ toResponse "Error: elm binary not found in your path."
46 (ExitFailure _, Just out) ->
53 (ExitFailure _, Just out) ->
47 do str <- liftIO $ hGetContents out
54 do str <- liftIO $ hGetContents out
48 badRequest $ toResponse str
55 badRequest $ toResponse str
49 (ExitFailure _, Nothing) ->
56 (ExitFailure _, Nothing) ->
50 badRequest $ toResponse "See command line for error message."
57 badRequest $ toResponse "See command line for error message."
51 (ExitSuccess, _) ->
58 (ExitSuccess, _) ->
52− serveFile (asContentType "text/html") ("build" </> replaceExtension file "html")
60+ (asContentType "text/html") ("build" </> replaceExtension file "html")
63+ args = [ "--make" ,"--runtime=" ++ runtime,
64+ "--cache-dir=" ++ defaultCacheDirectory, file ]
54−serveLib :: FilePath -> [Char] -> ServerPartT IO Response
66+serveLib :: FilePath -> String -> ServerPartT IO Response
55serveLib libLoc fp = do
67serveLib libLoc fp = do
56 guard (fp == runtime)
68 guard (fp == runtime)
57 serveFile (asContentType "application/javascript") libLoc
69 serveFile (asContentType "application/javascript") libLoc
@@ -63,9 +75,11 @@ parse :: [String] -> IO ()
63parse ("--help":_) = putStrLn usage
75parse ("--help":_) = putStrLn usage
64parse ("--version":_) = putStrLn ("The Elm Server " ++ showVersion version)
76parse ("--version":_) = putStrLn ("The Elm Server " ++ showVersion version)
65parse args =
77parse args =
66− case null remainingArgs of
78+ if null remainingArgs then
67− True -> serve portNumber =<< elmRuntime
79+ serve portNumber =<< elmRuntime
68− False -> putStrLn usageMini
81+ putStrLn usageMini
70 runtimeArg = filter (isPrefixOf "--runtime-location=") args
84 runtimeArg = filter (isPrefixOf "--runtime-location=") args
71 portArg = filter (isPrefixOf "--port=") args
85 portArg = filter (isPrefixOf "--port=") args
@@ -73,7 +87,10 @@ parse args =
74 argValue arg = tail $ dropWhile (/= '=') (head arg)
88 argValue arg = tail $ dropWhile (/= '=') (head arg)
75 portNumber = if null portArg then 8000 else read (argValue portArg) :: Int
89 portNumber = if null portArg then 8000 else read (argValue portArg) :: Int
76− elmRuntime = if null runtimeArg then Elm.runtime else return $ argValue runtimeArg
90+ elmRuntime = if null runtimeArg then
93+ return $ argValue runtimeArg
78usageMini :: String
95usageMini :: String
79usageMini =
96usageMini =