snaplet-purescript 0.4.1.0 → 0.5.1.0
raw patch · 4 files changed
+200/−92 lines, 4 files
Files
- snaplet-purescript.cabal +2/−1
- src/Snap/Snaplet/PureScript.hs +110/−75
- src/Snap/Snaplet/PureScript/Hooks.hs +48/−0
- src/Snap/Snaplet/PureScript/Internal.hs +40/−16
snaplet-purescript.cabal view
@@ -1,5 +1,5 @@ name: snaplet-purescript-version: 0.4.1.0+version: 0.5.1.0 synopsis: Automatic (re)compilation of purescript projects description: Automatic (re)compilation of purescript projects license: MIT@@ -19,6 +19,7 @@ Snap.Snaplet.PureScript other-modules: Snap.Snaplet.PureScript.Internal+ Snap.Snaplet.PureScript.Hooks Paths_snaplet_purescript build-depends: base >=4.6 && < 5.1, snap-core < 1.0.0.0,
src/Snap/Snaplet/PureScript.hs view
@@ -12,7 +12,6 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.State.Strict-import Data.Char import Data.Configurator as Cfg import Data.Monoid import Data.String@@ -23,6 +22,7 @@ import Shelly hiding (get) import Snap.Core import Snap.Snaplet+import Snap.Snaplet.PureScript.Hooks import Snap.Snaplet.PureScript.Internal import Snap.Snaplet.PureScript.Internal as Internals (PureScript) import Text.Printf@@ -33,58 +33,67 @@ -- | Snaplet initialization initPurs :: SnapletInit b PureScript initPurs = makeSnaplet "purs" description (Just dataDir) $ do- config <- getSnapletUserConfig env <- getEnvironment++ destDir <- getDestDir+ shelly $ verbosely $ chdir (fromText destDir) $ do+ let envCfg = fromText $ destDir <> T.pack ("/" <> env <> ".cfg")+ echo $ "Checking existance of " <> toTextIgnore envCfg+ envCfgExists <- test_f envCfg+ unless envCfgExists $ do+ touchfile envCfg+ writefile envCfg envCfgTemplate++ config <- getSnapletUserConfig+ hooks <- liftIO $ getHooks config+ shelly $ verbosely $ chdir (fromText destDir) $ preInitHook hooks+ 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")- pulpPath <- findOrInstallPulp =<< liftIO (Cfg.lookup config "pulpPath")+ modules <- liftIO (lookupDefault ["Main"] config "modules")+ psPath <- liftIO (lookupDefault mempty config "pureScriptPath")+ pulpPath <- findOrInstallPulp psPath =<< liftIO (Cfg.lookup config "pulpPath") psaOpts <- liftIO (lookupDefault mempty config "psaOpts") permissive <- liftIO (lookupDefault False config "permissiveInit") cm <- getCompilationFlavour- destDir <- getDestDir bowerfile <- fromText <$> getBowerFile- let envCfg = fromText $ destDir <> T.pack ("/" <> env <> ".cfg") -- If they do not exist, create the required directories- purs <- shelly $ verbosely $ do- mapM_ mkdir_p [fromText outDir]+ purs <- shelly $ verbosely $ chdir (fromText destDir) $ do+ mkdir_p (fromText outDir) bowerFileExists <- test_f bowerfile- envCfgExists <- test_f envCfg echo $ "Checking existance of " <> toTextIgnore bowerfile unless bowerFileExists $ do- chdir (fromText destDir) $ run_ (fromString $ getPulpPath pulpPath) ["init"]- echo $ "Checking existance of " <> toTextIgnore envCfg-- let purs = PureScript {- pursCompilationMode = cm- , pursVerbosity = verbosity- , pursBundle = bndl- , pursBundleName = bundleName- , pursPulpPath = pulpPath- , pursPsaOpts = psaOpts- , pursPermissiveInit = permissive- , pursPwdDir = destDir- , pursOutputDir = outDir- , pursModules = modules- }+ run_ (fromString $ getPulpPath pulpPath) ["init"] - unless envCfgExists $ do- touchfile envCfg- writefile envCfg (envCfgTemplate purs)- return purs+ return PureScript {+ pursCompilationMode = cm+ , pursVerbosity = verbosity+ , pursBundle = bndl+ , pursBundleName = bundleName+ , pursPulpPath = pulpPath+ , pursPsPath = psPath+ , pursPsaOpts = psaOpts+ , pursPermissiveInit = permissive+ , pursPwdDir = destDir+ , pursOutputDir = outDir+ , pursModules = modules+ , pursHooks = hooks+ } - -- compile at least once, regardless of the CompilationMode.+ -- compile at least once, unless `CompileNever` was passed. -- NOTE: We 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 <- build purs- _ <- bundle purs- case res of- CompilationFailed reason -> unless permissive (fail (T.unpack reason))- CompilationSucceeded -> return ()+ unless (cm == CompileNever) $ do+ res <- build purs+ _ <- bundle purs+ case res of+ CompilationFailed reason -> unless permissive (fail (T.unpack reason))+ CompilationSucceeded -> return () + shelly $ verbosely $ chdir (fromText destDir) $ postInitHook hooks return purs where description = "Automatic (re)compilation of PureScript projects"@@ -122,9 +131,12 @@ build :: MonadIO m => PureScript -> m CompilationOutput build PureScript{..} = shV $ errExit False $ do chdir (fromText pursPwdDir) $ do- let args = ["build", "-o", pursOutputDir] <> pursPsaOpts+ prependToPath (fromText pursPsPath)+ preBuildHook pursHooks+ let args = ["build", "-o", pursPwdDir <> "/" <> pursOutputDir] <> pursPsaOpts run_ (fromString . getPulpPath $ pursPulpPath) args eC <- lastExitCode+ preBuildHook pursHooks case (eC == 0) of True -> return CompilationSucceeded False -> CompilationFailed <$> lastStderr@@ -133,15 +145,18 @@ bundle :: MonadIO m => PureScript -> m CompilationOutput bundle PureScript{..} = liftIO $ shelly $ verbosely $ errExit False $ chdir (fromText pursPwdDir) $ do+ prependToPath (fromText pursPsPath) let bundlePath = pursOutputDir <> "/" <> pursBundleName case pursBundle of False -> return CompilationSucceeded True -> do+ preBundleHook pursHooks 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"])+ postBundleHook pursHooks eC <- lastExitCode case (eC == 0) of True -> return CompilationSucceeded@@ -152,7 +167,8 @@ compileWithMode = do mode <- gets pursCompilationMode case mode of- CompileOnce -> return CompilationSucceeded+ CompileNever -> return CompilationSucceeded+ CompileOnce -> return CompilationSucceeded CompileAlways -> do workDir <- gets pursPwdDir pursLog $ "Compiling Purescript project at " <> T.unpack workDir@@ -163,7 +179,8 @@ bundleWithMode _ = do mode <- gets pursCompilationMode case mode of- CompileOnce -> return CompilationSucceeded+ CompileOnce -> return CompilationSucceeded+ CompileNever -> return CompilationSucceeded CompileAlways -> do workDir <- gets pursPwdDir pursLog $ "Bundling Purescript project at " <> T.unpack workDir@@ -183,41 +200,59 @@ |] (T.unpack js) ---------------------------------------------------------------------------------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"- #- # Whether bundle everything in a fat app- #- bundle = %s- #- # The path to a specific, user-provided version of Pulp.- # Leave it uncommented if you plan to use the globally-installed one or you- # are OK with snaplet-purescript installing it for you.- #- # pulpPath = ""- #- # Extra options to pass to https://github.com/natefaubion/purescript-psa,- # if available.- psaOpts = []- #- permissiveInit = false- # Be lenient towards compilation errors in case the `pursInit` function- # initial compilation fails. Useful in devel mode to avoid your web server- # to not start at all when you are debugging your PS.- #- # The name of the output bundle- 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)+envCfgTemplate :: T.Text+envCfgTemplate = T.pack [r|+# Choose one between 'Verbose' and 'Quiet'+#+verbosity = "Verbose"+#+# Choose one between 'CompileOnce' and 'CompileAlways'+#+compilationMode = "CompileAlways"+#+# Whether bundle everything in a fat app+#+bundle = true+#+# The path to a specific directory containing the purescript toolchain.+# Example: snaplet/purs/node_modules/purescript/vendor.+# Leave it uncommented if you plan to use the globally-installed one.+#+# pureScriptPath = ""+#+# The path to a specific, user-provided version of Pulp.+# Leave it uncommented if you plan to use the globally-installed one or you+# are OK with snaplet-purescript installing it for you.+#+# pulpPath = ""+#+# Extra options to pass to https://github.com/natefaubion/purescript-psa,+# if available.+psaOpts = []+#+permissiveInit = false+# Be lenient towards compilation errors in case the `pursInit` function+# initial compilation fails. Useful in devel mode to avoid your web server+# to not start at all when you are debugging your PS.+#+# The name of the output bundle+bundleName = "app.js"+#+# The list of modules you want to compile under the PS namespace (bundle only)+# Adding 'Main' will make sure you will have something like PS.Main.main in+# your generated JS.+modules = ["Main"]+#+# Hooks - They are a way to invoke certain action during the snaplet lifecycle.+# They accept a shell command where the first token is the command itself,+# the rest are the parameters for the command. The entire hook section or each+# individual hook can be omitted.+hooks {+ preInit = "echo 'hello'"+ postInit = ""+ preBuild = ""+ postBuild = ""+ preBundle = ""+ postBundle = ""+}+|]
+ src/Snap/Snaplet/PureScript/Hooks.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}+module Snap.Snaplet.PureScript.Hooks (+ getHooks+ , Hook+ , Hooks(..)+ ) where++import Data.Configurator+import Data.Configurator.Types (Config)+import qualified Data.Text as T+import Shelly++--------------------------------------------------------------------------------+type Hook = Sh ()++--------------------------------------------------------------------------------+data Hooks = Hooks {+ preInitHook :: Hook+ , postInitHook :: Hook+ , preBuildHook :: Hook+ , postBuildHook :: Hook+ , preBundleHook :: Hook+ , postBundleHook :: Hook+ }++instance Show Hooks where+ show _ = "<<hooks>>"++--------------------------------------------------------------------------------+noOpHook :: Hook+noOpHook = return ()++--------------------------------------------------------------------------------+mkHook :: T.Text -> Hook+mkHook "" = noOpHook+mkHook t = case T.words t of+ [] -> noOpHook+ (x:args) -> run_ (fromText x) args++--------------------------------------------------------------------------------+getHooks :: Config -> IO Hooks+getHooks cfg =+ Hooks <$> (mkHook <$> lookupDefault "" cfg "hooks.preInit")+ <*> (mkHook <$> lookupDefault "" cfg "hooks.postInit")+ <*> (mkHook <$> lookupDefault "" cfg "hooks.preBuild")+ <*> (mkHook <$> lookupDefault "" cfg "hooks.postBuild")+ <*> (mkHook <$> lookupDefault "" cfg "hooks.preBundle")+ <*> (mkHook <$> lookupDefault "" cfg "hooks.postBundle")
src/Snap/Snaplet/PureScript/Internal.hs view
@@ -13,6 +13,7 @@ , getDestDir , getBowerFile , getAbsoluteOutputDir+ , prependToPath , findOrInstallPulp , shV , shS@@ -28,14 +29,17 @@ import Data.String import Data.String.Conv import qualified Data.Text as T+import qualified Shelly as Sh import Shelly hiding (FilePath) import Snap+import Snap.Snaplet.PureScript.Hooks (Hooks) import Text.Read hiding (String) -------------------------------------------------------------------------------- data CompilationMode = CompileOnce | CompileAlways- deriving (Show, Read)+ | CompileNever+ deriving (Show, Eq, Read) instance Configured CompilationMode where convert (String t) = readMaybe . T.unpack $ t@@ -72,12 +76,15 @@ , pursBundleName :: !T.Text -- ^ The name for your bundled output. , pursPulpPath :: !PulpPath- -- ^ The absolute path to the path executable. This can be user-provided+ -- ^ The absolute path to a `pulp` executable. This can be user-provided -- or inferred automatically by this snaplet.+ , pursPsPath :: !T.Text+ -- ^ The absolute path to the directory containing the PureScript toolchain.+ -- If not specified, this snaplet will use the globally installed PureScript. , pursPsaOpts :: [T.Text] -- ^ Extra options to pass to https://github.com/natefaubion/purescript-psa, -- if available.- , pursPermissiveInit :: Bool+ , pursPermissiveInit :: !Bool -- ^ Be lenient towards compilation errors in case the `pursInit` function -- initial compilation fails. Useful in devel mode to avoid your web server -- to not start at all when you are debugging your PS.@@ -86,7 +93,9 @@ , pursOutputDir :: !T.Text , pursModules :: ![T.Text] -- ^ Where to store compilation artifacts (defaults to /js)- }+ , pursHooks :: Hooks+ -- ^ Hooks to run at different times during the program execution+ } deriving Show -------------------------------------------------------------------------------- devFlagEnabled :: Bool@@ -106,16 +115,17 @@ shV = liftIO . shelly . verbosely . escaping False ---------------------------------------------------------------------------------findOrInstallPulp :: Maybe PulpPath+findOrInstallPulp :: T.Text+ -> Maybe PulpPath -> (Monad (m b v), MonadIO (m b v), MonadSnaplet m) => m b v PulpPath-findOrInstallPulp mbP = do+findOrInstallPulp psPath mbP = do let p = fromMaybe (PulpPath "pulp") mbP- installed <- shS (pulpInstalled p)+ installed <- shS (pulpInstalled psPath p) case installed of True -> return p False -> shS $ do- echo "Pulp not found, installing it for you..."+ echo "Pulp not found, installing it locally for you..." installPulp >> whichPulp --------------------------------------------------------------------------------@@ -123,16 +133,27 @@ whichPulp = PulpPath . toS . T.strip <$> shS (run "which" ["pulp"]) --------------------------------------------------------------------------------+-- | add the filepath onto the PATH env variable+prependToPath :: Sh.FilePath -> Sh ()+prependToPath fp = do+ tp <- toTextWarn fp+ pe <- get_env_text "PATH"+ setenv "PATH" $ tp <> T.singleton ':' <> pe++-------------------------------------------------------------------------------- installPulp :: MonadIO m => m ()-installPulp = shS $ run_ "npm" ["install", "-g", "pulp"]+installPulp = shS $ run_ "npm" ["install", "pulp"] ---------------------------------------------------------------------------------pulpInstalled :: PulpPath -> Sh Bool-pulpInstalled (PulpPath pp) = errExit False $ silently $ do- check `catchany_sh` \(_ :: SomeException) -> return False+pulpInstalled :: T.Text -> PulpPath -> Sh Bool+pulpInstalled psPath (PulpPath pp) = errExit False $ verbosely $ do+ check `catchany_sh` \(e :: SomeException) -> do+ echo (toS . show $ e)+ return False where check = do- run_ (fromString pp) ["version"]+ prependToPath (fromText psPath)+ run_ (fromString pp) ["--version"] eC <- lastExitCode return $ case eC of 0 -> True@@ -140,9 +161,12 @@ _ -> False ----------------------------------------------------------------------------------- | Returns the 'CompilationMode' the Snaplet should be using.--- It will default to 'CompileAlways' if your Snap app was compiled with--- -fdevelopment or the environment is "devel", 'CompileOnce' otherwise.+-- | Returns the `CompilationMode` the Snaplet should be using.+-- It will default to `CompileAlways` if your Snap app was compiled with+-- -fdevelopment or the environment is "devel", `CompileOnce` otherwise.+-- Consider using `CompileNever` if you do not want this snaplet to build+-- your .js bundle on the fly, for example if you have frozen its content and+-- you want to serve it straigth away in production. getCompilationFlavour :: Initializer b v CompilationMode getCompilationFlavour = do -- Any input for the user have highest priority