598 lines
23 KiB
Diff
598 lines
23 KiB
Diff
|
From ad0166a6e537021c9f5a1e01cde4b7c520edcf3a Mon Sep 17 00:00:00 2001
|
||
|
|
From: Joey Hess <joey@kitenet.net>
|
||
|
|
Date: Wed, 18 Dec 2013 05:10:59 +0000
|
||
|
|
Subject: [PATCH] remove TH
|
||
|
|
|
||
|
|
---
|
||
|
|
Yesod/EmbeddedStatic.hs | 64 -----------
|
||
|
|
Yesod/EmbeddedStatic/Generators.hs | 102 +----------------
|
||
|
|
Yesod/EmbeddedStatic/Internal.hs | 41 -------
|
||
|
|
Yesod/EmbeddedStatic/Types.hs | 14 ---
|
||
|
|
Yesod/Static.hs | 224 +------------------------------------
|
||
|
|
5 files changed, 12 insertions(+), 433 deletions(-)
|
||
|
|
|
||
|
|
diff --git a/Yesod/EmbeddedStatic.hs b/Yesod/EmbeddedStatic.hs
|
||
|
|
index e819630..a564d4b 100644
|
||
|
|
--- a/Yesod/EmbeddedStatic.hs
|
||
|
|
+++ b/Yesod/EmbeddedStatic.hs
|
||
|
|
@@ -41,7 +41,6 @@ module Yesod.EmbeddedStatic (
|
||
|
|
-- * Subsite
|
||
|
|
EmbeddedStatic
|
||
|
|
, embeddedResourceR
|
||
|
|
- , mkEmbeddedStatic
|
||
|
|
, embedStaticContent
|
||
|
|
|
||
|
|
-- * Generators
|
||
|
|
@@ -91,69 +90,6 @@ instance Yesod master => YesodSubDispatch EmbeddedStatic (HandlerT master IO) wh
|
||
|
|
("widget":_) -> staticApp (widgetSettings site) req
|
||
|
|
_ -> return $ responseLBS status404 [] "Not Found"
|
||
|
|
|
||
|
|
--- | Create the haskell variable for the link to the entry
|
||
|
|
-mkRoute :: ComputedEntry -> Q [Dec]
|
||
|
|
-mkRoute (ComputedEntry { cHaskellName = Nothing }) = return []
|
||
|
|
-mkRoute (c@ComputedEntry { cHaskellName = Just name }) = do
|
||
|
|
- routeType <- [t| Route EmbeddedStatic |]
|
||
|
|
- link <- [| $(cLink c) |]
|
||
|
|
- return [ SigD name routeType
|
||
|
|
- , ValD (VarP name) (NormalB link) []
|
||
|
|
- ]
|
||
|
|
-
|
||
|
|
--- | Creates an 'EmbeddedStatic' by running, at compile time, a list of generators.
|
||
|
|
--- Each generator produces a list of entries to embed into the executable.
|
||
|
|
---
|
||
|
|
--- This template haskell splice creates a variable binding holding the resulting
|
||
|
|
--- 'EmbeddedStatic' and in addition creates variable bindings for all the routes
|
||
|
|
--- produced by the generators. For example, if a directory called static has
|
||
|
|
--- the following contents:
|
||
|
|
---
|
||
|
|
--- * js/jquery.js
|
||
|
|
---
|
||
|
|
--- * css/bootstrap.css
|
||
|
|
---
|
||
|
|
--- * img/logo.png
|
||
|
|
---
|
||
|
|
--- then a call to
|
||
|
|
---
|
||
|
|
--- > #ifdef DEVELOPMENT
|
||
|
|
--- > #define DEV_BOOL True
|
||
|
|
--- > #else
|
||
|
|
--- > #define DEV_BOOL False
|
||
|
|
--- > #endif
|
||
|
|
--- > mkEmbeddedStatic DEV_BOOL "myStatic" [embedDir "static"]
|
||
|
|
---
|
||
|
|
--- will produce variables
|
||
|
|
---
|
||
|
|
--- > myStatic :: EmbeddedStatic
|
||
|
|
--- > js_jquery_js :: Route EmbeddedStatic
|
||
|
|
--- > css_bootstrap_css :: Route EmbeddedStatic
|
||
|
|
--- > img_logo_png :: Route EmbeddedStatic
|
||
|
|
-mkEmbeddedStatic :: Bool -- ^ development?
|
||
|
|
- -> String -- ^ variable name for the created 'EmbeddedStatic'
|
||
|
|
- -> [Generator] -- ^ the generators (see "Yesod.EmbeddedStatic.Generators")
|
||
|
|
- -> Q [Dec]
|
||
|
|
-mkEmbeddedStatic dev esName gen = do
|
||
|
|
- entries <- concat <$> sequence gen
|
||
|
|
- computed <- runIO $ mapM (if dev then devEmbed else prodEmbed) entries
|
||
|
|
-
|
||
|
|
- let settings = Static.mkSettings $ return $ map cStEntry computed
|
||
|
|
- devExtra = listE $ catMaybes $ map ebDevelExtraFiles entries
|
||
|
|
- ioRef = [| unsafePerformIO $ newIORef M.empty |]
|
||
|
|
-
|
||
|
|
- -- build the embedded static
|
||
|
|
- esType <- [t| EmbeddedStatic |]
|
||
|
|
- esCreate <- if dev
|
||
|
|
- then [| EmbeddedStatic (develApp $settings $devExtra) $ioRef |]
|
||
|
|
- else [| EmbeddedStatic (staticApp $! $settings) $ioRef |]
|
||
|
|
- let es = [ SigD (mkName esName) esType
|
||
|
|
- , ValD (VarP $ mkName esName) (NormalB esCreate) []
|
||
|
|
- ]
|
||
|
|
-
|
||
|
|
- routes <- mapM mkRoute computed
|
||
|
|
-
|
||
|
|
- return $ es ++ concat routes
|
||
|
|
|
||
|
|
-- | Use this for 'addStaticContent' to have the widget static content be served by
|
||
|
|
-- the embedded static subsite. For example,
|
||
|
|
diff --git a/Yesod/EmbeddedStatic/Generators.hs b/Yesod/EmbeddedStatic/Generators.hs
|
||
|
|
index e83785d..bc35359 100644
|
||
|
|
--- a/Yesod/EmbeddedStatic/Generators.hs
|
||
|
|
+++ b/Yesod/EmbeddedStatic/Generators.hs
|
||
|
|
@@ -6,12 +6,12 @@
|
||
|
|
module Yesod.EmbeddedStatic.Generators (
|
||
|
|
-- * Generators
|
||
|
|
Location
|
||
|
|
- , embedFile
|
||
|
|
- , embedFileAt
|
||
|
|
- , embedDir
|
||
|
|
- , embedDirAt
|
||
|
|
- , concatFiles
|
||
|
|
- , concatFilesWith
|
||
|
|
+ --, embedFile
|
||
|
|
+ --, embedFileAt
|
||
|
|
+ --, embedDir
|
||
|
|
+ --, embedDirAt
|
||
|
|
+ --, concatFiles
|
||
|
|
+ --, concatFilesWith
|
||
|
|
|
||
|
|
-- * Compression options for 'concatFilesWith'
|
||
|
|
, jasmine
|
||
|
|
@@ -50,28 +50,6 @@ import qualified Data.Text as T
|
||
|
|
|
||
|
|
import Yesod.EmbeddedStatic.Types
|
||
|
|
|
||
|
|
--- | Embed a single file. Equivalent to passing the same string twice to 'embedFileAt'.
|
||
|
|
-embedFile :: FilePath -> Generator
|
||
|
|
-embedFile f = embedFileAt f f
|
||
|
|
-
|
||
|
|
--- | Embed a single file at a given location within the static subsite and generate a
|
||
|
|
--- route variable based on the location via 'pathToName'. The @FilePath@ must be a relative
|
||
|
|
--- path to the directory in which you run @cabal build@. During development, the file located
|
||
|
|
--- at this filepath will be reloaded on every request. When compiling for production, the contents
|
||
|
|
--- of the file will be embedded into the executable and so the file does not need to be
|
||
|
|
--- distributed along with the executable.
|
||
|
|
-embedFileAt :: Location -> FilePath -> Generator
|
||
|
|
-embedFileAt loc f = do
|
||
|
|
- let mime = defaultMimeLookup $ T.pack f
|
||
|
|
- let entry = def {
|
||
|
|
- ebHaskellName = Just $ pathToName loc
|
||
|
|
- , ebLocation = loc
|
||
|
|
- , ebMimeType = mime
|
||
|
|
- , ebProductionContent = BL.readFile f
|
||
|
|
- , ebDevelReload = [| BL.readFile $(litE $ stringL f) |]
|
||
|
|
- }
|
||
|
|
- return [entry]
|
||
|
|
-
|
||
|
|
-- | List all files recursively in a directory
|
||
|
|
getRecursiveContents :: Location -- ^ The directory to search
|
||
|
|
-> FilePath -- ^ The prefix to add to the filenames
|
||
|
|
@@ -88,74 +66,6 @@ getRecursiveContents prefix topdir = do
|
||
|
|
else return [(loc, path)]
|
||
|
|
return (concat paths)
|
||
|
|
|
||
|
|
--- | Embed all files in a directory into the static subsite.
|
||
|
|
---
|
||
|
|
--- Equivalent to passing the empty string as the location to 'embedDirAt',
|
||
|
|
--- so the directory path itself is not part of the resource locations (and so
|
||
|
|
--- also not part of the generated route variable names).
|
||
|
|
-embedDir :: FilePath -> Generator
|
||
|
|
-embedDir = embedDirAt ""
|
||
|
|
-
|
||
|
|
--- | Embed all files in a directory to a given location within the static subsite.
|
||
|
|
---
|
||
|
|
--- The directory tree rooted at the 'FilePath' (which must be relative to the directory in
|
||
|
|
--- which you run @cabal build@) is embedded into the static subsite at the given
|
||
|
|
--- location. Also, route variables will be created based on the final location
|
||
|
|
--- of each file. For example, if a directory \"static\" contains the files
|
||
|
|
---
|
||
|
|
--- * css/bootstrap.css
|
||
|
|
---
|
||
|
|
--- * js/jquery.js
|
||
|
|
---
|
||
|
|
--- * js/bootstrap.js
|
||
|
|
---
|
||
|
|
--- then @embedDirAt \"somefolder\" \"static\"@ will
|
||
|
|
---
|
||
|
|
--- * Make the file @static\/css\/bootstrap.css@ available at the location
|
||
|
|
--- @somefolder\/css\/bootstrap.css@ within the static subsite and similarly
|
||
|
|
--- for the other two files.
|
||
|
|
---
|
||
|
|
--- * Create variables @somefolder_css_bootstrap_css@, @somefolder_js_jquery_js@,
|
||
|
|
--- @somefolder_js_bootstrap_js@ all of type @Route EmbeddedStatic@.
|
||
|
|
---
|
||
|
|
--- * During development, the files will be reloaded on every request. During
|
||
|
|
--- production, the contents of all files will be embedded into the executable.
|
||
|
|
---
|
||
|
|
--- * During development, files that are added to the directory while the server
|
||
|
|
--- is running will not be detected. You need to recompile the module which
|
||
|
|
--- contains the call to @mkEmbeddedStatic@. This will also generate new route
|
||
|
|
--- variables for the new files.
|
||
|
|
-embedDirAt :: Location -> FilePath -> Generator
|
||
|
|
-embedDirAt loc dir = do
|
||
|
|
- files <- runIO $ getRecursiveContents loc dir
|
||
|
|
- concat <$> mapM (uncurry embedFileAt) files
|
||
|
|
-
|
||
|
|
--- | Concatinate a list of files and embed it at the location. Equivalent to passing @return@ to
|
||
|
|
--- 'concatFilesWith'.
|
||
|
|
-concatFiles :: Location -> [FilePath] -> Generator
|
||
|
|
-concatFiles loc files = concatFilesWith loc return files
|
||
|
|
-
|
||
|
|
--- | Concatinate a list of files into a single 'BL.ByteString', run the resulting content through the given
|
||
|
|
--- function, embed it at the given location, and create a haskell variable name for the route based on
|
||
|
|
--- the location.
|
||
|
|
---
|
||
|
|
--- The processing function is only run when compiling for production, and the processing function is
|
||
|
|
--- executed at compile time. During development, on every request the files listed are reloaded,
|
||
|
|
--- concatenated, and served as a single resource at the given location without being processed.
|
||
|
|
-concatFilesWith :: Location -> (BL.ByteString -> IO BL.ByteString) -> [FilePath] -> Generator
|
||
|
|
-concatFilesWith loc process files = do
|
||
|
|
- let load = do putStrLn $ "Creating " ++ loc
|
||
|
|
- BL.concat <$> mapM BL.readFile files >>= process
|
||
|
|
- expFiles = listE $ map (litE . stringL) files
|
||
|
|
- expCt = [| BL.concat <$> mapM BL.readFile $expFiles |]
|
||
|
|
- mime = defaultMimeLookup $ T.pack loc
|
||
|
|
- return [def { ebHaskellName = Just $ pathToName loc
|
||
|
|
- , ebLocation = loc
|
||
|
|
- , ebMimeType = mime
|
||
|
|
- , ebProductionContent = load
|
||
|
|
- , ebDevelReload = expCt
|
||
|
|
- }]
|
||
|
|
-
|
||
|
|
-- | Convienient rexport of 'minifym' with a type signature to work with 'concatFilesWith'.
|
||
|
|
jasmine :: BL.ByteString -> IO BL.ByteString
|
||
|
|
jasmine ct = return $ either (const ct) id $ minifym ct
|
||
|
|
diff --git a/Yesod/EmbeddedStatic/Internal.hs b/Yesod/EmbeddedStatic/Internal.hs
|
||
|
|
index 0882c16..6f61a0f 100644
|
||
|
|
--- a/Yesod/EmbeddedStatic/Internal.hs
|
||
|
|
+++ b/Yesod/EmbeddedStatic/Internal.hs
|
||
|
|
@@ -7,9 +7,6 @@
|
||
|
|
module Yesod.EmbeddedStatic.Internal (
|
||
|
|
EmbeddedStatic(..)
|
||
|
|
, Route(..)
|
||
|
|
- , ComputedEntry(..)
|
||
|
|
- , devEmbed
|
||
|
|
- , prodEmbed
|
||
|
|
, develApp
|
||
|
|
, AddStaticContent
|
||
|
|
, staticContentHelper
|
||
|
|
@@ -68,44 +65,6 @@ instance ParseRoute EmbeddedStatic where
|
||
|
|
parseRoute (["widget",h], _) = Just $ EmbeddedWidgetR h
|
||
|
|
parseRoute _ = Nothing
|
||
|
|
|
||
|
|
--- | At compile time, one of these is created for every 'Entry' created by
|
||
|
|
--- the generators. The cLink is a template haskell expression of type @Route EmbeddedStatic@.
|
||
|
|
-data ComputedEntry = ComputedEntry {
|
||
|
|
- cHaskellName :: Maybe Name -- ^ Optional haskell name to create a variable for the route
|
||
|
|
- , cStEntry :: Static.EmbeddableEntry -- ^ The entry to be embedded into the executable
|
||
|
|
- , cLink :: ExpQ -- ^ The route for this entry
|
||
|
|
-}
|
||
|
|
-
|
||
|
|
-mkStr :: String -> ExpQ
|
||
|
|
-mkStr = litE . stringL
|
||
|
|
-
|
||
|
|
--- | Create a 'ComputedEntry' for development mode, reloading the content on every request.
|
||
|
|
-devEmbed :: Entry -> IO ComputedEntry
|
||
|
|
-devEmbed e = return computed
|
||
|
|
- where
|
||
|
|
- st = Static.EmbeddableEntry {
|
||
|
|
- Static.eLocation = "res/" `T.append` T.pack (ebLocation e)
|
||
|
|
- , Static.eMimeType = ebMimeType e
|
||
|
|
- , Static.eContent = Right [| $(ebDevelReload e) >>= \c ->
|
||
|
|
- return (T.pack (base64md5 c), c) |]
|
||
|
|
- }
|
||
|
|
- link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e)) [] |]
|
||
|
|
- computed = ComputedEntry (ebHaskellName e) st link
|
||
|
|
-
|
||
|
|
--- | Create a 'ComputedEntry' for production mode, hashing and embedding the content into the executable.
|
||
|
|
-prodEmbed :: Entry -> IO ComputedEntry
|
||
|
|
-prodEmbed e = do
|
||
|
|
- ct <- ebProductionContent e
|
||
|
|
- let hash = base64md5 ct
|
||
|
|
- link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e))
|
||
|
|
- [(T.pack "etag", T.pack $(mkStr hash))] |]
|
||
|
|
- st = Static.EmbeddableEntry {
|
||
|
|
- Static.eLocation = "res/" `T.append` T.pack (ebLocation e)
|
||
|
|
- , Static.eMimeType = ebMimeType e
|
||
|
|
- , Static.eContent = Left (T.pack hash, ct)
|
||
|
|
- }
|
||
|
|
- return $ ComputedEntry (ebHaskellName e) st link
|
||
|
|
-
|
||
|
|
tryExtraDevelFiles :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application
|
||
|
|
tryExtraDevelFiles [] _ = return $ responseLBS status404 [] ""
|
||
|
|
tryExtraDevelFiles (f:fs) r = do
|
||
|
|
diff --git a/Yesod/EmbeddedStatic/Types.hs b/Yesod/EmbeddedStatic/Types.hs
|
||
|
|
index 5cbd662..d3e514f 100644
|
||
|
|
--- a/Yesod/EmbeddedStatic/Types.hs
|
||
|
|
+++ b/Yesod/EmbeddedStatic/Types.hs
|
||
|
|
@@ -1,7 +1,6 @@
|
||
|
|
{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
|
||
|
|
module Yesod.EmbeddedStatic.Types(
|
||
|
|
Location
|
||
|
|
- , Generator
|
||
|
|
-- ** Entry
|
||
|
|
, Entry
|
||
|
|
, ebHaskellName
|
||
|
|
@@ -52,16 +51,3 @@ data Entry = Entry {
|
||
|
|
-- taking as input the list of path pieces and optionally returning a mime type
|
||
|
|
-- and content.
|
||
|
|
}
|
||
|
|
-
|
||
|
|
--- | When using 'def', you must fill in at least 'ebLocation'.
|
||
|
|
-instance Default Entry where
|
||
|
|
- def = Entry { ebHaskellName = Nothing
|
||
|
|
- , ebLocation = "xxxx"
|
||
|
|
- , ebMimeType = "application/octet-stream"
|
||
|
|
- , ebProductionContent = return BL.empty
|
||
|
|
- , ebDevelReload = [| return BL.empty |]
|
||
|
|
- , ebDevelExtraFiles = Nothing
|
||
|
|
- }
|
||
|
|
-
|
||
|
|
--- | An embedded generator is executed at compile time to produce the entries to embed.
|
||
|
|
-type Generator = Q [Entry]
|
||
|
|
diff --git a/Yesod/Static.hs b/Yesod/Static.hs
|
||
|
|
index ef27f1b..5795f45 100644
|
||
|
|
--- a/Yesod/Static.hs
|
||
|
|
+++ b/Yesod/Static.hs
|
||
|
|
@@ -37,8 +37,8 @@ module Yesod.Static
|
||
|
|
, staticDevel
|
||
|
|
-- * Combining CSS/JS
|
||
|
|
-- $combining
|
||
|
|
- , combineStylesheets'
|
||
|
|
- , combineScripts'
|
||
|
|
+ --, combineStylesheets'
|
||
|
|
+ --, combineScripts'
|
||
|
|
-- ** Settings
|
||
|
|
, CombineSettings
|
||
|
|
, csStaticDir
|
||
|
|
@@ -48,13 +48,13 @@ module Yesod.Static
|
||
|
|
, csJsPreProcess
|
||
|
|
, csCombinedFolder
|
||
|
|
-- * Template Haskell helpers
|
||
|
|
- , staticFiles
|
||
|
|
- , staticFilesList
|
||
|
|
- , publicFiles
|
||
|
|
+ --, staticFiles
|
||
|
|
+ --, staticFilesList
|
||
|
|
+ --, publicFiles
|
||
|
|
-- * Hashing
|
||
|
|
, base64md5
|
||
|
|
-- * Embed
|
||
|
|
- , embed
|
||
|
|
+ --, embed
|
||
|
|
#ifdef TEST_EXPORT
|
||
|
|
, getFileListPieces
|
||
|
|
#endif
|
||
|
|
@@ -64,7 +64,6 @@ import Prelude hiding (FilePath)
|
||
|
|
import qualified Prelude
|
||
|
|
import System.Directory
|
||
|
|
import Control.Monad
|
||
|
|
-import Data.FileEmbed (embedDir)
|
||
|
|
|
||
|
|
import Yesod.Core
|
||
|
|
import Yesod.Core.Types
|
||
|
|
@@ -135,21 +134,6 @@ staticDevel dir = do
|
||
|
|
hashLookup <- cachedETagLookupDevel dir
|
||
|
|
return $ Static $ webAppSettingsWithLookup (F.decodeString 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 :: Prelude.FilePath -> Q Exp
|
||
|
|
-embed fp = [|Static (embeddedSettings $(embedDir fp))|]
|
||
|
|
-
|
||
|
|
instance RenderRoute Static where
|
||
|
|
-- | A route on the static subsite (see also 'staticFiles').
|
||
|
|
--
|
||
|
|
@@ -214,59 +198,6 @@ getFileListPieces = flip evalStateT M.empty . flip go id
|
||
|
|
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 :: Prelude.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 :: Prelude.FilePath -> [Prelude.FilePath] -> Q [Dec]
|
||
|
|
-staticFilesList dir fs =
|
||
|
|
- mkStaticFilesList dir (map split fs) "StaticRoute" True
|
||
|
|
- where
|
||
|
|
- split :: Prelude.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 :: Prelude.FilePath -> Q [Dec]
|
||
|
|
-publicFiles dir = mkStaticFiles' dir "StaticRoute" False
|
||
|
|
-
|
||
|
|
|
||
|
|
mkHashMap :: Prelude.FilePath -> IO (M.Map F.FilePath S8.ByteString)
|
||
|
|
mkHashMap dir = do
|
||
|
|
@@ -309,53 +240,6 @@ cachedETagLookup dir = do
|
||
|
|
etags <- mkHashMap dir
|
||
|
|
return $ (\f -> return $ M.lookup f etags)
|
||
|
|
|
||
|
|
-mkStaticFiles :: Prelude.FilePath -> Q [Dec]
|
||
|
|
-mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True
|
||
|
|
-
|
||
|
|
-mkStaticFiles' :: Prelude.FilePath -- ^ static directory
|
||
|
|
- -> String -- ^ route constructor "StaticRoute"
|
||
|
|
- -> Bool -- ^ append checksum query parameter
|
||
|
|
- -> Q [Dec]
|
||
|
|
-mkStaticFiles' fp routeConName makeHash = do
|
||
|
|
- fs <- qRunIO $ getFileListPieces fp
|
||
|
|
- mkStaticFilesList fp fs routeConName makeHash
|
||
|
|
-
|
||
|
|
-mkStaticFilesList
|
||
|
|
- :: Prelude.FilePath -- ^ static directory
|
||
|
|
- -> [[String]] -- ^ list of files to create identifiers for
|
||
|
|
- -> String -- ^ route constructor "StaticRoute"
|
||
|
|
- -> Bool -- ^ append checksum query parameter
|
||
|
|
- -> Q [Dec]
|
||
|
|
-mkStaticFilesList fp fs routeConName 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 f = do
|
||
|
|
- let name' = intercalate "_" $ map (map replace') f
|
||
|
|
- 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)|]
|
||
|
|
- let route = mkName routeConName
|
||
|
|
- pack' <- [|pack|]
|
||
|
|
- qs <- if makeHash
|
||
|
|
- then do hash <- qRunIO $ base64md5File $ pathFromRawPieces fp f
|
||
|
|
- [|[(pack "etag", pack $(TH.lift hash))]|]
|
||
|
|
- else return $ ListE []
|
||
|
|
- return
|
||
|
|
- [ SigD routeName $ ConT route
|
||
|
|
- , FunD routeName
|
||
|
|
- [ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) []
|
||
|
|
- ]
|
||
|
|
- ]
|
||
|
|
|
||
|
|
base64md5File :: Prelude.FilePath -> IO String
|
||
|
|
base64md5File = fmap (base64 . encode) . hashFile
|
||
|
|
@@ -379,55 +263,6 @@ base64 = map 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 $ runResourceT $ mapM_ yield fps $$ awaitForever readUTFFile =$ consume
|
||
|
|
- ltext <- qRunIO $ preProcess $ TL.fromChunks texts
|
||
|
|
- bs <- qRunIO $ postProcess fps $ TLE.encodeUtf8 ltext
|
||
|
|
- let hash' = base64md5 bs
|
||
|
|
- suffix = csCombinedFolder </> F.decodeString hash' <.> extension
|
||
|
|
- fp = csStaticDir </> suffix
|
||
|
|
- qRunIO $ do
|
||
|
|
- createTree $ F.directory fp
|
||
|
|
- L.writeFile (F.encodeString fp) bs
|
||
|
|
- let pieces = map T.unpack $ T.splitOn "/" $ either id id $ F.toText suffix
|
||
|
|
- [|StaticRoute (map pack pieces) []|]
|
||
|
|
- where
|
||
|
|
- fps :: [F.FilePath]
|
||
|
|
- fps = map toFP routes
|
||
|
|
- toFP (StaticRoute pieces _) = csStaticDir </> F.concat (map F.fromText pieces)
|
||
|
|
- readUTFFile fp = sourceFile (F.encodeString fp) =$= CT.decode CT.utf8
|
||
|
|
- 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.
|
||
|
|
--
|
||
|
|
@@ -504,50 +339,3 @@ instance Default CombineSettings where
|
||
|
|
errorIntro :: [FilePath] -> [Char] -> [Char]
|
||
|
|
errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s
|
||
|
|
|
||
|
|
-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) |]
|
||
|
|
--
|
||
|
|
1.8.5.1
|
||
|
|
|