git.iko.soy/elk
on 05dbca5 help sign in
elk/server/Server.hs
105 lines 3.5 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,
42 "--cache-dir=elm-server-cache", file ]
43 (_, stdout, _, handle) <- liftIO $ createProcess $
44 (proc "elm" args) { std_out = CreatePipe }
45 exitCode <- liftIO $ waitForProcess handle
46 liftIO $ removeDirectoryRecursive "elm-server-cache"
47 case (exitCode, stdout) of
48 (ExitFailure _, Just out) ->
49 do str <- liftIO $ hGetContents out
50 badRequest $ toResponse str
51 (ExitFailure _, Nothing) ->
52 badRequest $ toResponse "See command line for error message."
53 (ExitSuccess, _) ->
54 serveFile
55 (asContentType "text/html") ("build" </> replaceExtension file "html")
57serveLib :: FilePath -> [Char] -> ServerPartT IO Response
58serveLib libLoc fp = do
59 guard (fp == runtime)
60 serveFile (asContentType "application/javascript") libLoc
62main :: IO ()
63main = getArgs >>= parse
65parse :: [String] -> IO ()
66parse ("--help":_) = putStrLn usage
67parse ("--version":_) = putStrLn ("The Elm Server " ++ showVersion version)
68parse args =
69 case null remainingArgs of
70 True -> serve portNumber =<< elmRuntime
71 False -> putStrLn usageMini
72 where
73 runtimeArg = filter (isPrefixOf "--runtime-location=") args
74 portArg = filter (isPrefixOf "--port=") args
75 remainingArgs = (args \\ runtimeArg) \\ portArg
77 argValue arg = tail $ dropWhile (/= '=') (head arg)
78 portNumber = if null portArg then 8000 else read (argValue portArg) :: Int
79 elmRuntime = if null runtimeArg then
80 Elm.runtime
81 else
82 return $ argValue runtimeArg
84usageMini :: String
85usageMini =
86 "Usage: elm-server [OPTIONS]\n\
87 \Try `elm-server --help' for more information."
89usage :: String
90usage =
91 "Usage: elm-server [OPTIONS]\n\
92 \Compiles and serves .elm files from the current directory.\n\
93 \Example: elm-server\n\
94 \\n\
95 \Server configuration:\n\
96 \ --port set the port to listen on (default: 8000)\n\
97 \\n\
98 \Resource Locations:\n\
99 \ --runtime-location set the location of the Elm runtime\n\
100 \\n\
101 \Compiler Information:\n\
102 \ --version print the version information and exit\n\
103 \ --help display this help and exit\n\
104 \\n\
105 \Elm home page: <http://elm-lang.org>"