yesod-static 1.2.4 → 1.6.1.3
raw patch · 17 files changed
Files
- ChangeLog.md +69/−0
- README.md +3/−0
- Yesod/EmbeddedStatic.hs +9/−19
- Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs +6/−6
- Yesod/EmbeddedStatic/Css/Util.hs +20/−18
- Yesod/EmbeddedStatic/Generators.hs +25/−24
- Yesod/EmbeddedStatic/Internal.hs +4/−29
- Yesod/EmbeddedStatic/Types.hs +5/−2
- Yesod/Static.hs +133/−82
- sample-embed.hs +5/−2
- sample.hs +4/−1
- test/EmbedDevelTest.hs +5/−1
- test/EmbedProductionTest.hs +15/−3
- test/EmbedTestGenerator.hs +4/−1
- test/FileGeneratorTests.hs +11/−7
- test/GeneratorTestUtil.hs +23/−15
- yesod-static.cabal +62/−60
+ ChangeLog.md view
@@ -0,0 +1,69 @@+# ChangeLog for yesod-static++## 1.6.1.3++* Support `yesod-core` 1.7++## 1.6.1.2++* Allow JavaScript MIME type used by `mime-types >= 0.1.2.1` in test suite [#1898](https://github.com/yesodweb/yesod/pull/1898)++## 1.6.1.1++* Use crypton instead of cryptonite [#1838](https://github.com/yesodweb/yesod/pull/1838)+* Set `base >= 4.11` for less CPP and imports [#1876](https://github.com/yesodweb/yesod/pull/1876)+++## 1.6.1.0++* Support reproducible embedded file order [#1684](https://github.com/yesodweb/yesod/issues/1684#issuecomment-652562514)++## 1.6.0.2++* Remove unnecessary deriving of Typeable++## 1.6.0.1++* Make test suite build with GHC 8.6 [#1561](https://github.com/yesodweb/yesod/pull/1561)++## 1.6.0++* Upgrade to yesod-core 1.6.0++## 1.5.3.1++* Switch to cryptonite++## 1.5.3++* Add `staticFilesMap` function+* Add `staticFilesMergeMap` function++## 1.5.2++* Fix test case for CRLF line endings+* Fix warnings++## 1.5.1.1++* Fix test suite compilation++## 1.5.1++* yesod-static doesn't obey Authentication [#1286](https://github.com/yesodweb/yesod/issues/1286)++## 1.5.0.5++* Avoid lazy I/O in mkEmbeddedStatic (fixes [#149](https://github.com/yesodweb/yesod/issues/149))++## 1.5.0.4++* Doc tweaks++## 1.5.0++* Drop system-filepath++## 1.4.0.3++Fix bug when `StaticRoute` constructor is not imported.
+ README.md view
@@ -0,0 +1,3 @@+## yesod-static++Static file serving subsite for Yesod Web Framework.
Yesod/EmbeddedStatic.hs view
@@ -1,13 +1,13 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+ -- | A subsite which serves static content which is embedded at compile time. -- -- At compile time, you supply a list of files, directories, processing functions (like javascript@@ -33,7 +33,7 @@ -- contains the created 'EmbeddedStatic'. -- -- It is recommended that you serve static resources from a separate domain to save time--- on transmitting cookies. You can use 'urlRenderOverride' to do so, by redirecting+-- on transmitting cookies. You can use 'urlParamRenderOverride' to do so, by redirecting -- routes to this subsite to a different domain (but the same path) and then pointing the -- alternative domain to this server. In addition, you might consider using a reverse -- proxy like varnish or squid to cache the static content, but the embedded content in@@ -49,7 +49,6 @@ , module Yesod.EmbeddedStatic.Generators ) where -import Control.Applicative ((<$>)) import Data.IORef import Data.Maybe (catMaybes) import Language.Haskell.TH@@ -57,11 +56,7 @@ import Network.Wai (responseLBS, pathInfo) import Network.Wai.Application.Static (staticApp) import System.IO.Unsafe (unsafePerformIO)-import Yesod.Core- ( HandlerT- , Yesod(..)- , YesodSubDispatch(..)- )+import Yesod.Core (YesodSubDispatch(..)) import Yesod.Core.Types ( YesodSubRunnerEnv(..) , YesodRunnerEnv(..)@@ -82,7 +77,7 @@ embeddedResourceR :: [T.Text] -> [(T.Text, T.Text)] -> Route EmbeddedStatic embeddedResourceR = EmbeddedResourceR -instance Yesod master => YesodSubDispatch EmbeddedStatic (HandlerT master IO) where+instance YesodSubDispatch EmbeddedStatic master where yesodSubDispatch YesodSubRunnerEnv {..} req = resp where master = yreSite ysreParentEnv@@ -90,11 +85,7 @@ resp = case pathInfo req of ("res":_) -> stApp site req ("widget":_) -> staticApp (widgetSettings site) req-#if MIN_VERSION_wai(3,0,0) _ -> ($ responseLBS status404 [] "Not Found")-#else- _ -> return $ responseLBS status404 [] "Not Found"-#endif -- | Create the haskell variable for the link to the entry mkRoute :: ComputedEntry -> Q [Dec]@@ -106,7 +97,7 @@ , ValD (VarP name) (NormalB link) [] ] --- | Creates an 'EmbeddedStatic' by running, at compile time, a list of generators. +-- | 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@@ -180,8 +171,7 @@ -- > addStaticContent = embedStaticContent getStatic StaticR mini -- > where mini = if development then Right else minifym -- > ...-embedStaticContent :: Yesod site- => (site -> EmbeddedStatic) -- ^ How to retrieve the embedded static subsite from your site+embedStaticContent :: (site -> EmbeddedStatic) -- ^ How to retrieve the embedded static subsite from your site -> (Route EmbeddedStatic -> Route site) -- ^ how to convert an embedded static route -> (BL.ByteString -> Either a BL.ByteString) -- ^ javascript minifier -> AddStaticContent site
Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+ -- | Manipulate CSS urls. -- -- * Make relative urls absolute (useful when combining assets)@@ -11,7 +12,6 @@ , absCssUrlsProd ) where -import Prelude hiding (FilePath) import Yesod.EmbeddedStatic.Generators import Yesod.EmbeddedStatic.Types @@ -22,7 +22,7 @@ import qualified Data.Text.Lazy.Encoding as TL import Control.Monad ((>=>)) import Data.Maybe (fromMaybe)-import Filesystem.Path.CurrentOS ((</>), collapse, FilePath, fromText, toText, encodeString, decodeString)+import System.FilePath ((</>)) import Yesod.EmbeddedStatic.Css.Util @@ -35,7 +35,7 @@ -> FilePath -> IO BL.ByteString absCssUrlsFileProd dir file = do- contents <- T.readFile (encodeString file)+ contents <- T.readFile file return $ TL.encodeUtf8 $ absCssUrlsProd dir contents absCssUrlsProd :: FilePath -- ^ Anchor relative urls to here@@ -47,14 +47,14 @@ where toAbsoluteUrl (UrlReference rel) = T.concat [ "url('/"- , (either id id $ toText $ collapse $ dir </> fromText rel)+ , (T.pack $ dir </> T.unpack rel) , "')" ] -- | Equivalent to passing the same string twice to 'absoluteUrlsAt'. absoluteUrls :: FilePath -> Generator-absoluteUrls f = absoluteUrlsAt (encodeString f) f+absoluteUrls f = absoluteUrlsAt f f -- | Equivalent to passing @return@ to 'absoluteUrlsWith'. absoluteUrlsAt :: Location -> FilePath -> Generator@@ -74,7 +74,7 @@ -> Maybe (CssGeneration -> IO BL.ByteString) -- ^ Another filter function run after this one (for example @return . yuiCSS . cssContent@) or other CSS filter that runs after this filter. -> Generator absoluteUrlsWith loc file mpostFilter =- return [ cssProductionFilter (absCssUrlsFileProd (decodeString loc) >=> postFilter . mkCssGeneration loc file) loc file+ return [ cssProductionFilter (absCssUrlsFileProd loc >=> postFilter . mkCssGeneration loc file) loc file ] where postFilter = fromMaybe (return . cssContent) mpostFilter
Yesod/EmbeddedStatic/Css/Util.hs view
@@ -1,19 +1,22 @@-{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell, TupleSections, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+ module Yesod.EmbeddedStatic.Css.Util where -import Prelude hiding (FilePath)-import Control.Applicative+import Control.Applicative ((<|>)) import Control.Monad (void, foldM) import Data.Hashable (Hashable)-import Data.Monoid import Network.Mime (MimeType, defaultMimeLookup)-import Filesystem.Path.CurrentOS (FilePath, directory, (</>), dropExtension, filename, toText, decodeString, encodeString, fromText, absolute) import Text.CSS.Parse (parseBlocks) import Language.Haskell.TH (litE, stringL) import Text.CSS.Render (renderBlocks) import Yesod.EmbeddedStatic.Types import Yesod.EmbeddedStatic (pathToName) import Data.Default (def)+import System.FilePath ((</>), takeFileName, takeDirectory, dropExtension) import qualified Blaze.ByteString.Builder as B import qualified Blaze.ByteString.Builder.Char.Utf8 as B@@ -63,14 +66,13 @@ parseBackgroundImage n v = (n, case P.parseOnly parseUrl v of Left _ -> Left v -- Can't parse url Right url -> -- maybe we should find a uri parser- if any (`T.isPrefixOf` url) ["http://", "https://", "//"] || absolute (fromText url)+ if any (`T.isPrefixOf` url) ["http://", "https://", "/"] then Left v else Right $ UrlReference url) parseCssWith :: (T.Text -> T.Text -> EithUrl) -> T.Text -> Either String Css parseCssWith urlParser contents =- let mparsed = parseBlocks contents in- case mparsed of+ case parseBlocks contents of Left err -> Left err Right blocks -> Right [ (t, map (uncurry urlParser) b) | (t,b) <- blocks ] @@ -79,9 +81,9 @@ parseCssFileWith :: (T.Text -> T.Text -> EithUrl) -> FilePath -> IO Css parseCssFileWith urlParser fp = do- mparsed <- parseCssWith urlParser <$> T.readFile (encodeString fp)+ mparsed <- parseCssWith urlParser <$> T.readFile fp case mparsed of- Left err -> fail $ "Unable to parse " ++ encodeString fp ++ ": " ++ err+ Left err -> fail $ "Unable to parse " ++ fp ++ ": " ++ err Right css -> return css parseCssFileUrls :: FilePath -> IO Css@@ -101,7 +103,7 @@ load imap (Left _) = return imap load imap (Right f) | f `M.member` imap = return imap load imap (Right f@(UrlReference path)) = do- img <- loadImage (dir </> fromText path)+ img <- loadImage (dir </> T.unpack path) return $ maybe imap (\i -> M.insert f i imap) img @@ -129,14 +131,14 @@ , ebLocation = loc , ebMimeType = "text/css" , ebProductionContent = prodFilter file- , ebDevelReload = [| develPassThrough $(litE (stringL loc)) $(litE (stringL $ encodeString file)) |]+ , ebDevelReload = [| develPassThrough $(litE (stringL loc)) $(litE (stringL file)) |] , ebDevelExtraFiles = Nothing } cssProductionImageFilter :: (FilePath -> IO BL.ByteString) -> Location -> FilePath -> Entry cssProductionImageFilter prodFilter loc file = (cssProductionFilter prodFilter loc file)- { ebDevelReload = [| develBgImgB64 $(litE (stringL loc)) $(litE (stringL $ encodeString file)) |]+ { ebDevelReload = [| develBgImgB64 $(litE (stringL loc)) $(litE (stringL file)) |] , ebDevelExtraFiles = Just [| develExtraFiles $(litE (stringL loc)) |] } @@ -158,8 +160,8 @@ url <- PBL.takeWhile (/= 39) -- single quote void $ PBL.string "')" - let b64 = B64.encode $ T.encodeUtf8 (either id id $ toText (directory file)) <> url- newUrl = B.fromString (encodeString $ filename $ decodeString loc) <> B.fromString "/" <> B.fromByteString b64+ let b64 = B64.encode $ T.encodeUtf8 (T.pack $ takeDirectory file) <> url+ newUrl = B.fromString (takeFileName loc) <> B.fromString "/" <> B.fromByteString b64 return $ B.fromByteString "background-image" <> B.fromByteString s1@@ -175,12 +177,12 @@ (PBL.endOfInput *> (pure $! b <> b')) <|> (parseDev loc file $! b <> b') develPassThrough :: Location -> FilePath -> IO BL.ByteString-develPassThrough _ = BL.readFile . encodeString+develPassThrough _ = BL.readFile -- | Create the CSS during development develBgImgB64 :: Location -> FilePath -> IO BL.ByteString develBgImgB64 loc file = do- ct <- BL.readFile $ encodeString file+ ct <- BL.readFile file case PBL.eitherResult $ PBL.parse (parseDev loc file mempty) ct of Left err -> error err Right b -> return $ B.toLazyByteString b@@ -190,7 +192,7 @@ develExtraFiles loc parts = case reverse parts of (file:dir) | T.pack loc == T.intercalate "/" (reverse dir) -> do- let file' = T.decodeUtf8 $ B64.decodeLenient $ T.encodeUtf8 $ either id id $ toText $ dropExtension $ fromText file+ let file' = T.decodeUtf8 $ B64.decodeLenient $ T.encodeUtf8 $ T.pack $ dropExtension $ T.unpack file ct <- BL.readFile $ T.unpack file' return $ Just (defaultMimeLookup file', ct) _ -> return Nothing
Yesod/EmbeddedStatic/Generators.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes, ScopedTypeVariables #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+ -- | A generator is executed at compile time to load a list of entries -- to embed into the subsite. This module contains several basic generators, -- but the design of generators and entries is such that it is straightforward@@ -24,18 +27,15 @@ -- * Util , pathToName- + -- * Custom Generators- + -- $example ) where -import Control.Applicative ((<$>), (<*>)) import Control.Exception (try, SomeException) import Control.Monad (forM, when)-import Control.Monad.Trans.Resource (runResourceT)-import Data.Char (isDigit, isLower)-import Data.Conduit (($$))+import Data.Char (isLower) import Data.Default (def) import Data.Maybe (isNothing) import Language.Haskell.TH@@ -43,14 +43,15 @@ import System.Directory (doesDirectoryExist, getDirectoryContents, findExecutable) import System.FilePath ((</>)) import Text.Jasmine (minifym)+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL-import qualified Data.Conduit.List as C-import Data.Conduit.Binary (sourceHandle)+import Conduit import qualified Data.Text as T import qualified System.Process as Proc import System.Exit (ExitCode (ExitSuccess)) import Control.Concurrent.Async (Concurrently (..)) import System.IO (hClose)+import Data.List (sort) import Yesod.EmbeddedStatic.Types @@ -71,8 +72,9 @@ ebHaskellName = Just $ pathToName loc , ebLocation = loc , ebMimeType = mime- , ebProductionContent = BL.readFile f- , ebDevelReload = [| BL.readFile $(litE $ stringL f) |]+ , ebProductionContent = fmap BL.fromStrict (BS.readFile f)+ , ebDevelReload = [| fmap BL.fromStrict+ (BS.readFile $(litE $ stringL f)) |] } return [entry] @@ -81,7 +83,7 @@ -> FilePath -- ^ The prefix to add to the filenames -> IO [(Location,FilePath)] getRecursiveContents prefix topdir = do- names <- getDirectoryContents topdir+ names <- sort <$> getDirectoryContents topdir let properNames = filter (`notElem` [".", ".."]) names paths <- forM properNames $ \name -> do let path = topdir </> name@@ -93,7 +95,7 @@ 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).@@ -112,7 +114,7 @@ -- * js/jquery.js -- -- * js/bootstrap.js--- +-- -- then @embedDirAt \"somefolder\" \"static\"@ will -- -- * Make the file @static\/css\/bootstrap.css@ available at the location@@ -169,7 +171,7 @@ -- to both mangle and compress and the option \"-\" to cause uglifyjs to read from -- standard input. uglifyJs :: BL.ByteString -> IO BL.ByteString-uglifyJs = compressTool "uglifyjs" ["-m", "-c", "-"]+uglifyJs = compressTool "uglifyjs" ["-", "-m", "-c"] -- | Use <http://yui.github.io/yuicompressor/ YUI Compressor> to compress javascript. -- Assumes a script @yuicompressor@ is located in the path. If not, you can still@@ -207,13 +209,13 @@ } (Just hin, Just hout, _, ph) <- Proc.createProcess p (compressed, (), code) <- runConcurrently $ (,,)- <$> Concurrently (sourceHandle hout $$ C.consume)+ <$> Concurrently (runConduit $ sourceHandle hout .| sinkLazy) <*> Concurrently (BL.hPut hin ct >> hClose hin) <*> Concurrently (Proc.waitForProcess ph) if code == ExitSuccess then do putStrLn $ "Compressed successfully with " ++ f- return $ BL.fromChunks compressed+ return compressed else error $ "compressTool: compression failed with " ++ f @@ -246,11 +248,10 @@ | otherwise = '_' name = map replace f routeName = mkName $- case () of- ()- | null name -> error "null-named file"- | isDigit (head name) -> '_' : name- | isLower (head name) -> name+ case name of+ [] -> error "null-named file"+ n : _+ | isLower n -> name | otherwise -> '_' : name @@ -295,7 +296,7 @@ -- -- Here is a small example yesod program using this generator. Try toggling -- the development argument to @mkEmbeddedStatic@.--- +-- -- >{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies #-} -- >module Main where -- >@@ -321,7 +322,7 @@ -- >getHomeR :: Handler Html -- >getHomeR = defaultLayout $ [whamlet| -- ><h1>Hello--- ><p>Check the +-- ><p>Check the -- > <a href=@{StaticR compile_time_json}>compile time -- >|] -- >
Yesod/EmbeddedStatic/Internal.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE CPP #-}+ module Yesod.EmbeddedStatic.Internal ( EmbeddedStatic(..) , Route(..)@@ -16,7 +16,6 @@ , widgetSettings ) where -import Control.Applicative ((<$>)) import Data.IORef import Language.Haskell.TH import Network.HTTP.Types (Status(..), status404, status200, status304)@@ -25,10 +24,9 @@ import Network.Wai.Application.Static (defaultWebAppSettings, staticApp) import WaiAppStatic.Types import Yesod.Core- ( HandlerT+ ( HandlerFor , ParseRoute(..) , RenderRoute(..)- , Yesod(..) , getYesod , liftIO )@@ -41,16 +39,6 @@ import Yesod.Static (base64md5) import Yesod.EmbeddedStatic.Types -#if !MIN_VERSION_base(4,6,0)--- copied from base-atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b-atomicModifyIORef' ref f = do- b <- atomicModifyIORef ref- (\x -> let (a, b) = f x- in (a, a `seq` b))- b `seq` return b-#endif- -- | The subsite for the embedded static file server. data EmbeddedStatic = EmbeddedStatic { stApp :: !Application@@ -107,11 +95,7 @@ return $ ComputedEntry (ebHaskellName e) st link toApp :: (Request -> IO Response) -> Application-#if MIN_VERSION_wai(3, 0, 0) toApp f req g = f req >>= g-#else-toApp = id-#endif tryExtraDevelFiles :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application tryExtraDevelFiles = toApp . tryExtraDevelFiles'@@ -133,27 +117,18 @@ -- | Helper to create the development application at runtime develApp :: StaticSettings -> [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application-#if MIN_VERSION_wai(3, 0, 0) develApp settings extra req sendResponse = do staticApp settings {ssMaxAge = NoMaxAge} req $ \resp -> if statusCode (responseStatus resp) == 404 then tryExtraDevelFiles extra req sendResponse else sendResponse resp-#else-develApp settings extra req = do- resp <- staticApp settings {ssMaxAge = NoMaxAge} req- if statusCode (responseStatus resp) == 404- then tryExtraDevelFiles extra req- else return resp-#endif -- | The type of 'addStaticContent' type AddStaticContent site = T.Text -> T.Text -> BL.ByteString- -> HandlerT site IO (Maybe (Either T.Text (Route site, [(T.Text, T.Text)])))+ -> HandlerFor site (Maybe (Either T.Text (Route site, [(T.Text, T.Text)]))) -- | Helper for embedStaticContent and embedLicensedStaticContent.-staticContentHelper :: Yesod site- => (site -> EmbeddedStatic)+staticContentHelper :: (site -> EmbeddedStatic) -> (Route EmbeddedStatic -> Route site) -> (BL.ByteString -> Either a BL.ByteString) -> AddStaticContent site
Yesod/EmbeddedStatic/Types.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+ module Yesod.EmbeddedStatic.Types( Location , Generator@@ -32,7 +35,7 @@ -- given name will be created which points to this resource. , ebLocation :: Location -- ^ The location to serve the resource from. , ebMimeType :: MimeType -- ^ The mime type of the resource.- , ebProductionContent :: IO BL.ByteString + , ebProductionContent :: IO BL.ByteString -- ^ If the development argument to 'Yesod.EmbeddedStatic.mkEmbeddedStatic' is False, -- then at compile time this action will be executed to load the content. -- During development, this action will not be executed.
Yesod/Static.hs view
@@ -1,11 +1,12 @@-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} --------------------------------------------------------- -- -- | Serve static files from a Yesod app.@@ -19,7 +20,7 @@ -- -- 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 'urlRenderOverride'+-- cookies. In that case, you may wish to use 'urlParamRenderOverride' -- to redirect requests to this subsite to a separate domain -- name. --@@ -50,6 +51,8 @@ -- * Template Haskell helpers , staticFiles , staticFilesList+ , staticFilesMap+ , staticFilesMergeMap , publicFiles -- * Hashing , base64md5@@ -60,17 +63,15 @@ #endif ) where -import Prelude hiding (FilePath)-import qualified Prelude import System.Directory+import qualified System.FilePath as FP import Control.Monad import Data.FileEmbed (embedDir) -import Control.Monad.Trans.Resource (runResourceT) import Yesod.Core import Yesod.Core.Types -import Data.List (intercalate)+import Data.List (intercalate, sort) import Language.Haskell.TH import Language.Haskell.TH.Syntax as TH @@ -78,7 +79,7 @@ import Crypto.Hash (MD5, Digest) import Control.Monad.Trans.State -import qualified Data.Byteable as Byteable+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@@ -86,24 +87,20 @@ 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.Char (isLower) import Data.List (foldl') import qualified Data.ByteString as S import System.PosixCompat.Files (getFileStatus, modificationTime) import System.Posix.Types (EpochTime)-import Data.Conduit-import Data.Conduit.List (sourceList, consume)-import Data.Conduit.Binary (sourceFile)-import qualified Data.Conduit.Text as CT-import Data.Functor.Identity (runIdentity)-import qualified Filesystem.Path.CurrentOS as F-import Filesystem.Path.CurrentOS ((</>), (<.>), FilePath)-import Filesystem (createTree)+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@@ -123,18 +120,18 @@ -- Does not have index files or directory listings. The static -- files' contents /must not/ change, however new files can be -- added.-static :: Prelude.FilePath -> IO Static+static :: FilePath -> IO Static static dir = do hashLookup <- cachedETagLookup dir- return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup+ 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 :: Prelude.FilePath -> IO Static+staticDevel :: FilePath -> IO Static staticDevel dir = do hashLookup <- cachedETagLookupDevel dir- return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup+ return $ Static $ webAppSettingsWithLookup dir hashLookup -- | Produce a 'Static' based on embedding all of the static files' contents in the -- executable at compile time.@@ -148,7 +145,7 @@ -- 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 :: FilePath -> Q Exp embed fp = [|Static (embeddedSettings $(embedDir fp))|] instance RenderRoute Static where@@ -172,27 +169,30 @@ instance ParseRoute Static where parseRoute (x, y) = Just $ StaticRoute x y -instance YesodSubDispatch Static m where+instance YesodSubDispatch Static master where yesodSubDispatch YesodSubRunnerEnv {..} req =- staticApp set req+ ysreParentRunner handlert ysreParentEnv (fmap ysreToParentRoute route) req where+ route = Just $ StaticRoute (pathInfo req) []+ Static set = ysreGetSub $ yreSite $ ysreParentEnv+ handlert = sendWaiApplication $ staticApp set -notHidden :: Prelude.FilePath -> Bool+notHidden :: FilePath -> Bool notHidden "tmp" = False notHidden s = case s of '.':_ -> False _ -> True -getFileListPieces :: Prelude.FilePath -> IO [[String]]+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+ allContents <- liftIO $ (sort . filter notHidden) `fmap` getDirectoryContents fp let fullPath :: String -> String fullPath f = fp ++ '/' : f files <- liftIO $ filterM (doesFileExist . fullPath) allContents@@ -232,7 +232,7 @@ -- Note that dots (@.@), dashes (@-@) and slashes (@\/@) are -- replaced by underscores (@\_@) to create valid Haskell -- identifiers.-staticFiles :: Prelude.FilePath -> Q [Dec]+staticFiles :: FilePath -> Q [Dec] staticFiles dir = mkStaticFiles dir -- | Same as 'staticFiles', but takes an explicit list of files@@ -241,15 +241,15 @@ -- files @\"static\/js\/jquery.js\"@ and -- @\"static\/css\/normalize.css\"@, you would use: ----- > staticFilesList \"static\" [\"js\/jquery.js\", \"css\/normalize.css\"]+-- > 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 :: FilePath -> [FilePath] -> Q [Dec] staticFilesList dir fs =- mkStaticFilesList dir (map split fs) "StaticRoute" True+ mkStaticFilesList dir (map split fs) True where- split :: Prelude.FilePath -> [String]+ split :: FilePath -> [String] split [] = [] split x = let (a, b) = break (== '/') x@@ -265,38 +265,85 @@ -- 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+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) -mkHashMap :: Prelude.FilePath -> IO (M.Map F.FilePath S8.ByteString)+-- | 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 [(F.FilePath, S8.ByteString)]+ hashAlist :: [[String]] -> IO [(FilePath, S8.ByteString)] hashAlist fs = mapM hashPair fs where- hashPair :: [String] -> IO (F.FilePath, S8.ByteString)+ hashPair :: [String] -> IO (FilePath, S8.ByteString) hashPair pieces = do let file = pathFromRawPieces dir pieces h <- base64md5File file- return (F.decodeString file, S8.pack h)+ return (file, S8.pack h) -pathFromRawPieces :: Prelude.FilePath -> [String] -> Prelude.FilePath+pathFromRawPieces :: FilePath -> [String] -> FilePath pathFromRawPieces = foldl' append where append a b = a ++ '/' : b -cachedETagLookupDevel :: Prelude.FilePath -> IO ETagLookup+cachedETagLookupDevel :: FilePath -> IO ETagLookup cachedETagLookupDevel dir = do etags <- mkHashMap dir- mtimeVar <- newIORef (M.empty :: M.Map F.FilePath EpochTime)+ 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.encodeString f+ fs <- getFileStatus f let newt = modificationTime fs mtimes <- readIORef mtimeVar oldt <- case M.lookup f mtimes of@@ -305,29 +352,36 @@ return $ if newt /= oldt then Nothing else Just checksum -cachedETagLookup :: Prelude.FilePath -> IO ETagLookup+cachedETagLookup :: FilePath -> IO ETagLookup 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 :: FilePath -> Q [Dec]+mkStaticFiles fp = mkStaticFiles' fp True -mkStaticFiles' :: Prelude.FilePath -- ^ static directory- -> String -- ^ route constructor "StaticRoute"+mkStaticFiles' :: FilePath -- ^ static directory -> Bool -- ^ append checksum query parameter -> Q [Dec]-mkStaticFiles' fp routeConName makeHash = do+mkStaticFiles' fp makeHash = do fs <- qRunIO $ getFileListPieces fp- mkStaticFilesList fp fs routeConName makeHash+ mkStaticFilesList fp fs makeHash mkStaticFilesList- :: Prelude.FilePath -- ^ static directory+ :: 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+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@@ -335,40 +389,37 @@ | 'a' <= c && c <= 'z' = c | '0' <= c && c <= '9' = c | otherwise = '_'- mkRoute f = do- let name' = intercalate "_" $ map (map replace') f+ 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'+ case name' of+ [] -> error "null-named file"+ n : _+ | isLower n -> 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+ [ SigD routeName $ ConT ''StaticRoute , FunD routeName- [ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) []+ [ Clause [] (NormalB $ (ConE 'StaticRoute) `AppE` f' `AppE` qs) [] ] ] -base64md5File :: Prelude.FilePath -> IO String+base64md5File :: FilePath -> IO String base64md5File = fmap (base64 . encode) . hashFile- where encode d = Byteable.toBytes (d :: Digest MD5)+ where encode d = ByteArray.convert (d :: Digest MD5) base64md5 :: L.ByteString -> String base64md5 lbs = base64 $ encode- $ runIdentity- $ sourceList (L.toChunks lbs) $$ sinkHash+ $ runConduitPure+ $ Conduit.sourceLazy lbs .| sinkHash where- encode d = Byteable.toBytes (d :: Digest MD5)+ encode d = ByteArray.convert (d :: Digest MD5) base64 :: S.ByteString -> String base64 = map tr@@ -401,22 +452,25 @@ -> [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+ 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 </> F.decodeString hash' <.> extension+ suffix = csCombinedFolder </> 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+ createDirectoryIfMissing True $ takeDirectory fp+ L.writeFile fp bs+ let pieces = map T.unpack $ T.splitOn "/" $ T.pack suffix [|StaticRoute (map pack pieces) []|] where- fps :: [F.FilePath]+ fps :: [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+ toFP (StaticRoute pieces _) = csStaticDir </> F.joinPath (map T.unpack pieces)+ readUTFFile fp = sourceFile fp .| decodeUtf8C postProcess = case combineType of JS -> csJsPostProcess@@ -438,7 +492,7 @@ -- -- Since 1.2.0 data CombineSettings = CombineSettings- { csStaticDir :: F.FilePath+ { csStaticDir :: FilePath -- ^ File path containing static files. -- -- Default: static@@ -501,9 +555,6 @@ , csJsPreProcess = return , csCombinedFolder = "combined" }--errorIntro :: [FilePath] -> [Char] -> [Char]-errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s liftRoutes :: [Route Static] -> Q Exp liftRoutes =
sample-embed.hs view
@@ -1,5 +1,8 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies #-}--- | This embeds just a single file; it embeds the source code file +{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- | This embeds just a single file; it embeds the source code file -- \"sample-embed.hs\" from the current directory so when you compile, -- the sample-embed.hs file must be in the current directory. --
sample.hs view
@@ -1,5 +1,8 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, MultiParamTypeClasses #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+ import Yesod.Static import Yesod.Core import Network.Wai.Handler.Warp (run)
test/EmbedDevelTest.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+ module EmbedDevelTest where -- Tests the development mode of the embedded static subsite by
test/EmbedProductionTest.hs view
@@ -1,4 +1,9 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies, OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+ module EmbedProductionTest where -- Tests the production mode of the embedded static subsite by@@ -108,11 +113,18 @@ yit "Embedded Javascript" $ do get HomeR statusIs 200- [script] <- htmlQuery "script"+ script <- htmlQuery "script" >>= \case+ [s] -> return s+ _ -> liftIO $ fail "Expected singleton list of script" let src = BL.takeWhile (/= 34) $ BL.drop 1 $ BL.dropWhile (/= 34) script -- 34 is " get $ TL.toStrict $ TL.decodeUtf8 src statusIs 200 hasCacheControl- assertHeader "Content-Type" "application/javascript"+ withResponse $ \resp -> liftIO $+ assertBool "Content-Type header is application/javascript or text/javascript" $+ lookup "Content-Type" (simpleHeaders resp) `elem`+ [ Just "text/javascript" -- mime-types >= 0.1.2.1+ , Just "application/javascript" -- mime-types <= 0.1.2.0+ ] bodyEquals "console.log(\"Hello World\");"
test/EmbedTestGenerator.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+ module EmbedTestGenerator (testGen) where import Data.Default
test/FileGeneratorTests.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+ module FileGeneratorTests (fileGenSpecs) where import Control.Exception@@ -11,7 +14,7 @@ -- | Embeds the LICENSE file license :: GenTestResult-license = $(embedFile "LICENSE" >>= +license = $(embedFile "LICENSE" >>= testOneEntry (Just "_LICENSE") "LICENSE" (BL.readFile "LICENSE") ) @@ -22,7 +25,7 @@ embDir :: [GenTestResult] embDir = $(embedDir "test/embed-dir" >>=- testEntries + testEntries [ (Just "abc_def_txt", "abc/def.txt", BL.readFile "test/embed-dir/abc/def.txt") , (Just "lorem_txt", "lorem.txt", BL.readFile "test/embed-dir/lorem.txt") , (Just "foo", "foo", BL.readFile "test/embed-dir/foo")@@ -31,7 +34,7 @@ embDirAt :: [GenTestResult] embDirAt = $(embedDirAt "xxx" "test/embed-dir" >>=- testEntries + testEntries [ (Just "xxx_abc_def_txt", "xxx/abc/def.txt", BL.readFile "test/embed-dir/abc/def.txt") , (Just "xxx_lorem_txt", "xxx/lorem.txt", BL.readFile "test/embed-dir/lorem.txt") , (Just "xxx_foo", "xxx/foo", BL.readFile "test/embed-dir/foo")@@ -50,7 +53,7 @@ [ "test/embed-dir/abc/def.txt", "test/embed-dir/foo"] >>= testOneEntry (Just "out2_txt") "out2.txt" (return "Yesod Rocks\nBar\nExtra") )- + fileGenSpecs :: Spec fileGenSpecs = do describe "Embed File" $ do@@ -78,10 +81,11 @@ describe "Compress" $ do it "compress tool function" $ do out <- compressTool "runhaskell" [] "main = putStrLn \"Hello World\""- assertEqual "" "Hello World\n" out+ -- 13 == CR, to make this test work on Windows+ BL.filter (/= 13) out `shouldBe` "Hello World\n" it "tryCompressTools" $ do- out <- flip tryCompressTools "abcdef" + out <- flip tryCompressTools "abcdef" [ const $ throwIO $ ErrorCall "An expected error" , const $ return "foo" , const $ return "bar"
test/GeneratorTestUtil.hs view
@@ -1,13 +1,16 @@-{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+ module GeneratorTestUtil where -import Control.Applicative import Control.Monad (when) import Data.List (sortBy) import Language.Haskell.TH import Test.HUnit-import Yesod.EmbeddedStatic.Types+import Yesod.EmbeddedStatic.Types as Y import qualified Data.ByteString.Lazy as BL+import RIO (HasCallStack) -- We test the generators by executing them at compile time -- and sticking the result into the GenTestResult. We then@@ -20,7 +23,7 @@ | GenSuccessWithDevel (IO BL.ByteString) -- | Creates a GenTestResult at compile time by testing the entry.-testEntry :: Maybe String -> Location -> IO BL.ByteString -> Entry -> ExpQ+testEntry :: Maybe String -> Y.Location -> IO BL.ByteString -> Entry -> ExpQ testEntry name _ _ e | ebHaskellName e /= (mkName <$> name) = [| GenError ("haskell name " ++ $(litE $ stringL $ show $ ebHaskellName e) ++ " /= "@@ -28,32 +31,37 @@ testEntry _ loc _ e | ebLocation e /= loc = [| GenError ("location " ++ $(litE $ stringL $ show $ ebLocation e)) |] testEntry _ _ act e = do- expected <- runIO act- actual <- runIO $ ebProductionContent e+ expected <- fmap stripCR $ runIO act+ actual <- fmap stripCR $ runIO $ ebProductionContent e if expected == actual then [| GenSuccessWithDevel $(ebDevelReload e) |]- else [| GenError "production content" |]+ else [| GenError $ "production content: " ++ $(litE $ stringL $ show (expected, actual)) |] -testOneEntry :: Maybe String -> Location -> IO BL.ByteString -> [Entry] -> ExpQ+-- | Remove all carriage returns, for Windows testing+stripCR :: BL.ByteString -> BL.ByteString+stripCR = BL.filter (/= 13)++testOneEntry :: Maybe String -> Y.Location -> IO BL.ByteString -> [Entry] -> ExpQ testOneEntry name loc ct [e] = testEntry name loc ct e testOneEntry _ _ _ _ = [| GenError "not exactly one entry" |] --- | Tests a list of entries -testEntries :: [(Maybe String, Location, IO BL.ByteString)] -> [Entry] -> ExpQ+-- | Tests a list of entries+testEntries :: [(Maybe String, Y.Location, IO BL.ByteString)] -> [Entry] -> ExpQ testEntries a b | length a /= length b = [| [GenError "lengths differ"] |] testEntries a b = listE $ zipWith f a' b'- where + where a' = sortBy (\(_,l1,_) (_,l2,_) -> compare l1 l2) a b' = sortBy (\e1 e2 -> ebLocation e1 `compare` ebLocation e2) b f (name, loc, ct) e = testEntry name loc ct e -- | Use this at runtime to assert the 'GenTestResult' is OK-assertGenResult :: (IO BL.ByteString) -- ^ expected development content+assertGenResult :: HasCallStack+ => (IO BL.ByteString) -- ^ expected development content -> GenTestResult -- ^ test result created at compile time -> Assertion assertGenResult _ (GenError e) = assertFailure ("invalid " ++ e) assertGenResult mexpected (GenSuccessWithDevel mactual) = do- expected <- mexpected- actual <- mactual+ expected <- fmap stripCR mexpected+ actual <- fmap stripCR mactual when (expected /= actual) $- assertFailure "invalid devel content"+ assertFailure $ "invalid devel content: " ++ show (expected, actual)
yesod-static.cabal view
@@ -1,5 +1,5 @@ name: yesod-static-version: 1.2.4+version: 1.6.1.3 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -7,10 +7,10 @@ synopsis: Static file serving subsite for Yesod Web Framework. category: Web, Yesod stability: Stable-cabal-version: >= 1.8+cabal-version: >= 1.10 build-type: Simple homepage: http://www.yesodweb.com/-description: Static file serving subsite for Yesod Web Framework.+description: API docs and the README are available at <http://www.stackage.org/package/yesod-static> extra-source-files: sample.hs sample-embed.hs@@ -22,44 +22,40 @@ test/embed-dir/foo test/embed-dir/lorem.txt test/embed-dir/abc/def.txt+ ChangeLog.md+ README.md library- build-depends: base >= 4 && < 5- , containers >= 0.2- , old-time >= 1.0- , yesod-core >= 1.2 && < 1.3+ default-language: Haskell2010+ build-depends: base >= 4.11 && < 5+ , async+ , attoparsec >= 0.10 , base64-bytestring >= 0.1.0.1- , byteable >= 0.1+ , blaze-builder >= 0.3 , bytestring >= 0.9.1.4- , template-haskell+ , conduit >= 1.3+ , containers >= 0.2+ , crypton >= 1.0+ , crypton-conduit >= 0.2.3+ , css-text >= 0.1.2+ , data-default , directory >= 1.0- , transformers >= 0.2.2- , wai-app-static >= 1.3.2- , wai >= 1.3- , text >= 0.9 , file-embed >= 0.0.4.1 && < 0.5+ , filepath >= 1.3+ , hashable >= 1.1+ , hjsmin , http-types >= 0.7- , unix-compat >= 0.2- , conduit >= 0.5- , conduit-extra- , cryptohash-conduit >= 0.1- , cryptohash >= 0.11- , system-filepath >= 0.4.6 && < 0.5- , system-fileio >= 0.3- , data-default- , shakespeare-css >= 1.0.3+ , memory , mime-types >= 0.1- , hjsmin- , filepath >= 1.3- , resourcet >= 0.4- , unordered-containers >= 0.2 , process- , async-- , attoparsec >= 0.10- , blaze-builder >= 0.3- , css-text >= 0.1.2- , hashable >= 1.1+ , template-haskell+ , text >= 0.9+ , transformers >= 0.2.2+ , unix-compat >= 0.2+ , unordered-containers >= 0.2+ , wai >= 1.3+ , wai-app-static >= 3.1+ , yesod-core >= 1.6 && < 1.8 exposed-modules: Yesod.Static Yesod.EmbeddedStatic@@ -71,54 +67,60 @@ Yesod.EmbeddedStatic.Css.Util ghc-options: -Wall- extensions: TemplateHaskell+ other-extensions: TemplateHaskell test-suite tests+ default-language: Haskell2010 hs-source-dirs: ., test main-is: tests.hs type: exitcode-stdio-1.0 cpp-options: -DTEST_EXPORT- build-depends: base+ other-modules: EmbedDevelTest+ EmbedProductionTest+ EmbedTestGenerator+ FileGeneratorTests+ GeneratorTestUtil+ Yesod.EmbeddedStatic+ Yesod.EmbeddedStatic.Generators+ Yesod.EmbeddedStatic.Internal+ Yesod.EmbeddedStatic.Types+ Yesod.Static+ YesodStaticTest+ build-depends: base < 5 , hspec >= 1.3- , yesod-test >= 1.2- , wai-test+ , yesod-test >= 1.6 , wai-extra , HUnit -- copy from above- , containers- , old-time- , yesod-core+ , async , base64-bytestring , bytestring- , byteable- , template-haskell+ , conduit+ , containers+ , crypton+ , crypton-conduit+ , data-default , directory- , transformers- , wai-app-static- , wai- , text , file-embed+ , filepath+ , hjsmin , http-types- , unix-compat- , conduit- , cryptohash-conduit- , cryptohash- , system-filepath- , system-fileio- , data-default- , shakespeare-css+ , memory , mime-types- , hjsmin- , filepath- , resourcet- , unordered-containers- , async , process- , conduit-extra+ , template-haskell+ , text+ , transformers+ , unix-compat+ , unordered-containers+ , wai+ , wai-app-static+ , yesod-core+ , rio ghc-options: -Wall -threaded- extensions: TemplateHaskell+ other-extensions: TemplateHaskell source-repository head type: git