diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Kyle Carter + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Kyle Carter nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/snap-elm.cabal b/snap-elm.cabal new file mode 100644 --- /dev/null +++ b/snap-elm.cabal @@ -0,0 +1,30 @@ +name: snap-elm +version: 0.1.0.0 +synopsis: Serve Elm files through the Snap web framework. +license: BSD3 +license-file: LICENSE +author: Kyle Carter +maintainer: kylcarte@gmail.com +copyright: Copyright Kyle Carter 2013 +category: Web +build-type: Simple +cabal-version: >=1.10 + +extra-source-files: + LICENSE, + Setup.hs + +library + exposed-modules: Snap.Elm + -- other-extensions: + build-depends: base >=4.6 && <5, + bytestring >=0.10, + Elm >=0.9, + filepath >=1.3, + snap-core >=0.9, + process >=1.1, + text >=0.11, + transformers >= 0.3 + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 diff --git a/src/Snap/Elm.hs b/src/Snap/Elm.hs new file mode 100644 --- /dev/null +++ b/src/Snap/Elm.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE OverloadedStrings #-} + +{-| + +This module provides a few functions for conveniently serving +Elm files through the Snap web framework. Any changes made to +the served files will be reflected in the browser upon a refresh. + +The easiest way to get started is to use the default ElmOptions: + +> app = makeSnaplet ... $ do +> opts <- defaultElmOptions +> ... +> addRoutes $ routes opts +> ... + +Then, provide routes to the Elm runtime, and to any Elm files +you wish to serve. + +> routes opts = +> [ ("/elm", serveElm opts "static/elm/test.elm") +> , ... +> , serveElmRuntime opts +> ] + +Additionally, you can customize the URI of the Elm runtime, +the file path to the Elm runtime, or the paths to the +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") +> ... +> addRoutes $ routes opts +> ... + +|-} + +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 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 + , elmRuntimePath :: 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 + +-- | 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 + +-- | Serve an Elm file. The 'ElmOptions' argument can be +-- constructed at the initialization of your app. +serveElm :: MonadSnap m => ElmOptions -> FilePath -> m () +serveElm opts fp = when (takeExtension fp == ".elm") $ do + let args = [ "--make" + , "--runtime=" ++ runtimeURI + , "--build-dir=" ++ buildPath + , "--cache-dir=" ++ cachePath + , fp + ] + (ec,out,err) <- liftIO $ readProcessWithExitCode "elm" args "" + case ec of + ExitFailure _ -> writeText $ T.unlines + [ "Failed to build Elm file (" <> T.pack fp <> "):" + , T.pack out + , T.pack err + ] + ExitSuccess -> serveFile (buildPath replaceExtension fp "html") + where + buildPath = elmBuildPath opts + cachePath = elmCachePath opts + runtimeURI = C8.unpack $ elmRuntimeURI opts + +-- | 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