module Snap.Snaplet.Sass (
Sass
, initSass
, sassServe
) where
import Control.Monad
import Control.Monad.Reader
import Control.Monad.State.Class
import Control.Monad.Trans.Writer
import Data.Char (toLower)
import qualified Data.Configurator as C
import Data.List (intercalate)
import Data.Maybe (isNothing)
import Snap.Core (modifyResponse, setContentType)
import Snap.Snaplet
import Snap.Util.FileServe
import System.Process (rawSystem)
import Paths_snaplet_sass
import Snap.Snaplet.Sass.Internal
initSass :: SnapletInit b Sass
initSass = makeSnaplet "sass" description datadir $ do
config <- getSnapletUserConfig
fp <- getSnapletFilePath
(opts, errs) <- runWriterT $ do
cmStr <- logErr "Must specify compileMode" $ C.lookup config "compileMode"
cm <- case cmStr of
Just x -> logErr "Invalid compileMode" . return $ compileModeFromString x
Nothing -> return Nothing
stStr <- logErr "Must specify style" $ C.lookup config "style"
st <- case stStr of
Just x -> logErr "Invalid style" . return $ styleFromString x
Nothing -> return Nothing
sm <- logErr "Must specify sourcemap" $ C.lookup config "sourcemap"
v <- logErr "Must specify verbose" $ C.lookup config "verbose"
return (cm, st, sm, v)
let sass = case opts of
(Just cm, Just st, Just sm, Just v) ->
Sass
{ snapletFilePath = fp
, compileMode = cm
, style = st
, sourcemap = sm
, verbose = v
}
_ -> error $ intercalate "\n" errs
liftIO $ mapM_ createDirUnlessExists [fp, srcDir sass, destDir sass]
when (Production == compileMode sass) (liftIO $ compileAll sass)
return sass
where
datadir = Just $ liftM (++ "/resources") getDataDir
description = "Automatic (re)compilation and serving of Sass files"
logErr :: MonadIO m => t -> IO (Maybe a) -> WriterT [t] m (Maybe a)
logErr err m = do
res <- liftIO m
when (isNothing res) (tell [err])
return res
sassServe :: Handler b Sass ()
sassServe = do
modifyResponse . setContentType $ "text/css;charset=utf-8"
get >>= compileWithMode . compileMode
compileWithMode :: CompileMode -> Handler b Sass ()
compileWithMode Development = do
config <- get
compileAll config
compileWithMode Production
compileWithMode Production = get >>= serveDirectory . destDir
compileAll :: MonadIO m => Sass -> m ()
compileAll cfg = liftIO $ compile >> return ()
where
compile = verboseLog >> rawSystem "sass" args
verboseLog = verbosePut cfg $ "compiling " ++ srcDir cfg
args = ["--update", ioDirs, "--style", st] ++ sm
ioDirs = srcDir cfg ++ ":" ++ destDir cfg
sm = if sourcemap cfg then ["--sourcemap"] else []
st = map toLower . show $ style cfg