git-annex-5.20131221: standalone/no-th/haskell-patches/yesod-static_remove-TH.patch
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