606 lines
21 KiB
Haskell
606 lines
21 KiB
Haskell
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
---------------------------------------------------------
|
|
--
|
|
-- | Serve static files from a Yesod app.
|
|
--
|
|
-- This is great for developing your application, but also for a
|
|
-- dead-simple deployment. Caching headers are automatically
|
|
-- taken care of.
|
|
--
|
|
-- If you are running a proxy server (like Apache or Nginx),
|
|
-- you may want to have that server do the static serving instead.
|
|
--
|
|
-- In fact, in an ideal setup you'll serve your static files from
|
|
-- a separate domain name to save time on transmitting
|
|
-- cookies. In that case, you may wish to use 'urlParamRenderOverride'
|
|
-- to redirect requests to this subsite to a separate domain
|
|
-- name.
|
|
--
|
|
-- Note that this module's static subsite ignores all files and
|
|
-- directories that are hidden by Unix conventions (i.e. start
|
|
-- with a dot, such as @\".ssh\"@) and the directory "tmp" on the
|
|
-- root of the directory with static files.
|
|
module Yesod.Static
|
|
( -- * Subsite
|
|
Static (..)
|
|
, Route (..)
|
|
, StaticRoute
|
|
-- * Smart constructor
|
|
, static
|
|
, staticDevel
|
|
-- * Combining CSS/JS
|
|
-- $combining
|
|
, combineStylesheets'
|
|
, combineScripts'
|
|
-- ** Settings
|
|
, CombineSettings
|
|
, csStaticDir
|
|
, csCssPostProcess
|
|
, csJsPostProcess
|
|
, csCssPreProcess
|
|
, csJsPreProcess
|
|
, csCombinedFolder
|
|
-- * Template Haskell helpers
|
|
, staticFiles
|
|
, staticFilesList
|
|
, staticFilesMap
|
|
, staticFilesMergeMap
|
|
, publicFiles
|
|
-- * Hashing
|
|
, base64md5
|
|
-- * Embed
|
|
, embed
|
|
#ifdef TEST_EXPORT
|
|
, getFileListPieces
|
|
#endif
|
|
) where
|
|
|
|
import System.Directory
|
|
import qualified System.FilePath as FP
|
|
import Control.Monad
|
|
import Data.FileEmbed (embedDir)
|
|
|
|
import Yesod.Core
|
|
import Yesod.Core.Types
|
|
|
|
import Data.List (intercalate)
|
|
import Language.Haskell.TH
|
|
import Language.Haskell.TH.Syntax as TH
|
|
|
|
import Crypto.Hash.Conduit (hashFile, sinkHash)
|
|
import Crypto.Hash (MD5, Digest)
|
|
import Control.Monad.Trans.State
|
|
|
|
import qualified Data.ByteArray as ByteArray
|
|
import qualified Data.ByteString.Base64
|
|
import qualified Data.ByteString.Char8 as S8
|
|
import qualified Data.ByteString.Lazy as L
|
|
import Data.Text (Text, pack)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Map as M
|
|
import Data.IORef (readIORef, newIORef, writeIORef)
|
|
import Data.Char (isLower, isDigit)
|
|
import Data.List (foldl')
|
|
import qualified Data.ByteString as S
|
|
import System.PosixCompat.Files (getFileStatus, modificationTime)
|
|
import System.Posix.Types (EpochTime)
|
|
import Conduit
|
|
import System.FilePath ((</>), (<.>), takeDirectory)
|
|
import qualified System.FilePath as F
|
|
import qualified Data.Text.Lazy as TL
|
|
import qualified Data.Text.Lazy.Encoding as TLE
|
|
import Data.Default
|
|
--import Text.Lucius (luciusRTMinified)
|
|
|
|
import Network.Wai (pathInfo)
|
|
import Network.Wai.Application.Static
|
|
( StaticSettings (..)
|
|
, staticApp
|
|
, webAppSettingsWithLookup
|
|
, embeddedSettings
|
|
)
|
|
import WaiAppStatic.Storage.Filesystem (ETagLookup)
|
|
|
|
-- | Type used for the subsite with static contents.
|
|
newtype Static = Static StaticSettings
|
|
|
|
type StaticRoute = Route Static
|
|
|
|
-- | Produce a default value of 'Static' for a given file
|
|
-- folder.
|
|
--
|
|
-- Does not have index files or directory listings. The static
|
|
-- files' contents /must not/ change, however new files can be
|
|
-- added.
|
|
static :: FilePath -> IO Static
|
|
static dir = do
|
|
hashLookup <- cachedETagLookup dir
|
|
return $ Static $ webAppSettingsWithLookup dir hashLookup
|
|
|
|
-- | Same as 'static', but does not assumes that the files do not
|
|
-- change and checks their modification time whenever a request
|
|
-- is made.
|
|
staticDevel :: FilePath -> IO Static
|
|
staticDevel dir = do
|
|
hashLookup <- cachedETagLookupDevel dir
|
|
return $ Static $ webAppSettingsWithLookup dir hashLookup
|
|
|
|
-- | Produce a 'Static' based on embedding all of the static files' contents in the
|
|
-- executable at compile time.
|
|
--
|
|
-- You should use "Yesod.EmbeddedStatic" instead, it is much more powerful.
|
|
--
|
|
-- Nota Bene: if you replace the scaffolded 'static' call in Settings/StaticFiles.hs
|
|
-- you will need to change the scaffolded addStaticContent. Otherwise, some of your
|
|
-- assets will be 404'ed. This is because by default yesod will generate compile those
|
|
-- assets to @static/tmp@ which for 'static' is fine since they are served out of the
|
|
-- directory itself. With embedded static, that will not work.
|
|
-- You can easily change @addStaticContent@ to @\_ _ _ -> return Nothing@ as a workaround.
|
|
-- This will cause yesod to embed those assets into the generated HTML file itself.
|
|
embed :: FilePath -> Q Exp
|
|
embed fp = [|Static (embeddedSettings $(embedDir fp))|]
|
|
|
|
instance RenderRoute Static where
|
|
-- | A route on the static subsite (see also 'staticFiles').
|
|
--
|
|
-- You may use this constructor directly to manually link to a
|
|
-- static file. The first argument is the sub-path to the file
|
|
-- being served whereas the second argument is the key-value
|
|
-- pairs in the query string. For example,
|
|
--
|
|
-- > StaticRoute $ StaticR [\"thumb001.jpg\"] [(\"foo\", \"5\"), (\"bar\", \"choc\")]
|
|
--
|
|
-- would generate a url such as
|
|
-- @http://www.example.com/static/thumb001.jpg?foo=5&bar=choc@
|
|
-- The StaticRoute constructor can be used when the URL cannot be
|
|
-- statically generated at compile-time (e.g. when generating
|
|
-- image galleries).
|
|
data Route Static = StaticRoute [Text] [(Text, Text)]
|
|
deriving (Eq, Show, Read)
|
|
renderRoute (StaticRoute x y) = (x, y)
|
|
instance ParseRoute Static where
|
|
parseRoute (x, y) = Just $ StaticRoute x y
|
|
|
|
instance YesodSubDispatch Static master where
|
|
yesodSubDispatch YesodSubRunnerEnv {..} req =
|
|
ysreParentRunner handlert ysreParentEnv (fmap ysreToParentRoute route) req
|
|
where
|
|
route = Just $ StaticRoute (pathInfo req) []
|
|
|
|
Static set = ysreGetSub $ yreSite $ ysreParentEnv
|
|
handlert = sendWaiApplication $ staticApp set
|
|
|
|
notHidden :: FilePath -> Bool
|
|
notHidden "tmp" = False
|
|
notHidden s =
|
|
case s of
|
|
'.':_ -> False
|
|
_ -> True
|
|
|
|
getFileListPieces :: FilePath -> IO [[String]]
|
|
getFileListPieces = flip evalStateT M.empty . flip go id
|
|
where
|
|
go :: String
|
|
-> ([String] -> [String])
|
|
-> StateT (M.Map String String) IO [[String]]
|
|
go fp front = do
|
|
allContents <- liftIO $ filter notHidden `fmap` getDirectoryContents fp
|
|
let fullPath :: String -> String
|
|
fullPath f = fp ++ '/' : f
|
|
files <- liftIO $ filterM (doesFileExist . fullPath) allContents
|
|
let files' = map (front . return) files
|
|
files'' <- mapM dedupe files'
|
|
dirs <- liftIO $ filterM (doesDirectoryExist . fullPath) allContents
|
|
dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs
|
|
return $ concat $ files'' : dirs'
|
|
|
|
-- Reuse data buffers for identical strings
|
|
dedupe :: [String] -> StateT (M.Map String String) IO [String]
|
|
dedupe = mapM dedupe'
|
|
|
|
dedupe' :: String -> StateT (M.Map String String) IO String
|
|
dedupe' s = do
|
|
m <- get
|
|
case M.lookup s m of
|
|
Just s' -> return s'
|
|
Nothing -> do
|
|
put $ M.insert s s m
|
|
return s
|
|
|
|
-- | Template Haskell function that automatically creates routes
|
|
-- for all of your static files.
|
|
--
|
|
-- For example, if you used
|
|
--
|
|
-- > staticFiles "static/"
|
|
--
|
|
-- and you had files @\"static\/style.css\"@ and
|
|
-- @\"static\/js\/script.js\"@, then the following top-level
|
|
-- definitions would be created:
|
|
--
|
|
-- > style_css = StaticRoute ["style.css"] []
|
|
-- > js_script_js = StaticRoute ["js", "script.js"] []
|
|
--
|
|
-- Note that dots (@.@), dashes (@-@) and slashes (@\/@) are
|
|
-- replaced by underscores (@\_@) to create valid Haskell
|
|
-- identifiers.
|
|
staticFiles :: FilePath -> Q [Dec]
|
|
staticFiles dir = mkStaticFiles dir
|
|
|
|
-- | Same as 'staticFiles', but takes an explicit list of files
|
|
-- to create identifiers for. The files path given are relative
|
|
-- to the static folder. For example, to create routes for the
|
|
-- files @\"static\/js\/jquery.js\"@ and
|
|
-- @\"static\/css\/normalize.css\"@, you would use:
|
|
--
|
|
-- > staticFilesList "static" ["js/jquery.js", "css/normalize.css"]
|
|
--
|
|
-- This can be useful when you have a very large number of static
|
|
-- files, but only need to refer to a few of them from Haskell.
|
|
staticFilesList :: FilePath -> [FilePath] -> Q [Dec]
|
|
staticFilesList dir fs =
|
|
mkStaticFilesList dir (map split fs) True
|
|
where
|
|
split :: FilePath -> [String]
|
|
split [] = []
|
|
split x =
|
|
let (a, b) = break (== '/') x
|
|
in a : split (drop 1 b)
|
|
|
|
-- | Same as 'staticFiles', but doesn't append an ETag to the
|
|
-- query string.
|
|
--
|
|
-- Using 'publicFiles' will speed up the compilation, since there
|
|
-- won't be any need for hashing files during compile-time.
|
|
-- However, since the ETag ceases to be part of the URL, the
|
|
-- 'Static' subsite won't be able to set the expire date too far
|
|
-- on the future. Browsers still will be able to cache the
|
|
-- contents, however they'll need send a request to the server to
|
|
-- see if their copy is up-to-date.
|
|
publicFiles :: FilePath -> Q [Dec]
|
|
publicFiles dir = mkStaticFiles' dir False
|
|
|
|
-- | Similar to 'staticFilesList', but takes a mapping of
|
|
-- unmunged names to fingerprinted file names.
|
|
--
|
|
-- @since 1.5.3
|
|
staticFilesMap :: FilePath -> M.Map FilePath FilePath -> Q [Dec]
|
|
staticFilesMap fp m = mkStaticFilesList' fp (map splitBoth mapList) True
|
|
where
|
|
splitBoth (k, v) = (split k, split v)
|
|
mapList = M.toList m
|
|
split :: FilePath -> [String]
|
|
split [] = []
|
|
split x =
|
|
let (a, b) = break (== '/') x
|
|
in a : split (drop 1 b)
|
|
|
|
-- | Similar to 'staticFilesMergeMap', but also generates identifiers
|
|
-- for all files in the specified directory that don't have a
|
|
-- fingerprinted version.
|
|
--
|
|
-- @since 1.5.3
|
|
staticFilesMergeMap :: FilePath -> M.Map FilePath FilePath -> Q [Dec]
|
|
staticFilesMergeMap fp m = do
|
|
fs <- qRunIO $ getFileListPieces fp
|
|
let filesList = map FP.joinPath fs
|
|
mergedMapList = M.toList $ foldl' (checkedInsert invertedMap) m filesList
|
|
mkStaticFilesList' fp (map splitBoth mergedMapList) True
|
|
where
|
|
splitBoth (k, v) = (split k, split v)
|
|
swap (x, y) = (y, x)
|
|
mapList = M.toList m
|
|
invertedMap = M.fromList $ map swap mapList
|
|
split :: FilePath -> [String]
|
|
split [] = []
|
|
split x =
|
|
let (a, b) = break (== '/') x
|
|
in a : split (drop 1 b)
|
|
-- We want to keep mappings for all files that are pre-fingerprinted,
|
|
-- so this function checks against all of the existing fingerprinted files and
|
|
-- only inserts a new mapping if it's not a fingerprinted file.
|
|
checkedInsert
|
|
:: M.Map FilePath FilePath -- inverted dictionary
|
|
-> M.Map FilePath FilePath -- accumulating state
|
|
-> FilePath
|
|
-> M.Map FilePath FilePath
|
|
checkedInsert iDict st p = if M.member p iDict
|
|
then st
|
|
else M.insert p p st
|
|
|
|
mkHashMap :: FilePath -> IO (M.Map FilePath S8.ByteString)
|
|
mkHashMap dir = do
|
|
fs <- getFileListPieces dir
|
|
hashAlist fs >>= return . M.fromList
|
|
where
|
|
hashAlist :: [[String]] -> IO [(FilePath, S8.ByteString)]
|
|
hashAlist fs = mapM hashPair fs
|
|
where
|
|
hashPair :: [String] -> IO (FilePath, S8.ByteString)
|
|
hashPair pieces = do let file = pathFromRawPieces dir pieces
|
|
h <- base64md5File file
|
|
return (file, S8.pack h)
|
|
|
|
pathFromRawPieces :: FilePath -> [String] -> FilePath
|
|
pathFromRawPieces =
|
|
foldl' append
|
|
where
|
|
append a b = a ++ '/' : b
|
|
|
|
cachedETagLookupDevel :: FilePath -> IO ETagLookup
|
|
cachedETagLookupDevel dir = do
|
|
etags <- mkHashMap dir
|
|
mtimeVar <- newIORef (M.empty :: M.Map FilePath EpochTime)
|
|
return $ \f ->
|
|
case M.lookup f etags of
|
|
Nothing -> return Nothing
|
|
Just checksum -> do
|
|
fs <- getFileStatus f
|
|
let newt = modificationTime fs
|
|
mtimes <- readIORef mtimeVar
|
|
oldt <- case M.lookup f mtimes of
|
|
Nothing -> writeIORef mtimeVar (M.insert f newt mtimes) >> return newt
|
|
Just oldt -> return oldt
|
|
return $ if newt /= oldt then Nothing else Just checksum
|
|
|
|
|
|
cachedETagLookup :: FilePath -> IO ETagLookup
|
|
cachedETagLookup dir = do
|
|
etags <- mkHashMap dir
|
|
return $ (\f -> return $ M.lookup f etags)
|
|
|
|
mkStaticFiles :: FilePath -> Q [Dec]
|
|
mkStaticFiles fp = mkStaticFiles' fp True
|
|
|
|
mkStaticFiles' :: FilePath -- ^ static directory
|
|
-> Bool -- ^ append checksum query parameter
|
|
-> Q [Dec]
|
|
mkStaticFiles' fp makeHash = do
|
|
fs <- qRunIO $ getFileListPieces fp
|
|
mkStaticFilesList fp fs makeHash
|
|
|
|
mkStaticFilesList
|
|
:: FilePath -- ^ static directory
|
|
-> [[String]] -- ^ list of files to create identifiers for
|
|
-> Bool -- ^ append checksum query parameter
|
|
-> Q [Dec]
|
|
mkStaticFilesList fp fs makeHash = mkStaticFilesList' fp (zip fs fs) makeHash
|
|
|
|
mkStaticFilesList'
|
|
:: FilePath -- ^ static directory
|
|
-> [([String], [String])] -- ^ list of files to create identifiers for, where
|
|
-- the first argument of the tuple is the identifier
|
|
-- alias and the second is the actual file name
|
|
-> Bool -- ^ append checksum query parameter
|
|
-> Q [Dec]
|
|
mkStaticFilesList' fp fs makeHash = do
|
|
concat `fmap` mapM mkRoute fs
|
|
where
|
|
replace' c
|
|
| 'A' <= c && c <= 'Z' = c
|
|
| 'a' <= c && c <= 'z' = c
|
|
| '0' <= c && c <= '9' = c
|
|
| otherwise = '_'
|
|
mkRoute (alias, f) = do
|
|
let name' = intercalate "_" $ map (map replace') alias
|
|
routeName = mkName $
|
|
case () of
|
|
()
|
|
| null name' -> error "null-named file"
|
|
| isDigit (head name') -> '_' : name'
|
|
| isLower (head name') -> name'
|
|
| otherwise -> '_' : name'
|
|
f' <- [|map pack $(TH.lift f)|]
|
|
qs <- if makeHash
|
|
then do hash <- qRunIO $ base64md5File $ pathFromRawPieces fp f
|
|
[|[(pack "etag", pack $(TH.lift hash))]|]
|
|
else return $ ListE []
|
|
return
|
|
[ SigD routeName $ ConT ''StaticRoute
|
|
, FunD routeName
|
|
[ Clause [] (NormalB $ (ConE 'StaticRoute) `AppE` f' `AppE` qs) []
|
|
]
|
|
]
|
|
|
|
base64md5File :: FilePath -> IO String
|
|
base64md5File = fmap (base64 . encode) . hashFile
|
|
where encode d = ByteArray.convert (d :: Digest MD5)
|
|
|
|
base64md5 :: L.ByteString -> String
|
|
base64md5 lbs =
|
|
base64 $ encode
|
|
$ runConduitPure
|
|
$ Conduit.sourceLazy lbs .| sinkHash
|
|
where
|
|
encode d = ByteArray.convert (d :: Digest MD5)
|
|
|
|
base64 :: S.ByteString -> String
|
|
base64 = map tr
|
|
. take 8
|
|
. S8.unpack
|
|
. Data.ByteString.Base64.encode
|
|
where
|
|
tr '+' = '-'
|
|
tr '/' = '_'
|
|
tr c = c
|
|
|
|
-- $combining
|
|
--
|
|
-- A common scenario on a site is the desire to include many external CSS and
|
|
-- Javascript files on every page. Doing so via the Widget functionality in
|
|
-- Yesod will work, but would also mean that the same content will be
|
|
-- downloaded many times. A better approach would be to combine all of these
|
|
-- files together into a single static file and serve that as a static resource
|
|
-- for every page. That resource can be cached on the client, and bandwidth
|
|
-- usage reduced.
|
|
--
|
|
-- This could be done as a manual process, but that becomes tedious. Instead,
|
|
-- you can use some Template Haskell code which will combine these files into a
|
|
-- single static file at compile time.
|
|
|
|
data CombineType = JS | CSS
|
|
|
|
combineStatics' :: CombineType
|
|
-> CombineSettings
|
|
-> [Route Static] -- ^ files to combine
|
|
-> Q Exp
|
|
combineStatics' combineType CombineSettings {..} routes = do
|
|
texts <- qRunIO $ runConduitRes
|
|
$ yieldMany fps
|
|
.| awaitForever readUTFFile
|
|
.| sinkLazy
|
|
ltext <- qRunIO $ preProcess texts
|
|
bs <- qRunIO $ postProcess fps $ TLE.encodeUtf8 ltext
|
|
let hash' = base64md5 bs
|
|
suffix = csCombinedFolder </> hash' <.> extension
|
|
fp = csStaticDir </> suffix
|
|
qRunIO $ do
|
|
createDirectoryIfMissing True $ takeDirectory fp
|
|
L.writeFile fp bs
|
|
let pieces = map T.unpack $ T.splitOn "/" $ T.pack suffix
|
|
[|StaticRoute (map pack pieces) []|]
|
|
where
|
|
fps :: [FilePath]
|
|
fps = map toFP routes
|
|
toFP (StaticRoute pieces _) = csStaticDir </> F.joinPath (map T.unpack pieces)
|
|
readUTFFile fp = sourceFile fp .| decodeUtf8C
|
|
postProcess =
|
|
case combineType of
|
|
JS -> csJsPostProcess
|
|
CSS -> csCssPostProcess
|
|
preProcess =
|
|
case combineType of
|
|
JS -> csJsPreProcess
|
|
CSS -> csCssPreProcess
|
|
extension =
|
|
case combineType of
|
|
JS -> "js"
|
|
CSS -> "css"
|
|
|
|
-- | Data type for holding all settings for combining files.
|
|
--
|
|
-- This data type is a settings type. For more information, see:
|
|
--
|
|
-- <http://www.yesodweb.com/book/settings-types>
|
|
--
|
|
-- Since 1.2.0
|
|
data CombineSettings = CombineSettings
|
|
{ csStaticDir :: FilePath
|
|
-- ^ File path containing static files.
|
|
--
|
|
-- Default: static
|
|
--
|
|
-- Since 1.2.0
|
|
, csCssPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString
|
|
-- ^ Post processing to be performed on CSS files.
|
|
--
|
|
-- Default: Pass-through.
|
|
--
|
|
-- Since 1.2.0
|
|
, csJsPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString
|
|
-- ^ Post processing to be performed on Javascript files.
|
|
--
|
|
-- Default: Pass-through.
|
|
--
|
|
-- Since 1.2.0
|
|
, csCssPreProcess :: TL.Text -> IO TL.Text
|
|
-- ^ Pre-processing to be performed on CSS files.
|
|
--
|
|
-- Default: convert all occurences of /static/ to ../
|
|
--
|
|
-- Since 1.2.0
|
|
, csJsPreProcess :: TL.Text -> IO TL.Text
|
|
-- ^ Pre-processing to be performed on Javascript files.
|
|
--
|
|
-- Default: Pass-through.
|
|
--
|
|
-- Since 1.2.0
|
|
, csCombinedFolder :: FilePath
|
|
-- ^ Subfolder to put combined files into.
|
|
--
|
|
-- Default: combined
|
|
--
|
|
-- Since 1.2.0
|
|
}
|
|
|
|
instance Default CombineSettings where
|
|
def = CombineSettings
|
|
{ csStaticDir = "static"
|
|
{- Disabled due to: https://github.com/yesodweb/yesod/issues/623
|
|
, csCssPostProcess = \fps ->
|
|
either (error . (errorIntro fps)) (return . TLE.encodeUtf8)
|
|
. flip luciusRTMinified []
|
|
. TLE.decodeUtf8
|
|
-}
|
|
, csCssPostProcess = const return
|
|
, csJsPostProcess = const return
|
|
-- FIXME The following borders on a hack. With combining of files,
|
|
-- the final location of the CSS is no longer fixed, so relative
|
|
-- references will break. Instead, we switched to using /static/
|
|
-- absolute references. However, when served from a separate domain
|
|
-- name, this will break too. The solution is that, during
|
|
-- development, we keep /static/, and in the combining phase, we
|
|
-- replace /static with a relative reference to the parent folder.
|
|
, csCssPreProcess =
|
|
return
|
|
. TL.replace "'/static/" "'../"
|
|
. TL.replace "\"/static/" "\"../"
|
|
, csJsPreProcess = return
|
|
, csCombinedFolder = "combined"
|
|
}
|
|
|
|
liftRoutes :: [Route Static] -> Q Exp
|
|
liftRoutes =
|
|
fmap ListE . mapM go
|
|
where
|
|
go :: Route Static -> Q Exp
|
|
go (StaticRoute x y) = [|StaticRoute $(liftTexts x) $(liftPairs y)|]
|
|
|
|
liftTexts = fmap ListE . mapM liftT
|
|
liftT t = [|pack $(TH.lift $ T.unpack t)|]
|
|
|
|
liftPairs = fmap ListE . mapM liftPair
|
|
liftPair (x, y) = [|($(liftT x), $(liftT y))|]
|
|
|
|
-- | Combine multiple CSS files together. Common usage would be:
|
|
--
|
|
-- >>> combineStylesheets' development def 'StaticR [style1_css, style2_css]
|
|
--
|
|
-- Where @development@ is a variable in your site indicated whether you are in
|
|
-- development or production mode.
|
|
--
|
|
-- Since 1.2.0
|
|
combineStylesheets' :: Bool -- ^ development? if so, perform no combining
|
|
-> CombineSettings
|
|
-> Name -- ^ Static route constructor name, e.g. \'StaticR
|
|
-> [Route Static] -- ^ files to combine
|
|
-> Q Exp
|
|
combineStylesheets' development cs con routes
|
|
| development = [| mapM_ (addStylesheet . $(return $ ConE con)) $(liftRoutes routes) |]
|
|
| otherwise = [| addStylesheet $ $(return $ ConE con) $(combineStatics' CSS cs routes) |]
|
|
|
|
|
|
-- | Combine multiple JS files together. Common usage would be:
|
|
--
|
|
-- >>> combineScripts' development def 'StaticR [script1_js, script2_js]
|
|
--
|
|
-- Where @development@ is a variable in your site indicated whether you are in
|
|
-- development or production mode.
|
|
--
|
|
-- Since 1.2.0
|
|
combineScripts' :: Bool -- ^ development? if so, perform no combining
|
|
-> CombineSettings
|
|
-> Name -- ^ Static route constructor name, e.g. \'StaticR
|
|
-> [Route Static] -- ^ files to combine
|
|
-> Q Exp
|
|
combineScripts' development cs con routes
|
|
| development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |]
|
|
| otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]
|