git.iko.soy/elk
on 007ea71 help sign in
elk/server/Server.hs
114 lines 3.6 kB history raw
1module Main where
3import Control.Monad (msum,guard,when)
4import Control.Monad.Trans (MonadIO(liftIO))
5import Data.List (isPrefixOf, isSuffixOf, (\\))
6import Data.Version (showVersion)
7import Happstack.Server
8import Happstack.Server.Compression
9import System.Directory
10import System.Environment
11import System.Exit
12import System.FilePath
13import System.Process
14import GHC.IO.Handle
15import qualified Elm.Internal.Paths as ElmPaths
16import Paths_elm_server
18runtime = "/elm-runtime.js"
20serve :: Int -> String -> IO ()
21serve portNumber libLoc = do
22 putStrLn $ "Elm Server " ++ showVersion version ++
23 ": running at <http://localhost:" ++ show portNumber ++ ">"
24 putStrLn "Just refresh a page to recompile it!"
25 simpleHTTP httpConf $ do
26 _ <- compressedResponseFilter
27 msum [ uriRest serveElm
28 , uriRest (serveLib libLoc)
29 , serveDirectory EnableBrowsing [] "."
30 ]
31 where httpConf = nullConf { port = portNumber }
33pageTitle :: String -> String
34pageTitle = dropExtension . takeBaseName
36serveElm :: FilePath -> ServerPartT IO Response
37serveElm fp =
38 do fileExists <- liftIO $ doesFileExist file
39 guard (fileExists && takeExtension fp == ".elm")
40 onSuccess compile serve
41 where
42 file = tail fp
44 compile = liftIO $ createProcess $ (proc "elm" args) { std_out = CreatePipe }
45 where args = [ "--make", "--runtime=" ++ runtime, file ]
47 serve = serveFile (asContentType "text/html")
48 ("build" </> replaceExtension file "html")
50onSuccess action success = do
51 (_, stdout, _, handle) <- action
52 exitCode <- liftIO $ waitForProcess handle
53 case (exitCode, stdout) of
54 (ExitFailure 127, _) ->
55 badRequest $ toResponse "Error: elm binary not found in your path."
56 (ExitFailure _, Just out) ->
57 do str <- liftIO $ hGetContents out
58 badRequest $ toResponse str
59 (ExitFailure _, Nothing) ->
60 badRequest $ toResponse "See command line for error message."
61 (ExitSuccess, _) -> success
64serveLib :: FilePath -> String -> ServerPartT IO Response
65serveLib libLoc fp = do
66 guard (fp == runtime)
67 serveFile (asContentType "application/javascript") libLoc
69main :: IO ()
70main = getArgs >>= parse
72parse :: [String] -> IO ()
73parse ("--help":_) = putStrLn usage
74parse ("--version":_) = putStrLn ("The Elm Server " ++ showVersion version)
75parse args =
76 if null remainingArgs then
77 serve portNumber elmRuntime
78 else
79 putStrLn usageMini
81 where
82 runtimeArg = filter (isPrefixOf "--runtime-location=") args
83 portArg = filter (isPrefixOf "--port=") args
84 remainingArgs = (args \\ runtimeArg) \\ portArg
86 argValue arg = tail $ dropWhile (/= '=') (head arg)
87 portNumber = if null portArg then 8000 else read (argValue portArg) :: Int
88 elmRuntime = if null runtimeArg then
89 ElmPaths.runtime
90 else
91 argValue runtimeArg
93usageMini :: String
94usageMini =
95 "Usage: elm-server [OPTIONS]\n\
96 \Try `elm-server --help' for more information."
98usage :: String
99usage =
100 "Usage: elm-server [OPTIONS]\n\
101 \Compiles and serves .elm files from the current directory.\n\
102 \Example: elm-server\n\
103 \\n\
104 \Server configuration:\n\
105 \ --port set the port to listen on (default: 8000)\n\
106 \\n\
107 \Resource Locations:\n\
108 \ --runtime-location set the location of the Elm runtime\n\
109 \\n\
110 \Compiler Information:\n\
111 \ --version print the version information and exit\n\
112 \ --help display this help and exit\n\
113 \\n\
114 \Elm home page: <http://elm-lang.org>"