yesod-static 1.4.0.4 → 1.5.0
raw patch · 5 files changed
+57/−61 lines, 5 filesdep −system-fileiodep −system-filepathdep ~wai-app-static
Dependencies removed: system-fileio, system-filepath
Dependency ranges changed: wai-app-static
Files
- ChangeLog.md +4/−0
- Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs +5/−6
- Yesod/EmbeddedStatic/Css/Util.hs +12/−13
- Yesod/Static.hs +35/−37
- yesod-static.cabal +1/−5
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.5.0++* Drop system-filepath+ ## 1.4.0.3 Fix bug when `StaticRoute` constructor is not imported.
Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs view
@@ -11,7 +11,6 @@ , absCssUrlsProd ) where -import Prelude hiding (FilePath) import Yesod.EmbeddedStatic.Generators import Yesod.EmbeddedStatic.Types @@ -22,7 +21,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 +34,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 +46,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 +73,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,18 @@ {-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell, TupleSections, GeneralizedNewtypeDeriving #-} module Yesod.EmbeddedStatic.Css.Util where -import Prelude hiding (FilePath) 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,7 +62,7 @@ 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) @@ -79,9 +78,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 +100,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 +128,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 +157,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 +174,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 +189,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/Static.hs view
@@ -60,8 +60,6 @@ #endif ) where -import Prelude hiding (FilePath)-import qualified Prelude import System.Directory import Control.Monad import Data.FileEmbed (embedDir)@@ -96,9 +94,9 @@ 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 System.FilePath ((</>), (<.>), FilePath, takeDirectory)+import qualified System.FilePath as F+import System.Directory (createDirectoryIfMissing) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import Data.Default@@ -123,18 +121,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 +146,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@@ -178,14 +176,14 @@ where Static set = ysreGetSub $ yreSite $ ysreParentEnv -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@@ -232,7 +230,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@@ -245,11 +243,11 @@ -- -- 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) True where- split :: Prelude.FilePath -> [String]+ split :: FilePath -> [String] split [] = [] split x = let (a, b) = break (== '/') x@@ -265,38 +263,38 @@ -- 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 :: FilePath -> Q [Dec] publicFiles dir = mkStaticFiles' dir False -mkHashMap :: Prelude.FilePath -> IO (M.Map F.FilePath S8.ByteString)+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,15 +303,15 @@ 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 :: FilePath -> Q [Dec] mkStaticFiles fp = mkStaticFiles' fp True -mkStaticFiles' :: Prelude.FilePath -- ^ static directory+mkStaticFiles' :: FilePath -- ^ static directory -> Bool -- ^ append checksum query parameter -> Q [Dec] mkStaticFiles' fp makeHash = do@@ -321,7 +319,7 @@ mkStaticFilesList fp fs makeHash mkStaticFilesList- :: Prelude.FilePath -- ^ static directory+ :: FilePath -- ^ static directory -> [[String]] -- ^ list of files to create identifiers for -> Bool -- ^ append checksum query parameter -> Q [Dec]@@ -355,7 +353,7 @@ ] ] -base64md5File :: Prelude.FilePath -> IO String+base64md5File :: FilePath -> IO String base64md5File = fmap (base64 . encode) . hashFile where encode d = Byteable.toBytes (d :: Digest MD5) @@ -402,18 +400,18 @@ ltext <- qRunIO $ preProcess $ TL.fromChunks 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 =$= CT.decode CT.utf8 postProcess = case combineType of JS -> csJsPostProcess@@ -435,7 +433,7 @@ -- -- Since 1.2.0 data CombineSettings = CombineSettings- { csStaticDir :: F.FilePath+ { csStaticDir :: FilePath -- ^ File path containing static files. -- -- Default: static
yesod-static.cabal view
@@ -1,5 +1,5 @@ name: yesod-static-version: 1.4.0.4+version: 1.5.0 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -46,8 +46,6 @@ , conduit-extra , cryptohash-conduit >= 0.1 , cryptohash >= 0.11- , system-filepath >= 0.4.6 && < 0.5- , system-fileio >= 0.3 , data-default , mime-types >= 0.1 , hjsmin@@ -104,8 +102,6 @@ , conduit , cryptohash-conduit , cryptohash- , system-filepath- , system-fileio , data-default , mime-types , hjsmin