diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,35 @@ +# 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 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 @@ -49,7 +49,6 @@ , module Yesod.EmbeddedStatic.Generators ) where -import Control.Applicative as A ((<$>)) import Data.IORef import Data.Maybe (catMaybes) import Language.Haskell.TH @@ -57,10 +56,7 @@ import Network.Wai (responseLBS, pathInfo) import Network.Wai.Application.Static (staticApp) import System.IO.Unsafe (unsafePerformIO) -import Yesod.Core - ( HandlerT - , YesodSubDispatch(..) - ) +import Yesod.Core (YesodSubDispatch(..)) import Yesod.Core.Types ( YesodSubRunnerEnv(..) , YesodRunnerEnv(..) @@ -81,7 +77,7 @@ embeddedResourceR :: [T.Text] -> [(T.Text, T.Text)] -> Route EmbeddedStatic embeddedResourceR = EmbeddedResourceR -instance YesodSubDispatch EmbeddedStatic (HandlerT master IO) where +instance YesodSubDispatch EmbeddedStatic master where yesodSubDispatch YesodSubRunnerEnv {..} req = resp where master = yreSite ysreParentEnv @@ -101,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 @@ -135,7 +131,7 @@ -> [Generator] -- ^ the generators (see "Yesod.EmbeddedStatic.Generators") -> Q [Dec] mkEmbeddedStatic dev esName gen = do - entries <- concat A.<$> sequence gen + entries <- concat <$> sequence gen computed <- runIO $ mapM (if dev then devEmbed else prodEmbed) entries let settings = Static.mkSettings $ return $ map cStEntry computed 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) 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,10 +1,14 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell, TupleSections, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} + module Yesod.EmbeddedStatic.Css.Util where -import Control.Applicative +import Control.Applicative ((<|>)) import Control.Monad (void, foldM) import Data.Hashable (Hashable) -import Data.Monoid import Network.Mime (MimeType, defaultMimeLookup) import Text.CSS.Parse (parseBlocks) import Language.Haskell.TH (litE, stringL) @@ -68,8 +72,7 @@ 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 ] 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,17 +27,15 @@ -- * Util , pathToName - + -- * Custom Generators - + -- $example ) where -import Control.Applicative as A ((<$>), (<*>)) import Control.Exception (try, SomeException) import Control.Monad (forM, when) -import Data.Char (isDigit, isLower) -import Data.Conduit (($$)) +import Data.Char (isLower) import Data.Default (def) import Data.Maybe (isNothing) import Language.Haskell.TH @@ -44,13 +45,13 @@ 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 @@ -82,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 @@ -94,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). @@ -113,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 @@ -208,13 +209,13 @@ } (Just hin, Just hout, _, ph) <- Proc.createProcess p (compressed, (), code) <- runConcurrently $ (,,) - A.<$> Concurrently (sourceHandle hout $$ C.consume) - A.<*> Concurrently (BL.hPut hin ct >> hClose hin) - A.<*> Concurrently (Proc.waitForProcess ph) + <$> 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 @@ -247,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 @@ -296,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 -- > @@ -322,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 as A ((<$>)) import Data.IORef import Language.Haskell.TH import Network.HTTP.Types (Status(..), status404, status200, status304) @@ -25,7 +24,7 @@ import Network.Wai.Application.Static (defaultWebAppSettings, staticApp) import WaiAppStatic.Types import Yesod.Core - ( HandlerT + ( HandlerFor , ParseRoute(..) , RenderRoute(..) , getYesod @@ -40,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 @@ -136,7 +125,7 @@ -- | 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 :: (site -> EmbeddedStatic) @@ -144,7 +133,7 @@ -> (BL.ByteString -> Either a BL.ByteString) -> AddStaticContent site staticContentHelper getStatic staticR minify ext _ ct = do - wIORef <- widgetFiles . getStatic A.<$> getYesod + wIORef <- widgetFiles . getStatic <$> getYesod let hash = T.pack $ base64md5 ct hash' = Just $ T.encodeUtf8 hash filename = T.concat [hash, ".", ext] 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,12 +1,12 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} --------------------------------------------------------- -- -- | Serve static files from a Yesod app. @@ -68,17 +68,15 @@ 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 import Crypto.Hash.Conduit (hashFile, sinkHash) import Crypto.Hash (MD5, Digest) -import Control.Monad.Catch (MonadThrow) import Control.Monad.Trans.State import qualified Data.ByteArray as ByteArray @@ -89,16 +87,12 @@ 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 Conduit import System.FilePath ((), (<.>), takeDirectory) import qualified System.FilePath as F import qualified Data.Text.Lazy as TL @@ -175,12 +169,10 @@ instance ParseRoute Static where parseRoute (x, y) = Just $ StaticRoute x y -instance (MonadThrow m, MonadIO m, MonadBaseControl IO m) - => YesodSubDispatch Static (HandlerT master m) where +instance YesodSubDispatch Static master where yesodSubDispatch YesodSubRunnerEnv {..} req = - ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route) req + ysreParentRunner handlert ysreParentEnv (fmap ysreToParentRoute route) req where - base = stripHandlerT handlert ysreGetSub ysreToParentRoute route route = Just $ StaticRoute (pathInfo req) [] Static set = ysreGetSub $ yreSite $ ysreParentEnv @@ -200,7 +192,7 @@ -> ([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 @@ -400,11 +392,10 @@ 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)|] qs <- if makeHash @@ -425,8 +416,8 @@ base64md5 :: L.ByteString -> String base64md5 lbs = base64 $ encode - $ runIdentity - $ sourceList (L.toChunks lbs) $$ sinkHash + $ runConduitPure + $ Conduit.sourceLazy lbs .| sinkHash where encode d = ByteArray.convert (d :: Digest MD5) @@ -461,8 +452,11 @@ -> [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 hash' <.> extension @@ -476,7 +470,7 @@ fps :: [FilePath] fps = map toFP routes toFP (StaticRoute pieces _) = csStaticDir F.joinPath (map T.unpack pieces) - readUTFFile fp = sourceFile fp =$= CT.decode CT.utf8 + readUTFFile fp = sourceFile fp .| decodeUtf8C postProcess = case combineType of JS -> csJsPostProcess 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 @@ -82,7 +85,7 @@ 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 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 @@ -21,19 +24,23 @@ -- | Creates a GenTestResult at compile time by testing the entry. testEntry :: Maybe String -> Y.Location -> IO BL.ByteString -> Entry -> ExpQ -testEntry name _ _ e | ebHaskellName e /= (mkName Control.Applicative.<$> name) = +testEntry name _ _ e | ebHaskellName e /= (mkName <$> name) = [| GenError ("haskell name " ++ $(litE $ stringL $ show $ ebHaskellName e) ++ " /= " ++ $(litE $ stringL $ show name)) |] 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)) |] +-- | 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" |] @@ -48,12 +55,13 @@ 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.5.3.1 +version: 1.6.1.3 license: MIT license-file: LICENSE author: Michael Snoyman @@ -7,7 +7,7 @@ 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: API docs and the README are available at @@ -26,41 +26,36 @@ README.md library - build-depends: base >= 4 && < 5 - , containers >= 0.2 - , old-time >= 1.0 - , yesod-core >= 1.4 && < 1.5 + 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 >= 3.1 - , 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 - , cryptonite-conduit >= 0.1 - , cryptonite >= 0.11 , memory - , data-default , 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 - , exceptions + , 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 @@ -72,9 +67,10 @@ 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 @@ -90,45 +86,41 @@ Yesod.EmbeddedStatic.Types Yesod.Static YesodStaticTest - build-depends: base + build-depends: base < 5 , hspec >= 1.3 - , yesod-test >= 1.4 + , 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 - , cryptonite-conduit - , cryptonite , memory - , data-default , mime-types - , hjsmin - , filepath - , resourcet - , unordered-containers - , async , process - , conduit-extra - , exceptions + , 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