Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

107 lines (87 sloc) 3.28 kB
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# 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.