diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +## yesod-static + +Static file serving subsite for Yesod Web Framework. diff --git a/Yesod/EmbeddedStatic.hs b/Yesod/EmbeddedStatic.hs --- a/Yesod/EmbeddedStatic.hs +++ b/Yesod/EmbeddedStatic.hs @@ -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 diff --git a/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs b/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs --- a/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs +++ b/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs @@ -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 diff --git a/Yesod/EmbeddedStatic/Css/Util.hs b/Yesod/EmbeddedStatic/Css/Util.hs --- a/Yesod/EmbeddedStatic/Css/Util.hs +++ b/Yesod/EmbeddedStatic/Css/Util.hs @@ -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 diff --git a/Yesod/EmbeddedStatic/Generators.hs b/Yesod/EmbeddedStatic/Generators.hs --- a/Yesod/EmbeddedStatic/Generators.hs +++ b/Yesod/EmbeddedStatic/Generators.hs @@ -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 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| -- >

Hello --- >

Check the +-- >

Check the -- > compile time -- >|] -- > diff --git a/Yesod/EmbeddedStatic/Internal.hs b/Yesod/EmbeddedStatic/Internal.hs --- a/Yesod/EmbeddedStatic/Internal.hs +++ b/Yesod/EmbeddedStatic/Internal.hs @@ -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 diff --git a/Yesod/EmbeddedStatic/Types.hs b/Yesod/EmbeddedStatic/Types.hs --- a/Yesod/EmbeddedStatic/Types.hs +++ b/Yesod/EmbeddedStatic/Types.hs @@ -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. diff --git a/Yesod/Static.hs b/Yesod/Static.hs --- a/Yesod/Static.hs +++ b/Yesod/Static.hs @@ -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 = diff --git a/sample-embed.hs b/sample-embed.hs --- a/sample-embed.hs +++ b/sample-embed.hs @@ -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. -- diff --git a/sample.hs b/sample.hs --- a/sample.hs +++ b/sample.hs @@ -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) diff --git a/test/EmbedDevelTest.hs b/test/EmbedDevelTest.hs --- a/test/EmbedDevelTest.hs +++ b/test/EmbedDevelTest.hs @@ -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 diff --git a/test/EmbedProductionTest.hs b/test/EmbedProductionTest.hs --- a/test/EmbedProductionTest.hs +++ b/test/EmbedProductionTest.hs @@ -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\");" diff --git a/test/EmbedTestGenerator.hs b/test/EmbedTestGenerator.hs --- a/test/EmbedTestGenerator.hs +++ b/test/EmbedTestGenerator.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + module EmbedTestGenerator (testGen) where import Data.Default diff --git a/test/FileGeneratorTests.hs b/test/FileGeneratorTests.hs --- a/test/FileGeneratorTests.hs +++ b/test/FileGeneratorTests.hs @@ -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" diff --git a/test/GeneratorTestUtil.hs b/test/GeneratorTestUtil.hs --- a/test/GeneratorTestUtil.hs +++ b/test/GeneratorTestUtil.hs @@ -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) diff --git a/yesod-static.cabal b/yesod-static.cabal --- a/yesod-static.cabal +++ b/yesod-static.cabal @@ -1,5 +1,5 @@ name: yesod-static -version: 1.2.4 +version: 1.6.1.3 license: MIT license-file: LICENSE author: Michael Snoyman @@ -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 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