git.iko.soy/elk
on 56ecbbc help sign in
elk/server/Server.hs
116 lines 3.8 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 Language.Elm as Elm
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
36defaultCacheDirectory = "elm-server-cache"
38serveElm :: FilePath -> ServerPartT IO Response
39serveElm fp = do
40 fileExists <- liftIO $ doesFileExist file
41 guard $ fileExists && takeExtension fp == ".elm"
43 (_, stdout, _, handle) <- liftIO $ createProcess $
44 (proc "elm" args) { std_out = CreatePipe }
45 exitCode <- liftIO $ waitForProcess handle
47 dirExists <- liftIO $ doesDirectoryExist defaultCacheDirectory
48 when dirExists $ liftIO $ removeDirectoryRecursive defaultCacheDirectory
50 case (exitCode, stdout) of
51 (ExitFailure 127, _) ->
52 badRequest $ toResponse "Error: elm binary not found in your path."
53 (ExitFailure _, Just out) ->
54 do str <- liftIO $ hGetContents out
55 badRequest $ toResponse str
56 (ExitFailure _, Nothing) ->
57 badRequest $ toResponse "See command line for error message."
58 (ExitSuccess, _) ->
59 serveFile
60 (asContentType "text/html") ("build" </> replaceExtension file "html")
62 where file = tail fp
63 args = [ "--make" ,"--runtime=" ++ runtime,
64 "--cache-dir=" ++ defaultCacheDirectory, file ]
66serveLib :: FilePath -> String -> ServerPartT IO Response
67serveLib libLoc fp = do
68 guard (fp == runtime)
69 serveFile (asContentType "application/javascript") libLoc
71main :: IO ()
72main = getArgs >>= parse
74parse :: [String] -> IO ()
75parse ("--help":_) = putStrLn usage
76parse ("--version":_) = putStrLn ("The Elm Server " ++ showVersion version)
77parse args =
78 if null remainingArgs then
79 serve portNumber =<< elmRuntime
80 else
81 putStrLn usageMini
83 where
84 runtimeArg = filter (isPrefixOf "--runtime-location=") args
85 portArg = filter (isPrefixOf "--port=") args
86 remainingArgs = (args \\ runtimeArg) \\ portArg
88 argValue arg = tail $ dropWhile (/= '=') (head arg)
89 portNumber = if null portArg then 8000 else read (argValue portArg) :: Int
90 elmRuntime = if null runtimeArg then
91 Elm.runtime
92 else
93 return $ argValue runtimeArg
95usageMini :: String
96usageMini =
97 "Usage: elm-server [OPTIONS]\n\
98 \Try `elm-server --help' for more information."
100usage :: String
101usage =
102 "Usage: elm-server [OPTIONS]\n\
103 \Compiles and serves .elm files from the current directory.\n\
104 \Example: elm-server\n\
105 \\n\
106 \Server configuration:\n\
107 \ --port set the port to listen on (default: 8000)\n\
108 \\n\
109 \Resource Locations:\n\
110 \ --runtime-location set the location of the Elm runtime\n\
111 \\n\
112 \Compiler Information:\n\
113 \ --version print the version information and exit\n\
114 \ --help display this help and exit\n\
115 \\n\
116 \Elm home page: <http://elm-lang.org>"