Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

106 lines (86 sloc) 3.239 kb
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS -fno-warn-name-shadowing #-}
module Snap.Snaplet.Fay (
CompileMethod (..)
, Fay
, initFay
, fayServe
) where
import Control.Monad
import Control.Monad.Reader
import Control.Monad.State.Class
import Control.Monad.Trans.Writer
import qualified Data.ByteString.Char8 as BS
import qualified Data.Configurator as C
import Data.List
import Data.Maybe
import Data.String
import Snap.Core
import Snap.Snaplet
import Snap.Util.FileServe
import System.Directory
import System.FilePath
import Paths_snaplet_fay
import Snap.Snaplet.Fay.Internal
methodFromString :: String -> Maybe CompileMethod
methodFromString "CompileOnDemand" = Just CompileOnDemand
methodFromString "CompileAll" = Just CompileAll
methodFromString _ = Nothing
-- | Snaplet initialization
initFay :: SnapletInit b Fay
initFay = makeSnaplet "fay" description datadir $ do
config <- getSnapletUserConfig
fp <- getSnapletFilePath
(opts, errs) <- runWriterT $ do
compileMethodStr <- logErr "Must specify compileMethod" $ C.lookup config "compileMethod"
compileMethod <- case compileMethodStr of
Just x -> logErr "Invalid compileMethod" . return $ methodFromString x
Nothing -> return Nothing
verbose <- logErr "Must specify verbose" $ C.lookup config "verbose"
return (verbose, compileMethod)
let fay = case opts of
(Just verbose, Just compileMethod) ->
Fay (toSrcDir fp) (toDestDir fp) [toSrcDir fp] verbose compileMethod
_ -> error $ intercalate "\n" errs
liftIO $ do
-- Create the snaplet directory
dirExists <- doesDirectoryExist fp
unless dirExists $ createDirectory fp
-- Create the src directory
dirExists <- doesDirectoryExist $ toSrcDir fp
unless dirExists . createDirectory $ toSrcDir fp
-- Create the js directory
dirExists <- doesDirectoryExist (toDestDir fp)
unless dirExists $ createDirectory (toDestDir fp)
return fay
where
datadir = Just $ liftM (++ "/resources") getDataDir
description = "Automatic (re)compilation and serving of Fay 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
toSrcDir :: FilePath -> FilePath
toSrcDir = (</> "src")
toDestDir :: FilePath -> FilePath
toDestDir = (</> "js")
-- | Serves the compiled Fay scripts
fayServe :: Handler b Fay ()
fayServe = do
cfg <- get
compileWithMethod (compileMethod cfg)
compileWithMethod :: CompileMethod -> Handler b Fay ()
compileWithMethod CompileOnDemand = do
cfg <- get
req <- getRequest
let uri = srcDir cfg </> (toHsName . filename . BS.unpack . rqURI) req
res <- liftIO (compileFile cfg uri)
case res of
Just s -> writeLBS $ fromString s
Nothing -> return ()
compileWithMethod CompileAll = do
cfg <- get
liftIO (compileAll cfg)
serveDirectory (destDir cfg)
Jump to Line
Something went wrong with that request. Please try again.