elm-server 0.10.1 → 0.11
raw patch · 3 files changed
+120/−106 lines, 3 filesdep +bytestringdep +cmdargsdep +snap-coredep −HTTPdep −blaze-htmldep −deepseqdep ~Elmdep ~mtl
Dependencies added: bytestring, cmdargs, snap-core, snap-server, unordered-containers
Dependencies removed: HTTP, blaze-html, deepseq, happstack-server, parsec, transformers
Dependency ranges changed: Elm, mtl
Files
- LICENSE +1/−1
- Server.hs +105/−92
- elm-server.cabal +14/−13
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c)2012-2013, Evan Czaplicki+Copyright (c)2012-2014, Evan Czaplicki All rights reserved.
Server.hs view
@@ -1,114 +1,127 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} module Main where -import Control.Monad (msum,guard,when)+import Control.Applicative ((<$>),(<|>))+import Control.Monad (guard) import Control.Monad.Trans (MonadIO(liftIO))-import Data.List (isPrefixOf, isSuffixOf, (\\))-import Data.Version (showVersion)-import Happstack.Server-import Happstack.Server.Compression+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.HashMap.Strict as Map+import qualified Data.Version as Version+import System.Console.CmdArgs import System.Directory-import System.Environment import System.Exit import System.FilePath import System.Process-import GHC.IO.Handle-import qualified Elm.Internal.Paths as ElmPaths-import Paths_elm_server+import System.IO (hGetContents, Handle) -runtime = "/elm-runtime.js"+import Paths_elm_server (version)+import qualified Elm.Internal.Paths as Elm+import Snap.Core+import Snap.Http.Server+import Snap.Util.FileServe -serve :: Int -> String -> IO ()-serve portNumber libLoc = do- putStrLn $ "Elm Server " ++ showVersion version ++- ": running at <http://localhost:" ++ show portNumber ++ ">"- putStrLn "Just refresh a page to recompile it!"- simpleHTTP httpConf $ do- _ <- compressedResponseFilter- msum [ uriRest serveElm- , uriRest (serveLib libLoc)- , serveDirectory EnableBrowsing [] "."- ]- where httpConf = nullConf { port = portNumber }+data Flags = Flags+ { port :: Int+ , runtime :: Maybe FilePath+ } deriving (Data,Typeable,Show,Eq) -pageTitle :: String -> String-pageTitle = dropExtension . takeBaseName+flags :: Flags+flags = Flags+ { port = 8000 &= help "set the port of the server"+ , runtime = Nothing &= typFile+ &= help "Specify a custom location for Elm's runtime system."+ } &= help "Quickly reload Elm projects in your browser. Just refresh to recompile.\n\+ \It serves static files and freshly recompiled Elm files."+ &= helpArg [explicit, name "help", name "h"]+ &= versionArg [ explicit, name "version", name "v"+ , summary (Version.showVersion version)+ ]+ &= summary ("Elm Server " ++ Version.showVersion version +++ ", (c) Evan Czaplicki 2011-2014") -serveElm :: FilePath -> ServerPartT IO Response-serveElm fp =- do fileExists <- liftIO $ doesFileExist file- guard (fileExists && takeExtension fp == ".elm")- onSuccess compile serve- where- file = tail fp - compile = liftIO $ createProcess $ (proc "elm" args) { std_out = CreatePipe }- where args = [ "--make", "--runtime=" ++ runtime, file ]-- serve = serveFile (asContentType "text/html")- ("build" </> replaceExtension file "html")+config :: Config Snap a+config = setAccessLog ConfigNoLog (setErrorLog ConfigNoLog defaultConfig) -onSuccess action success = do- (_, stdout, _, handle) <- action- exitCode <- liftIO $ waitForProcess handle- case (exitCode, stdout) of- (ExitFailure 127, _) ->- badRequest $ toResponse "Error: elm binary not found in your path."- (ExitFailure _, Just out) ->- do str <- liftIO $ hGetContents out- badRequest $ toResponse str- (ExitFailure _, Nothing) ->- badRequest $ toResponse "See command line for error message."- (ExitSuccess, _) -> success+-- | Set up the server.+main :: IO ()+main = do+ cargs <- cmdArgs flags+ putStrLn $ "Elm Server " ++ Version.showVersion version +++ ": Just refresh a page to recompile it!"+ httpServe (setPort (port cargs) config) $+ serveRuntime (maybe Elm.runtime id (runtime cargs))+ <|> serveElm+ <|> serveDirectoryWith directoryConfig "." +directoryConfig :: MonadSnap m => DirectoryConfig m+directoryConfig =+ fancyDirectoryConfig+ { indexGenerator = defaultIndexGenerator defaultMimeTypes indexStyle+ , mimeTypes = Map.insert ".elm" "text/html" defaultMimeTypes+ } -serveLib :: FilePath -> String -> ServerPartT IO Response-serveLib libLoc fp = do- guard (fp == runtime)- serveFile (asContentType "application/javascript") libLoc+indexStyle :: BS.ByteString+indexStyle =+ "body { margin:0; font-family:sans-serif; background:rgb(245,245,245);\+ \ font-family: calibri, verdana, helvetica, arial; }\+ \div.header { padding: 40px 50px; font-size: 24px; }\+ \div.content { padding: 0 40px }\+ \div.footer { display:none; }\+ \table { width:100%; border-collapse:collapse; }\+ \td { padding: 6px 10px; }\+ \tr:nth-child(odd) { background:rgb(216,221,225); }\+ \td { font-family:monospace }\+ \th { background:rgb(90,99,120); color:white; text-align:left;\+ \ padding:10px; font-weight:normal; }" -main :: IO ()-main = getArgs >>= parse+runtimeName :: String+runtimeName = "elm-runtime.js" -parse :: [String] -> IO ()-parse ("--help":_) = putStrLn usage-parse ("--version":_) = putStrLn ("The Elm Server " ++ showVersion version)-parse args =- if null remainingArgs then- serve portNumber elmRuntime- else- putStrLn usageMini+serveRuntime :: FilePath -> Snap ()+serveRuntime runtimePath =+ do file <- BSC.unpack . rqPathInfo <$> getRequest+ guard (file == runtimeName)+ serveFileAs "application/javascript" runtimePath +serveElm :: Snap ()+serveElm =+ do file <- BSC.unpack . rqPathInfo <$> getRequest+ exists <- liftIO $ doesFileExist file+ guard (exists && takeExtension file == ".elm")+ onSuccess (compile file) (serve file) where- runtimeArg = filter (isPrefixOf "--runtime-location=") args- portArg = filter (isPrefixOf "--port=") args- remainingArgs = (args \\ runtimeArg) \\ portArg+ compile file =+ let elmArgs = [ "--make", "--runtime=" ++ runtimeName, file ]+ in createProcess $ (proc "elm" elmArgs) { std_out = CreatePipe } - argValue arg = tail $ dropWhile (/= '=') (head arg)- portNumber = if null portArg then 8000 else read (argValue portArg) :: Int- elmRuntime = if null runtimeArg then- ElmPaths.runtime- else- argValue runtimeArg+ serve file =+ serveFileAs "text/html; charset=UTF-8" ("build" </> replaceExtension file "html") -usageMini :: String-usageMini =- "Usage: elm-server [OPTIONS]\n\- \Try `elm-server --help' for more information."+failure :: String -> Snap ()+failure msg =+ do modifyResponse $ setResponseStatus 404 "Not found"+ writeBS $ BSC.pack msg -usage :: String-usage =- "Usage: elm-server [OPTIONS]\n\- \Compiles and serves .elm files from the current directory.\n\- \Example: elm-server\n\- \\n\- \Server configuration:\n\- \ --port set the port to listen on (default: 8000)\n\- \\n\- \Resource Locations:\n\- \ --runtime-location set the location of the Elm runtime\n\- \\n\- \Compiler Information:\n\- \ --version print the version information and exit\n\- \ --help display this help and exit\n\- \\n\- \Elm home page: <http://elm-lang.org>"+onSuccess :: IO (t, Maybe Handle, t1, ProcessHandle) -> Snap () -> Snap ()+onSuccess action success =+ do (_, stdout, _, handle) <- liftIO action+ exitCode <- liftIO $ waitForProcess handle+ case (exitCode, stdout) of+ (ExitFailure 127, _) ->+ failure "Error: elm compiler not found in your path."++ (ExitFailure _, Just out) ->+ failure =<< liftIO (hGetContents out)++ (ExitFailure _, Nothing) ->+ failure "See command line for error message."++ (ExitSuccess, _) -> success++{--+pageTitle :: String -> String+pageTitle = dropExtension . takeBaseName+--}
elm-server.cabal view
@@ -1,7 +1,9 @@ Name: elm-server-Version: 0.10.1-Synopsis: The Elm language server.-Description: This package provides a standalone, Happstack-based Elm server.+Version: 0.11+Synopsis: Server for developing Elm projects+Description: Provides a standalone Snap server that serves static files.+ For Elm files, it recompiles them and serves them as HTML,+ so you can just refresh to see the new version. Homepage: http://elm-lang.org @@ -10,7 +12,7 @@ Author: Evan Czaplicki Maintainer: info@elm-lang.org-Copyright: Copyright: (c) 2011-2013 Evan Czaplicki+Copyright: Copyright: (c) 2011-2014 Evan Czaplicki Category: Compiler, Language @@ -26,15 +28,14 @@ Executable elm-server Main-is: Server.hs Build-depends: base >=4.2 && <5,+ bytestring,+ cmdargs, containers >= 0.3, directory,- transformers >= 0.2,- mtl >= 2,- parsec >= 3.1.1,- blaze-html >= 0.5.1,- HTTP >= 4000,- happstack-server,- deepseq, filepath,- Elm >= 0.10.1,- process+ Elm >= 0.11,+ snap-core,+ snap-server,+ mtl,+ process,+ unordered-containers