module Snap.Snaplet.PureScript
( initPurs
, pursServe
, module Internals
) where
import Prelude hiding (FilePath)
import Snap.Core
import Snap.Snaplet
import Control.Monad
import Control.Monad.State.Strict
import Paths_snaplet_purescript
import Shelly hiding (get)
import Text.Printf
import Data.Monoid
import Data.Configurator
import qualified Data.Text.Encoding as TE
import qualified Data.Text as T
import Snap.Snaplet.PureScript.Internal as Internals (PureScript)
import Snap.Snaplet.PureScript.Internal
import Text.RawString.QQ
initPurs :: SnapletInit b PureScript
initPurs = makeSnaplet "purs" description (Just dataDir) $ do
config <- getSnapletUserConfig
env <- getEnvironment
buildDir <- liftIO (lookupDefault "js" config "buildDir")
verbosity <- liftIO (lookupDefault Verbose config "verbosity")
cm <- getCompilationFlavour
destDir <- getDestDir
srcDir <- fromText <$> getSrcDir
jsDir <- fromText <$> getJsDir
gruntfile <- fromText <$> getGruntfile
let envCfg = fromText $ destDir <> T.pack ("/" <> env <> ".cfg")
shelly $ silently $ do
srcDirExisted <- test_f srcDir
mapM_ mkdir_p [jsDir, srcDir]
gruntFileExists <- test_f gruntfile
envCfgExists <- test_f envCfg
unless gruntFileExists $ writefile gruntfile (gruntTemplate buildDir)
unless envCfgExists $ do
touchfile envCfg
writefile envCfg (envCfgTemplate verbosity cm)
unless srcDirExisted $ do
let mainFile = srcDir </> (fromText "Main.purs")
touchfile mainFile
writefile mainFile mainTemplate
compileAll srcDir
return $ PureScript cm verbosity
where
description = "Automatic (re)compilation of PureScript projects"
dataDir = liftM (++ "/resources") getDataDir
pursLog :: String -> Handler b PureScript ()
pursLog l = do
verb <- get >>= return . pursVerbosity
unless (verb == Quiet) (liftIO $ putStrLn $ "snaplet-purescript: " <> l)
pursServe :: Handler b PureScript ()
pursServe = do
modifyResponse . setContentType $ "text/javascript;charset=utf-8"
get >>= compileWithMode . pursCompilationMode
(_, requestedJs) <- T.breakOn "/" . T.drop 1 . TE.decodeUtf8 . rqURI <$> getRequest
case requestedJs of
"" -> fail "The path you asked me to serve doesn't point anywhere!"
_ -> do
pursLog $ "Serving " <> T.unpack requestedJs
jsDir <- getJsDir
let fulljsPath = jsDir <> requestedJs
(shelly $ silently $ readfile (fromText fulljsPath)) >>= writeText
compileAll :: MonadIO m => FilePath -> m ()
compileAll fp = liftIO $ shelly $ silently $ errExit False $ chdir fp $ do
res <- run "grunt" []
eC <- lastExitCode
unless (eC == 0) $ error (show res)
compileWithMode :: CompilationMode -> Handler b PureScript ()
compileWithMode CompileOnce = return ()
compileWithMode CompileAlways = do
srcDir <- getSrcDir
pursLog $ "Compiling from " <> T.unpack srcDir
compileAll (fromText srcDir)
gruntTemplate :: String -> T.Text
gruntTemplate = T.pack . printf [r|
module.exports = function(grunt) { "use strict"; grunt.initConfig({
srcFiles: ["src/**/*.purs", "bower_components/**/src/**/*.purs"],
pscMake: {
options: {
//main: "YourMainGoesHere",
modules: [] //Your modules list goes here
},
lib: {
src: ["<%%=srcFiles%%>"],
dest: "%s"
}
}
});
grunt.loadNpmTasks("grunt-purescript");
grunt.registerTask("default", ["pscMake:lib"]);
};
|]
envCfgTemplate :: Verbosity -> CompilationMode -> T.Text
envCfgTemplate ver cm = T.pack $ printf [r|
# Choose one between 'Verbose' and 'Quiet'
verbosity = "%s"
# Choose one between 'CompileOnce' and 'CompileAlways'
compilationMode = "%s"
|] (show ver) (show cm)
mainTemplate :: T.Text
mainTemplate = T.pack [r|
module Main where
import Debug.Trace
main = trace "Hello PS world!"
|]