From 48a3bdeadb04cc43e1f9de14ff6a3131b52589ea Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 12 May 2015 12:35:04 +0300 Subject: [PATCH] Drop system-filepath --- yesod-static/ChangeLog.md | 4 ++ .../Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs | 11 ++- yesod-static/Yesod/EmbeddedStatic/Css/Util.hs | 25 ++++--- yesod-static/Yesod/Static.hs | 72 +++++++++---------- yesod-static/yesod-static.cabal | 6 +- 5 files changed, 57 insertions(+), 61 deletions(-) diff --git a/yesod-static/ChangeLog.md b/yesod-static/ChangeLog.md index 96770c38..ff9e22c3 100644 --- a/yesod-static/ChangeLog.md +++ b/yesod-static/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.5.0 + +* Drop system-filepath + ## 1.4.0.3 Fix bug when `StaticRoute` constructor is not imported. diff --git a/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs b/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs index 19a9a1fb..a29aaece 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Css/AbsoluteUrl.hs @@ -11,7 +11,6 @@ module Yesod.EmbeddedStatic.Css.AbsoluteUrl ( , absCssUrlsProd ) where -import Prelude hiding (FilePath) import Yesod.EmbeddedStatic.Generators import Yesod.EmbeddedStatic.Types @@ -22,7 +21,7 @@ import qualified Data.Text.IO as T 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 @@ absCssUrlsFileProd :: FilePath -- ^ Anchor relative urls to here -> 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 @@ absCssUrlsProd dir contents = 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 @@ absoluteUrlsWith :: -> 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-static/Yesod/EmbeddedStatic/Css/Util.hs b/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs index 2b0bd504..e3a49a41 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Css/Util.hs @@ -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 :: T.Text -> T.Text -> EithUrl 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 @@ parseCssUrls = parseCssWith checkForUrl 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 @@ loadImages dir css loadImage = foldM load M.empty $ concat [map snd block | (_,b 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 @@ cssProductionFilter prodFilter loc file = , 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 @@ parseBackground loc file = do 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 @@ parseDev loc file b = do (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 :: Location -> [T.Text] -> IO (Maybe (MimeType, BL.ByteString)) 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-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs index a18d88ef..81da1be6 100644 --- a/yesod-static/Yesod/Static.hs +++ b/yesod-static/Yesod/Static.hs @@ -60,8 +60,6 @@ module Yesod.Static #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.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 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 @@ type StaticRoute = Route Static -- 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 @@ staticDevel dir = do -- 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 @@ instance YesodSubDispatch Static m where 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 @@ getFileListPieces = flip evalStateT M.empty . flip go id -- 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 @@ staticFiles dir = mkStaticFiles dir -- -- 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 @@ staticFilesList dir fs = -- 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 @@ cachedETagLookupDevel dir = do 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 @@ mkStaticFiles' fp makeHash = do 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 @@ mkStaticFilesList fp fs makeHash = do ] ] -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 @@ combineStatics' combineType CombineSettings {..} routes = do 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 @@ combineStatics' combineType CombineSettings {..} routes = do -- -- Since 1.2.0 data CombineSettings = CombineSettings - { csStaticDir :: F.FilePath + { csStaticDir :: FilePath -- ^ File path containing static files. -- -- Default: static diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index 4ccb0d7a..51728024 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -1,5 +1,5 @@ name: yesod-static -version: 1.4.0.4 +version: 1.5.0 license: MIT license-file: LICENSE author: Michael Snoyman @@ -46,8 +46,6 @@ library , 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 @@ test-suite tests , conduit , cryptohash-conduit , cryptohash - , system-filepath - , system-fileio , data-default , mime-types , hjsmin