snaplet-purescript (empty) → 0.1.0.0

raw patch · 5 files changed

+208/−0 lines, 5 filesdep +basedep +configuratordep +mtlsetup-changed

Dependencies added: base, configurator, mtl, raw-strings-qq, shelly, snap, snap-core, text

Files

• LICENSE +0/−0
• Setup.hs +2/−0
• snaplet-purescript.cabal +29/−0
• src/Snap/Snaplet/PureScript.hs +110/−0
• src/Snap/Snaplet/PureScript/Internal.hs +67/−0

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,29 @@+name:                snaplet-purescript+version:             0.1.0.0+synopsis:            Automatic (re)compilation of purescript projects+license:             MIT+license-file:        LICENSE+author:              Alfredo Di Napoli+maintainer:          alfredo.dinapoli@gmail.com+category:            Web+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:+    Snap.Snaplet.PureScript+  other-modules:+    Snap.Snaplet.PureScript.Internal+    Paths_snaplet_purescript+  build-depends:+    base >=4.6 && < 5.0,+    snap-core < 1.0.0.0,+    snap < 1.0.0.0,+    raw-strings-qq >= 1.0.2,+    text > 0.11 && < 1.2.0.0,+    mtl < 2.3,+    configurator >= 0.2.0.0,+    shelly >= 0.4.1 && < 1.7+  hs-source-dirs:+    src+  default-language:    Haskell2010

@@ -0,0 +1,110 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+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++--------------------------------------------------------------------------------+-- | Snaplet initialization+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")+  -- If they do not exist, create the required directories+  shelly $ silently $ do+    mapM_ mkdir_p [jsDir, srcDir]+    gruntFileExists <- test_f gruntfile+    envCfgExists <- test_f envCfg+    unless gruntFileExists $ writefile gruntfile (gruntTemplate buildDir)+    unless envCfgExists $ touchfile envCfg++  -- compile at least once, regardless of the CompilationMode+  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+  -- Now get the requested file and try to serve it+  -- This returns something like /purs/Hello/index.js+  -- TODO: Temporary: Strip "purs"+  requestedJs <- T.drop 5 . TE.decodeUtf8 . rqURI <$> getRequest+  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"]);+  };+|]

@@ -0,0 +1,67 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+module Snap.Snaplet.PureScript.Internal where++import           Snap+import           Data.Monoid+import           Data.Configurator.Types+import           Text.Read hiding (String)+import qualified Data.Text as T++--------------------------------------------------------------------------------+data CompilationMode =+      CompileOnce+    | CompileAlways+    deriving Show++data Verbosity = Verbose | Quiet deriving (Show, Read, Eq)++instance Configured Verbosity where+  convert (String t) = readMaybe . T.unpack $ t+  convert _ = Nothing++--------------------------------------------------------------------------------+data PureScript = PureScript {+    pursCompilationMode :: CompilationMode+  , pursVerbosity :: Verbosity+  }++--------------------------------------------------------------------------------+-- | TODO: This doesn't seem to work, but I do not want to +-- spend all my time on this now.+devFlagEnabled :: Bool+devFlagEnabled =+#if defined(DEVELOPMENT)+  True+#else+  False+#endif++--------------------------------------------------------------------------------+-- | 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.+getCompilationFlavour :: Initializer b v CompilationMode+getCompilationFlavour = do+ inDevelMode <- ("devel" ==) <$> getEnvironment+ return $ if or [inDevelMode, devFlagEnabled]+            then CompileAlways+            else CompileOnce++--------------------------------------------------------------------------------+getDestDir :: (Monad (m b v), MonadIO (m b v), MonadSnaplet m) => m b v T.Text+getDestDir = do+  fp <- getSnapletFilePath+  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++--------------------------------------------------------------------------------+getGruntfile :: (Monad (m b v), MonadIO (m b v), MonadSnaplet m) => m b v T.Text+getGruntfile = return . (`mappend` "/Gruntfile.js") =<< getDestDir