git.iko.soy/elk
on 8a255de help sign in
elk/server/Server.hs
99 lines 3.3 kB history raw
2module Main where
4import Control.Monad (msum,guard)
5import Control.Monad.Trans (MonadIO(liftIO))
6import Data.List (isPrefixOf, isSuffixOf, (\\))
7import Data.Version (showVersion)
8import Happstack.Server
9import Happstack.Server.Compression
10import System.Directory
11import System.Environment
12import System.Exit
13import System.FilePath
14import System.Process
15import GHC.IO.Handle
16import qualified Language.Elm as Elm
17import Paths_elm_server
19runtime = "/elm-runtime.js"
21serve :: Int -> String -> IO ()
22serve portNumber libLoc = do
23 putStrLn $ "Elm Server " ++ showVersion version ++
24 ": running at <http://localhost:" ++ show portNumber ++ ">"
25 putStrLn "Just refresh a page to recompile it!"
26 simpleHTTP httpConf $ do
27 _ <- compressedResponseFilter
28 msum [ uriRest serveElm
29 , uriRest (serveLib libLoc)
30 , serveDirectory EnableBrowsing [] "."
31 ]
32 where httpConf = nullConf { port = portNumber }
34pageTitle :: String -> String
35pageTitle = dropExtension . takeBaseName
37serveElm :: FilePath -> ServerPartT IO Response
38serveElm fp = do
39 guard (takeExtension fp == ".elm")
40 let file = tail fp
41 args = [ "--make" ,"--runtime=" ++ runtime, "--cache-dir=elm-server-cache", file ]
42 (_, stdout, _, handle) <- liftIO $ createProcess $ (proc "elm" args) { std_out = CreatePipe }
43 exitCode <- liftIO $ waitForProcess handle
44 liftIO $ removeDirectoryRecursive "elm-server-cache"
45 case (exitCode, stdout) of
46 (ExitFailure _, Just out) ->
47 do str <- liftIO $ hGetContents out
48 badRequest $ toResponse str
49 (ExitFailure _, Nothing) ->
50 badRequest $ toResponse "See command line for error message."
51 (ExitSuccess, _) ->
52 serveFile (asContentType "text/html") ("build" </> replaceExtension file "html")
54serveLib :: FilePath -> [Char] -> ServerPartT IO Response
55serveLib libLoc fp = do
56 guard (fp == runtime)
57 serveFile (asContentType "application/javascript") libLoc
59main :: IO ()
60main = getArgs >>= parse
62parse :: [String] -> IO ()
63parse ("--help":_) = putStrLn usage
64parse ("--version":_) = putStrLn ("The Elm Server " ++ showVersion version)
65parse args =
66 case null remainingArgs of
67 True -> serve portNumber =<< elmRuntime
68 False -> putStrLn usageMini
69 where
70 runtimeArg = filter (isPrefixOf "--runtime-location=") args
71 portArg = filter (isPrefixOf "--port=") args
72 remainingArgs = (args \\ runtimeArg) \\ portArg
74 argValue arg = tail $ dropWhile (/= '=') (head arg)
75 portNumber = if null portArg then 8000 else read (argValue portArg) :: Int
76 elmRuntime = if null runtimeArg then Elm.runtime else return $ argValue runtimeArg
78usageMini :: String
79usageMini =
80 "Usage: elm-server [OPTIONS]\n\
81 \Try `elm-server --help' for more information."
83usage :: String
84usage =
85 "Usage: elm-server [OPTIONS]\n\
86 \Compiles and serves .elm files from the current directory.\n\
87 \Example: elm-server\n\
88 \\n\
89 \Server configuration:\n\
90 \ --port set the port to listen on (default: 8000)\n\
91 \\n\
92 \Resource Locations:\n\
93 \ --runtime-location set the location of the Elm runtime\n\
94 \\n\
95 \Compiler Information:\n\
96 \ --version print the version information and exit\n\
97 \ --help display this help and exit\n\
98 \\n\
99 \Elm home page: <http://elm-lang.org>"