diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -71,3 +71,8 @@ ## 0.1.4.5 -- 2023-07-14 * Fixing documentation for Yesod.Static.Streamly. + +## 0.1.5.1 -- 2023-07-17 + +* Added combineStylesheetsStreamly' and combineScriptsStreamly' replacement functions in Yesod.Static.Streamly. +* Added CombineTypeStreamly(..), CombineSettingsStreamly(..), liftRoutesStreamly, combineStaticsStreamly' and base64md5Streamly in Yesod.Static.Streamly.Internal. diff --git a/src/Yesod/Static/Streamly.hs b/src/Yesod/Static/Streamly.hs --- a/src/Yesod/Static/Streamly.hs +++ b/src/Yesod/Static/Streamly.hs @@ -21,6 +21,9 @@ module Yesod.Static.Streamly ( -- * Yesod.Static Replacement functions - Smart constructor staticStreamly, staticDevelStreamly, + -- * Yesod.Static Replacement functions - Combining CSS/JS + combineStylesheetsStreamly', + combineScriptsStreamly', -- * Yesod.Static Replacement functions - Template Haskell helpers staticFilesStreamly, staticFilesListStreamly, @@ -60,6 +63,33 @@ hashLookup <- cachedETagLookupDevelStreamly dir size return $ Static $ webAppSettingsWithLookup dir hashLookup + +-- | A more performant replacement of +-- [combineStylesheets'](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:combineStylesheets-39-) +-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html). +combineStylesheetsStreamly' :: Bool -- ^ development? if so, perform no combining + -> CombineSettingsStreamly + -> Name -- ^ Static route constructor name, e.g. \'StaticR + -> [Route Static] -- ^ files to combine + -> Int -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.) + -> Q Exp +combineStylesheetsStreamly' development cs con routes size + | development = [| mapM_ (addStylesheet . $(return $ ConE con)) $(liftRoutesStreamly routes) |] + | otherwise = [| addStylesheet $ $(return $ ConE con) $(combineStaticsStreamly' CSS cs routes size) |] + +-- | A more performant replacement of +-- [combineScripts'](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:combineScripts-39-) +-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html). +combineScriptsStreamly' :: Bool -- ^ development? if so, perform no combining + -> CombineSettingsStreamly + -> Name -- ^ Static route constructor name, e.g. \'StaticR + -> [Route Static] -- ^ files to combine + -> Int -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.) + -> Q Exp +combineScriptsStreamly' development cs con routes size + | development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutesStreamly routes) |] + | otherwise = [| addScript $ $(return $ ConE con) $(combineStaticsStreamly' JS cs routes size) |] + -- | A more performant replacement of -- [staticFiles](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:staticFiles) diff --git a/src/Yesod/Static/Streamly/Internal.hs b/src/Yesod/Static/Streamly/Internal.hs --- a/src/Yesod/Static/Streamly/Internal.hs +++ b/src/Yesod/Static/Streamly/Internal.hs @@ -47,7 +47,12 @@ notHiddenStreamly, getFileListPiecesStreamly, pathFromRawPiecesStreamly, + CombineTypeStreamly(..), + CombineSettingsStreamly(..), + liftRoutesStreamly, + combineStaticsStreamly', base64md5FileStreamly, + base64md5Streamly, base64Streamly, hashFileStreamly, sinkHashStreamly @@ -58,21 +63,27 @@ import "cryptonite" Crypto.Hash.IO (HashAlgorithm) import qualified Data.ByteArray as ByteArray import Data.ByteString as B (ByteString) -import Data.ByteString.Lazy as L (ByteString) +import Data.ByteString.Lazy as L (ByteString,concat,writeFile) import qualified Data.ByteString.Base64 import qualified Data.ByteString.Char8 as S8 import Data.Char (isLower,isDigit) +import Data.Default import Data.IORef (readIORef,newIORef,writeIORef) import Data.List (foldl',intercalate,sort) import qualified Data.Map as M -import Data.Text (pack) +--import Data.Text (pack) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE import Language.Haskell.TH import Language.Haskell.TH.Syntax as TH import qualified Streamly.Data.Stream as S import Streamly.External.ByteString.Lazy as StreamlyLByteString (fromChunksIO) import Streamly.Internal.FileSystem.File as StreamlyInternalFile (chunkReaderWith) import Streamly.Internal.System.IO (arrayPayloadSize) -import System.Directory (doesDirectoryExist,doesFileExist,getDirectoryContents) +import System.Directory (createDirectoryIfMissing,doesDirectoryExist,doesFileExist,getDirectoryContents) +import System.FilePath ((), (<.>), takeDirectory) +import qualified System.FilePath as F import System.PosixCompat.Files (getFileStatus,modificationTime) import System.Posix.Types (EpochTime) import WaiAppStatic.Storage.Filesystem (ETagLookup) @@ -114,7 +125,7 @@ -> Int -- ^ buffer size -> Q [Dec] mkStaticFilesListStreamly' fp fs makeHash size = - concat `fmap` mapM mkRoute fs + Prelude.concat `fmap` mapM mkRoute fs where replace' c | 'A' <= c && c <= 'Z' = c @@ -221,7 +232,7 @@ files'' <- mapM dedupe files' dirs <- liftIO $ filterM (doesDirectoryExist . fullPath) allContents dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs - return $ concat $ files'' : dirs' + return $ Prelude.concat $ files'' : dirs' -- Reuse data buffers for identical strings dedupe :: [String] @@ -248,12 +259,151 @@ append a b = a ++ '/' : b -- | A replacement of +-- [CombineType](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#CombineType). +data CombineTypeStreamly = JS | CSS + +-- | A replacement of +-- [CombineSettings](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#t:CombineSettings). +data CombineSettingsStreamly = CombineSettingsStreamly + { csStaticDir :: FilePath + -- ^ File path containing static files. + -- + -- Default: static + -- + -- Since 1.2.0 + , csCssPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString + -- ^ Post processing to be performed on CSS files. + -- + -- Default: Pass-through. + -- + -- Since 1.2.0 + , csJsPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString + -- ^ Post processing to be performed on Javascript files. + -- + -- Default: Pass-through. + -- + -- Since 1.2.0 + , csCssPreProcess :: TL.Text -> IO TL.Text + -- ^ Pre-processing to be performed on CSS files. + -- + -- Default: convert all occurences of /static/ to ../ + -- + -- Since 1.2.0 + , csJsPreProcess :: TL.Text -> IO TL.Text + -- ^ Pre-processing to be performed on Javascript files. + -- + -- Default: Pass-through. + -- + -- Since 1.2.0 + , csCombinedFolder :: FilePath + -- ^ Subfolder to put combined files into. + -- + -- Default: combined + -- + -- Since 1.2.0 + } + +instance Default CombineSettingsStreamly where + def = CombineSettingsStreamly + { csStaticDir = "static" + {- Disabled due to: https://github.com/yesodweb/yesod/issues/623 + , csCssPostProcess = \fps -> + either (error . (errorIntro fps)) (return . TLE.encodeUtf8) + . flip luciusRTMinified [] + . TLE.decodeUtf8 + -} + , csCssPostProcess = const return + , csJsPostProcess = const return + -- FIXME The following borders on a hack. With combining of files, + -- the final location of the CSS is no longer fixed, so relative + -- references will break. Instead, we switched to using /static/ + -- absolute references. However, when served from a separate domain + -- name, this will break too. The solution is that, during + -- development, we keep /static/, and in the combining phase, we + -- replace /static with a relative reference to the parent folder. + , csCssPreProcess = + return + . TL.replace "'/static/" "'../" + . TL.replace "\"/static/" "\"../" + , csJsPreProcess = return + , csCombinedFolder = "combined" + } + +-- | A replacement of +-- [liftRoutes](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#liftRoutes). +liftRoutesStreamly :: [Route Static] + -> Q Exp +liftRoutesStreamly = + fmap ListE . mapM go + where + go :: Route Static -> Q Exp + go (StaticRoute x y) = [|StaticRoute $(liftTexts x) $(liftPairs y)|] + + liftTexts = fmap ListE . mapM liftT + liftT t = [|pack $(TH.lift $ T.unpack t)|] + + liftPairs = fmap ListE . mapM liftPair + liftPair (x, y) = [|($(liftT x), $(liftT y))|] + +-- | A replacement of +-- [combineStatics'](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#combineStatics'). +combineStaticsStreamly' :: CombineTypeStreamly + -> CombineSettingsStreamly + -> [Route Static] -- ^ files to combine + -> Int + -> Q Exp +combineStaticsStreamly' combineType CombineSettingsStreamly {..} routes size = do + texts <- qRunIO $ mapM (\fp -> do let lazyfile = S.unfold StreamlyInternalFile.chunkReaderWith (arrayPayloadSize (size * 1024),fp) + lazybs <- liftIO $ StreamlyLByteString.fromChunksIO lazyfile + return lazybs + ) + fps + let textss = L.concat texts + let textsss = TLE.decodeUtf8 textss + ltext <- qRunIO $ preProcess textsss + bs <- qRunIO $ postProcess fps $ TLE.encodeUtf8 ltext + let hash' = base64md5Streamly bs + suffix = csCombinedFolder hash' <.> extension + fp = csStaticDir suffix + qRunIO $ do + createDirectoryIfMissing True $ takeDirectory fp + L.writeFile fp bs + let pieces = map T.unpack $ T.splitOn "/" $ T.pack suffix + [|StaticRoute (map pack pieces) []|] + where + fps :: [FilePath] + fps = map toFP routes + toFP (StaticRoute pieces _) = csStaticDir F.joinPath (map T.unpack pieces) + postProcess = + case combineType of + JS -> csJsPostProcess + CSS -> csCssPostProcess + preProcess = + case combineType of + JS -> csJsPreProcess + CSS -> csCssPreProcess + extension = + case combineType of + JS -> "js" + CSS -> "css" + +-- | A replacement of -- [base64md5File](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#base64md5File). base64md5FileStreamly :: FilePath -> Int -> IO String base64md5FileStreamly fp size = fmap (base64Streamly . encode) $ (hashFileStreamly fp size) where encode d = ByteArray.convert (d :: Crypto.Hash.Digest MD5) + +-- | A replacement of +-- [base64md5](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:base64md5). +base64md5Streamly :: L.ByteString + -> String +base64md5Streamly lbs = do + let hashedlbs = hashlazy lbs + base64Streamly $ encode hashedlbs + where + encode d = ByteArray.convert (d :: Digest MD5) -- | A replacement of -- [base64](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#base64). diff --git a/yesod-static-streamly.cabal b/yesod-static-streamly.cabal --- a/yesod-static-streamly.cabal +++ b/yesod-static-streamly.cabal @@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.4.5 +version: 0.1.5.1 -- A short (one-line) description of the package. synopsis: A streamly-based library providing performance-focused alternatives for functionality found in yesod-static. @@ -83,6 +83,7 @@ bytestring >= 0.11.4 && < 0.12, containers >= 0.6.7 && < 0.7, cryptonite >= 0.30 && < 0.31, + data-default >= 0.7.1 && < 0.8, directory >= 1.3.7 && < 1.4, filepath >= 1.4.2 && < 1.5, memory >= 0.18.0 && < 0.19,