snap-elm 0.1.0.1 → 0.1.1
raw patch · 2 files changed
+124/−43 lines, 2 filesdep +directory
Dependencies added: directory
Files
- snap-elm.cabal +2/−1
- src/Snap/Elm.hs +122/−42
snap-elm.cabal view
@@ -1,5 +1,5 @@ name: snap-elm-version: 0.1.0.1+version: 0.1.1 synopsis: Serve Elm files through the Snap web framework. license: BSD3 license-file: LICENSE@@ -20,6 +20,7 @@ build-depends: base >=4.6 && <5, bytestring >=0.10, Elm >=0.9,+ directory >=1.2, filepath >=1.3, snap-core >=0.9, process >=1.1,
src/Snap/Elm.hs view
@@ -28,100 +28,180 @@ directores that Elm will use to build and cache the compiled files. > app = makeSnaplet ... $ do-> opts <- mkElmOptions-> "route/to/use/for/runtime.js"-> (Just "/my/own/local/file/for/the/actual/runtime.js")-> (Just "/tmp/location/for/build/dir")-> (Just "/tmp/location/for/cache/dir")+> opts <- setElmBuildPath "/tmp/elm" <$>+> setElmVerbose True <$>+> defaultElmOptions > ... > addRoutes $ routes opts > ... +The 'FilePath's supplied to setElm{Source,Build,Cache}Path can be+relative or absolute.+ -} module Snap.Elm where ------------------------------------------------------------------------------- import Control.Monad import Control.Monad.IO.Class import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C8-import Data.Maybe (fromMaybe) import Data.Monoid import qualified Data.Text as T import Snap.Core import Snap.Util.FileServe------------------------------------------------------------------------------- import qualified Language.Elm as Elm+import GHC.IO.Handle+import System.Directory import System.Exit import System.FilePath import System.Process------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- | A set of options to coordinate the serving of Elm files and runtime. data ElmOptions = ElmOptions- { elmRuntimeURI :: ByteString+ { elmIsVerbose :: Bool+ , elmRuntimeURI :: ByteString , elmRuntimePath :: FilePath+ , elmSourcePath :: FilePath , elmBuildPath :: FilePath , elmCachePath :: FilePath } ------------------------------------------------------------------------------- -- | The default set of options for serving Elm files. -- This will use "static/js/elm-runtime.js" as the URI -- for the Elm runtime, so you should use a custom route -- if the route conflicts with another, for some reason. defaultElmOptions :: MonadIO m => m ElmOptions-defaultElmOptions = mkElmOptions- "/static/js/elm-runtime.js"- Nothing- Nothing- Nothing+defaultElmOptions = do+ let v = False+ let uri = "/static/js/elm-runtime.js"+ rt <- liftIO Elm.runtime+ let s = "."+ let b = "elm-build"+ let c = "elm-cache"+ return $ ElmOptions v uri rt s b c ---------------------------------------------------------------------------------- | Construct a custom set of options.-mkElmOptions :: MonadIO m- => ByteString -- ^ Route at which to serve Elm runtime- -> Maybe FilePath -- ^ 'FilePath' to custom Elm runtime- -> Maybe FilePath -- ^ 'FilePath' to custom build directory- -> Maybe FilePath -- ^ 'FilePath' to custom cache directory- -> m ElmOptions-mkElmOptions uri mr mb mc = do- rt <- maybe (liftIO Elm.runtime) return mr- let bp = fromMaybe "elm-build" mb- let cp = fromMaybe "elm-cache" mc- return $ ElmOptions uri rt bp cp+-- | Tell Elm to be verbose (print all executed commands and their output+-- to stdout), or quiet (print nothing).+setElmVerbose :: Bool -> ElmOptions -> ElmOptions+setElmVerbose v opts = opts { elmIsVerbose = v } ---------------------------------------------------------------------------------- | Serve an Elm file. The 'ElmOptions' argument can be--- constructed at the initialization of your app.+-- | Set the URI at which to serve the Elm runtime JS file.+setElmRuntimeURI :: ByteString -> ElmOptions -> ElmOptions+setElmRuntimeURI uri opts = opts { elmRuntimeURI = uri }++-- | Set the 'FilePath' to some custom Elm runtime.+setElmRuntimePath :: FilePath -> ElmOptions -> ElmOptions+setElmRuntimePath rt opts = opts { elmRuntimePath = rt }++-- | Set the directory to look for .elm files.+-- This allows for the @elm@ binary to properly find+-- local Elm modules.+setElmSourcePath :: FilePath -> ElmOptions -> ElmOptions+setElmSourcePath src opts = opts { elmSourcePath = src }++-- | Set the directory to use for storing the compiled .html+-- that @elm@ produces.+setElmBuildPath :: FilePath -> ElmOptions -> ElmOptions+setElmBuildPath bld opts = opts { elmBuildPath = bld }++-- | Set the directory to use for storing the .elmi and .elmo+-- files that @elm@ produces.+setElmCachePath :: FilePath -> ElmOptions -> ElmOptions+setElmCachePath cch opts = opts { elmCachePath = cch }++-- | Compile and serve an Elm file. serveElm :: MonadSnap m => ElmOptions -> FilePath -> m () serveElm opts fp = when (takeExtension fp == ".elm") $ do+ cd <- liftIO getCurrentDirectory+ let runtimeURI = C8.unpack (elmRuntimeURI opts)+ let sourcePath = makeAbsolutePath (elmSourcePath opts) cd+ let buildPath = makeAbsolutePath (elmBuildPath opts) cd+ let cachePath = makeAbsolutePath (elmCachePath opts) cd let args = [ "--make" , "--runtime=" ++ runtimeURI , "--build-dir=" ++ buildPath , "--cache-dir=" ++ cachePath , fp ]- (ec,out,err) <- liftIO $ readProcessWithExitCode "elm" args ""++ ifVerbose $ liftIO $ do+ putStrLn "Elm:"+ putStrLn $ " $ cd " ++ elmSourcePath opts+ putStrLn $ unwords $ " $ elm" : args++ (_,hOut,hErr,pid) <- liftIO $ runInteractiveProcess "elm" args+ (Just sourcePath)+ Nothing+ out <- liftIO $ hGetContents hOut+ err <- liftIO $ hGetContents hErr+ ec <- liftIO $ waitForProcess pid+ ifVerbose $ liftIO $ putStrLn $ indent out+ case ec of ExitFailure _ -> writeText $ T.unlines [ "Failed to build Elm file (" <> T.pack fp <> "):"- , T.pack out- , T.pack err+ , " " <> T.pack err ] ExitSuccess -> serveFile $ buildPath </> replaceExtension fp "html" where- buildPath = elmBuildPath opts- cachePath = elmCachePath opts- runtimeURI = C8.unpack $ elmRuntimeURI opts+ ifVerbose = when $ elmIsVerbose opts+ indent = unlines . map (" " ++) . lines -------------------------------------------------------------------------------+ makeAbsolutePath :: FilePath -> FilePath -> FilePath+ makeAbsolutePath p cd = case p of+ "" -> cd+ "." -> cd+ '/':_ -> p+ _ -> cd </> p++-- | Serve a directory of Elm files, using a route parameter.+--+-- For example, a list of routes could contain:+--+-- > routes opts =+-- > [ ...+-- > , ("elm/:file", jerveElmDirectory opts "file")+-- > ]+--+-- Then, following the example, if the ElmOptions contained @static/elm@+-- as the sourcePath, the route @elm/file.elm@ would+-- be handled by @serveElm "file.elm"@, run with the working directory+-- @static/elm@.+serveElmDirectory :: MonadSnap m+ => ElmOptions+ -> ByteString+ -- ^ Route parameter name by which to identify files+ -> m ()+serveElmDirectory opts pm = do+ mf <- getParam pm+ whenJust mf (serveElm opts . C8.unpack)+ where+ whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()+ whenJust m f = maybe (return ()) f m++serveElmDirectory' :: MonadSnap m+ => ElmOptions+ -> ByteString+ -> (ByteString, m ())+serveElmDirectory' opts d = (uri,handler)+ where+ param = "file"+ uri+ | C8.null d = "/:" <> param+ | C8.last d == '/' = d <> ":" <> param+ | otherwise = d <> "/:" <> param+ handler = do+ mf <- getParam param+ whenJust mf (serveElm opts . C8.unpack)+ whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()+ whenJust m f = maybe (return ()) f m++ -- | A route handler for the Elm runtime. If given the 'ElmOptions' used -- by 'serveElm', it will place the runtime at the route the Elm file--- will expect, as per the <script src=".../runtime.js"> element included--- in the compiled file's <head> section.+-- will expect, as per the @<script src=".../runtime.js">@ element included+-- in the compiled file's @<head>@ section. serveElmRuntime :: MonadSnap m => ElmOptions -> (ByteString, m ()) serveElmRuntime opts = ( elmRuntimeURI opts