module Snap.Elm
( ElmOptions (..)
, defaultElmOptions
, setElmVerbose
, setElmRuntimeURI
, setElmRuntimePath
, setElmSourcePath
, setElmBuildPath
, setElmCachePath
, serveElmFile
, serveElmDirectory
, serveElmRuntime
) where
import Control.Monad
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Snap.Core
import Snap.Util.FileServe
import qualified Language.Elm as Elm
import System.Directory
import System.Exit
import System.FilePath
import System.Process
data ElmOptions = ElmOptions
{ elmIsVerbose :: Bool
, elmRuntimeURI :: ByteString
, elmRuntimePath :: FilePath
, elmSourcePath :: FilePath
, elmBuildPath :: FilePath
, elmCachePath :: FilePath
}
defaultElmOptions :: MonadIO m => m ElmOptions
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
setElmVerbose :: Bool -> ElmOptions -> ElmOptions
setElmVerbose v opts = opts { elmIsVerbose = v }
setElmRuntimeURI :: ByteString -> ElmOptions -> ElmOptions
setElmRuntimeURI uri opts = opts { elmRuntimeURI = uri }
setElmRuntimePath :: FilePath -> ElmOptions -> ElmOptions
setElmRuntimePath rt opts = opts { elmRuntimePath = rt }
setElmSourcePath :: FilePath -> ElmOptions -> ElmOptions
setElmSourcePath src opts = opts { elmSourcePath = src }
setElmBuildPath :: FilePath -> ElmOptions -> ElmOptions
setElmBuildPath bld opts = opts { elmBuildPath = bld }
setElmCachePath :: FilePath -> ElmOptions -> ElmOptions
setElmCachePath cch opts = opts { elmCachePath = cch }
serveElmFile :: MonadSnap m => ElmOptions -> FilePath -> m ()
serveElmFile opts fp = when (takeExtension fp == ".elm") $ do
mBin <- liftIO $ findExecutable "elm"
case mBin of
Nothing -> elmError fp "No executable 'elm' in PATH"
Just bin -> 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
]
ifVerbose $ liftIO $ do
putStrLn "Elm:"
putStrLn $ " $ cd " ++ elmSourcePath opts
putStrLn $ unwords $ (" $ " <> bin) : args
(_,hOut,hErr,pid) <- liftIO $ runInteractiveProcess bin args
(Just sourcePath)
Nothing
out <- liftIO $ T.hGetContents hOut
err <- liftIO $ T.hGetContents hErr
ec <- liftIO $ waitForProcess pid
ifVerbose $ liftIO $ T.putStrLn $ indent out
case ec of
ExitFailure _ -> elmError fp $ indent $ T.unlines [ out , "" , err ]
ExitSuccess -> serveFile $ buildPath </> replaceExtension fp "html"
where
ifVerbose = when $ elmIsVerbose opts
makeAbsolutePath :: FilePath -> FilePath -> FilePath
makeAbsolutePath p cd = case p of
"" -> cd
"." -> cd
'/':_ -> p
_ -> cd </> p
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
case mf of
Nothing -> return ()
Just f -> serveElmFile opts . C8.unpack $ f
serveElmRuntime :: MonadSnap m => ElmOptions -> (ByteString, m ())
serveElmRuntime opts =
( elmRuntimeURI opts
, serveFile $ elmRuntimePath opts
)
elmError :: MonadSnap m => FilePath -> T.Text -> m ()
elmError fp msg = writeText $ T.unlines
[ "Failed to build Elm file (" <> T.pack fp <> "):"
, indent msg
]
indent :: T.Text -> T.Text
indent = T.unlines . map (T.replicate n " " <>) . T.lines
where
n = 2