diff --git a/snap-elm.cabal b/snap-elm.cabal --- a/snap-elm.cabal +++ b/snap-elm.cabal @@ -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, diff --git a/src/Snap/Elm.hs b/src/Snap/Elm.hs --- a/src/Snap/Elm.hs +++ b/src/Snap/Elm.hs @@ -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