Shared: Added collapseFilePath function

This function removes intermediate "." and ".." from a path.
This commit is contained in:
Matthew Pickering 2014-08-08 20:10:58 +01:00
parent 116f03a70a
commit 2d956677ef

View file

@ -80,6 +80,7 @@ module Text.Pandoc.Shared (
fetchItem,
fetchItem',
openURL,
collapseFilePath,
-- * Error handling
err,
warn,
@ -105,6 +106,7 @@ import Network.URI ( escapeURIString, isURI, nonStrictRelativeTo,
unEscapeString, parseURIReference, isAllowedInURI )
import qualified Data.Set as Set
import System.Directory
import System.FilePath (joinPath, splitDirectories)
import Text.Pandoc.MIME (getMimeType)
import System.FilePath ( (</>), takeExtension, dropExtension)
import Data.Generics (Typeable, Data)
@ -854,6 +856,29 @@ warn msg = do
name <- getProgName
UTF8.hPutStrLn stderr $ name ++ ": " ++ msg
-- | Remove intermediate "." and ".." directories from a path.
--
-- @
-- collapseFilePath "./foo" == "foo"
-- collapseFilePath "/bar/../baz" == "/baz"
-- collapseFilePath "/../baz" == "/../baz"
-- collapseFilePath "parent/foo/baz/../bar" == "parent/foo/bar"
-- collapseFilePath "parent/foo/baz/../../bar" == "parent/bar"
-- collapseFilePath "parent/foo/.." == "parent"
-- collapseFilePath "/parent/foo/../../bar" == "/bar"
-- @
collapseFilePath :: FilePath -> FilePath
collapseFilePath = joinPath . reverse . foldl go [] . splitDirectories
where
go rs "." = rs
go r@(p:rs) ".." = case p of
".." -> ("..":r)
"/" -> ("..":r)
_ -> rs
go _ "/" = ["/"]
go rs x = x:rs
--
-- Safe read
--