From ad0166a6e537021c9f5a1e01cde4b7c520edcf3a Mon Sep 17 00:00:00 2001 From: Joey Hess 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