snaplet-purescript 0.3.0.0 → 0.4.0.0
raw patch · 3 files changed
+151/−101 lines, 3 filesdep ~mtldep ~text
Dependency ranges changed: mtl, text
Files
- snaplet-purescript.cabal +3/−3
- src/Snap/Snaplet/PureScript.hs +131/−89
- src/Snap/Snaplet/PureScript/Internal.hs +17/−9
snaplet-purescript.cabal view
@@ -1,5 +1,5 @@ name: snaplet-purescript-version: 0.3.0.0+version: 0.4.0.0 synopsis: Automatic (re)compilation of purescript projects description: Automatic (re)compilation of purescript projects license: MIT@@ -25,8 +25,8 @@ snap-core < 1.0.0.0, snap < 1.0.0.0, raw-strings-qq >= 1.0.2,- text > 0.11 && < 1.3.0.0,- mtl < 2.3,+ text > 0.11 && < 1.4.0.0,+ mtl < 2.5, transformers, configurator >= 0.2.0.0, shelly >= 0.4.1 && < 1.7
src/Snap/Snaplet/PureScript.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-}-module Snap.Snaplet.PureScript +module Snap.Snaplet.PureScript ( initPurs , pursServe , module Internals@@ -9,8 +11,10 @@ import Prelude hiding (FilePath) import Control.Monad.IO.Class+import Control.Exception (SomeException) import Snap.Core import Snap.Snaplet+import Data.Char import Control.Monad import Control.Monad.State.Strict import Paths_snaplet_purescript@@ -30,43 +34,57 @@ initPurs = makeSnaplet "purs" description (Just dataDir) $ do config <- getSnapletUserConfig env <- getEnvironment- buildDir <- liftIO (lookupDefault "js" config "buildDir")- verbosity <- liftIO (lookupDefault Verbose config "verbosity")+ outDir <- liftIO (lookupDefault "js" config "buildDir")+ verbosity <- liftIO (lookupDefault Verbose config "verbosity")+ bndl <- liftIO (lookupDefault True config "bundle")+ bundleName <- liftIO (lookupDefault "app.js" config "bundleName")+ modules <- liftIO (lookupDefault mempty config "modules") cm <- getCompilationFlavour destDir <- getDestDir- srcDir <- fromText <$> getSrcDir- jsDir <- fromText <$> getJsDir- gruntfile <- fromText <$> getGruntfile+ let buildDir = destDir <> "/" <> outDir+ bowerfile <- fromText <$> getBowerFile let envCfg = fromText $ destDir <> T.pack ("/" <> env <> ".cfg") -- If they do not exist, create the required directories- shelly $ silently $ do- srcDirExisted <- test_d srcDir- mapM_ mkdir_p [jsDir, srcDir]- gruntFileExists <- test_f gruntfile+ purs <- shelly $ verbosely $ do+ mapM_ mkdir_p [fromText outDir]+ bowerFileExists <- test_f bowerfile envCfgExists <- test_f envCfg- unlessM (localGruntInstalled (fromText destDir)) $ do+ unlessM (pulpInstalled (fromText destDir)) $ do liftIO $ do- putStrLn "Local grunt not found, installing it for you..."- installLocalGrunt (fromText destDir)- unless gruntFileExists $ writefile gruntfile (gruntTemplate buildDir)+ putStrLn $ T.unpack $ "Local pulp not found in " <> destDir <> ", installing it for you..."+ installPulp (fromText destDir)+ putStrLn $ "Pulp installed."+ echo $ "Checking existance of " <> toTextIgnore bowerfile+ unless bowerFileExists $ do+ chdir (fromText destDir) $ run_ "pulp" ["init"]+ echo $ "Checking existance of " <> toTextIgnore envCfg++ let purs = PureScript {+ pursCompilationMode = cm+ , pursVerbosity = verbosity+ , pursBundle = bndl+ , pursBundleName = bundleName+ , pursPwdDir = destDir+ , pursOutputDir = outDir+ , pursModules = modules+ }+ unless envCfgExists $ do touchfile envCfg- writefile envCfg (envCfgTemplate verbosity cm)- unless srcDirExisted $ do- let mainFile = srcDir </> (fromText "Main.purs")- touchfile mainFile- writefile mainFile mainTemplate+ writefile envCfg (envCfgTemplate purs)+ return purs -- compile at least once, regardless of the CompilationMode. -- NOTE: We might want to ignore the ouput of this first compilation -- if we are running in a 'permissive' mode, to avoid having the entire -- web service to grind to an halt in case our Purs does not compile.- res <- compileAll (fromText destDir)+ res <- build purs+ _ <- bundle purs case res of CompilationFailed reason -> fail (T.unpack reason) CompilationSucceeded -> return () - return $ PureScript cm verbosity+ return purs where description = "Automatic (re)compilation of PureScript projects" dataDir = liftM (++ "/resources") getDataDir@@ -78,57 +96,98 @@ unless (verb == Quiet) (liftIO $ putStrLn $ "snaplet-purescript: " <> l) ---------------------------------------------------------------------------------localGruntInstalled :: FilePath -> Sh Bool-localGruntInstalled dir = errExit False $ chdir dir $ do- run_ "grunt" []- eC <- lastExitCode- return $ case eC of- 99 -> False- _ -> True+pulpInstalled :: FilePath -> Sh Bool+pulpInstalled dir = errExit False $ silently $ chdir dir $ do+ check `catchany_sh` \(_ :: SomeException) -> return False+ where+ check = do+ run_ "pulp" []+ eC <- lastExitCode+ return $ case eC of+ 0 -> True+ 1 -> True+ _ -> False ---------------------------------------------------------------------------------installLocalGrunt :: MonadIO m => FilePath -> m ()-installLocalGrunt dir = liftIO $ shelly $ silently $ chdir dir $ do- run_ "npm" ["install", "grunt"]- run_ "npm" ["install", "grunt-purescript"]+installPulp :: MonadIO m => FilePath -> m ()+installPulp dir = liftIO $ shelly $ silently $ chdir dir $ do+ run_ "npm" ["install", "-g", "pulp"] -------------------------------------------------------------------------------- pursServe :: Handler b PureScript () pursServe = do- modifyResponse . setContentType $ "text/javascript;charset=utf-8"- res <- get >>= compileWithMode . pursCompilationMode- case res of- CompilationFailed reason -> writeText reason- CompilationSucceeded -> do- -- Now get the requested file and try to serve it- -- This returns something like /purs/Hello/index.js- (_, requestedJs) <- T.breakOn "/" . T.drop 1 . TE.decodeUtf8 . rqURI <$> getRequest- case requestedJs of- "" -> fail (jsNotFound requestedJs)- _ -> do- pursLog $ "Serving " <> T.unpack requestedJs- jsDir <- getJsDir- let fulljsPath = jsDir <> requestedJs- (shelly $ silently $ readfile (fromText fulljsPath)) >>= writeText + (_, requestedJs) <- (fmap (T.takeWhile (/= '?')) . T.breakOn "/" . T.drop 1 . TE.decodeUtf8 . rqURI) <$> getRequest+ case requestedJs of+ "" -> fail (jsNotFound requestedJs)+ _ -> do+ pursLog $ "Requested file: " <> T.unpack requestedJs+ modifyResponse . setContentType $ "text/javascript;charset=utf-8"+ pwdDir <- getDestDir+ outDir <- getAbsoluteOutputDir+ let fulljsPath = outDir <> requestedJs+ pursLog $ "Serving " <> T.unpack (fulljsPath)+ compMode <- gets pursCompilationMode+ res <- compileWithMode+ _ <- bundleWithMode (T.drop 1 requestedJs)+ case res of+ CompilationFailed reason -> writeText reason+ CompilationSucceeded ->+ (shelly $ silently $ readfile (fromText fulljsPath)) >>= writeText ---------------------------------------------------------------------------------compileAll :: MonadIO m => FilePath -> m CompilationOutput-compileAll fp = liftIO $ shelly $ silently $ errExit False $ chdir fp $ do- res <- run "grunt" []- eC <- lastExitCode- case (eC == 0) of- True -> return CompilationSucceeded- False -> return $ CompilationFailed res+-- | Build the project (without bundling it).+build :: MonadIO m => PureScript -> m CompilationOutput+build PureScript{..} =+ liftIO $ shelly $ verbosely $ errExit False $+ chdir (fromText pursPwdDir) $ do+ res <- run "pulp" ["build", "-o", pursOutputDir]+ eC <- lastExitCode+ case (eC == 0) of+ True -> return CompilationSucceeded+ False -> return $ CompilationFailed res ---------------------------------------------------------------------------------compileWithMode :: CompilationMode -> Handler b PureScript CompilationOutput-compileWithMode CompileOnce = return CompilationSucceeded-compileWithMode CompileAlways = do- projDir <- getDestDir- pursLog $ "Compiling Purescript project at " <> T.unpack projDir- compileAll (fromText projDir)+bundle :: MonadIO m => PureScript -> m CompilationOutput+bundle PureScript{..} =+ liftIO $ shelly $ verbosely $ errExit False $ chdir (fromText pursPwdDir) $ do+ let bundlePath = pursOutputDir <> "/" <> pursBundleName+ case pursBundle of+ False -> return CompilationSucceeded+ True -> do+ rm_rf (fromText bundlePath)+ let modules = T.intercalate " -m " pursModules+ echo $ "Bundling everything in " <> bundlePath+ res <- run "psc-bundle" (["js/**/*.js", "-m"] <> (T.words modules) <>+ ["-o", bundlePath, "-n", "PS"])+ eC <- lastExitCode+ case (eC == 0) of+ True -> return CompilationSucceeded+ False -> return $ CompilationFailed res --------------------------------------------------------------------------------+compileWithMode :: Handler b PureScript CompilationOutput+compileWithMode = do+ mode <- gets pursCompilationMode+ case mode of+ CompileOnce -> return CompilationSucceeded+ CompileAlways -> do+ workDir <- gets pursPwdDir+ pursLog $ "Compiling Purescript project at " <> T.unpack workDir+ get >>= build++--------------------------------------------------------------------------------+bundleWithMode :: T.Text -> Handler b PureScript CompilationOutput+bundleWithMode artifactName = do+ mode <- gets pursCompilationMode+ case mode of+ CompileOnce -> return CompilationSucceeded+ CompileAlways -> do+ workDir <- gets pursPwdDir+ pursLog $ "Bundling Purescript project at " <> T.unpack workDir+ outDir <- gets pursOutputDir+ get >>= bundle++-------------------------------------------------------------------------------- jsNotFound :: T.Text -> String jsNotFound js = printf [r| You asked me to serve:@@ -138,42 +197,25 @@ But I wasn't able to find a suitable PureScript module to build. If this is the first time you are running snaplet-purescript, have-a look inside snaplets/purs/Gruntfile.js.--You probably need to uncomment the 'main:' section to make it-point to your Main.purs, as well as adding any relevant module to-your 'modules:' section.+a look inside snaplets/purs/devel.cfg. |] (T.unpack js) ---------------------------------------------------------------------------------gruntTemplate :: String -> T.Text-gruntTemplate = T.pack . printf [r|- module.exports = function(grunt) { "use strict"; grunt.initConfig({- srcFiles: ["src/**/*.purs", "bower_components/**/src/**/*.purs"],- psc: {- options: {- //main: "YourMainGoesHere",- modules: [] //Add your modules here- },- all: {- src: ["<%%=srcFiles%%>"],- dest: "%s/app.js"- }- }- });- grunt.loadNpmTasks("grunt-purescript");- grunt.registerTask("default", ["psc:all"]);- };-|]-----------------------------------------------------------------------------------envCfgTemplate :: Verbosity -> CompilationMode -> T.Text-envCfgTemplate ver cm = T.pack $ printf [r|+envCfgTemplate :: PureScript -> T.Text+envCfgTemplate PureScript{..} = T.pack $ printf [r| # Choose one between 'Verbose' and 'Quiet' verbosity = "%s" # Choose one between 'CompileOnce' and 'CompileAlways' compilationMode = "%s"-|] (show ver) (show cm)+ # Whether bundle everything in a fat app+ bundle = %s+ bundleName = "%s"+ # The list of modules you want to compile under the PS namespace (bundle only)+ modules = []+|] (show pursVerbosity)+ (show pursCompilationMode)+ (map toLower $ show pursBundle)+ (T.unpack pursBundleName) -------------------------------------------------------------------------------- mainTemplate :: T.Text
src/Snap/Snaplet/PureScript/Internal.hs view
@@ -6,6 +6,7 @@ import Control.Applicative import Data.Monoid import Control.Monad.IO.Class+import Control.Monad.Reader import Data.Configurator as Cfg import Data.Configurator.Types import Text.Read hiding (String)@@ -28,7 +29,7 @@ convert _ = Nothing ---------------------------------------------------------------------------------data CompilationOutput = CompilationFailed T.Text+data CompilationOutput = CompilationFailed !T.Text | CompilationSucceeded deriving (Show, Ord, Eq) @@ -36,6 +37,14 @@ data PureScript = PureScript { pursCompilationMode :: CompilationMode , pursVerbosity :: Verbosity+ , pursBundle :: !Bool+ -- ^ Whether or not bundle everything in a fat app with a PS namespace.+ , pursBundleName :: !T.Text+ , pursPwdDir :: !T.Text+ -- ^ The CWD of your snaplet+ , pursOutputDir :: !T.Text+ , pursModules :: ![T.Text]+ -- ^ Where to store compilation artifacts (defaults to /js) } --------------------------------------------------------------------------------@@ -71,13 +80,12 @@ return $ T.pack fp ---------------------------------------------------------------------------------getSrcDir :: (Monad (m b v), MonadIO (m b v), MonadSnaplet m) => m b v T.Text-getSrcDir = return . (`mappend` "/src") =<< getDestDir-----------------------------------------------------------------------------------getJsDir :: (Monad (m b v), MonadIO (m b v), MonadSnaplet m) => m b v T.Text-getJsDir = return . (`mappend` "/js") =<< getDestDir+getBowerFile :: (Monad (m b v), MonadIO (m b v), MonadSnaplet m) => m b v T.Text+getBowerFile = return . (`mappend` "/bower.json") =<< getDestDir ---------------------------------------------------------------------------------getGruntfile :: (Monad (m b v), MonadIO (m b v), MonadSnaplet m) => m b v T.Text-getGruntfile = return . (`mappend` "/Gruntfile.js") =<< getDestDir+getAbsoluteOutputDir :: Handler b PureScript T.Text+getAbsoluteOutputDir = do+ wDir <- asks pursPwdDir+ oDir <- asks pursOutputDir+ return $ wDir <> "/" <> oDir