Drop system-filepath

2015-05-12 12:35:04 +03:00 · 2015-05-12 12:35:04 +03:00 · 48a3bdeadb
commit 48a3bdeadb
parent ae555aa6f0
5 changed files with 57 additions and 61 deletions
--- 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.
--- 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
--- 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
--- 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
--- 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 <michael@snoyman.com>
@ -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