{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module: Filesystem.Path
-- Copyright: 2010 John Millikin
-- License: MIT
--
-- Maintainer: jmillikin@gmail.com
-- Portability: portable
--
-- High‐level, byte‐based file and directory path
-- manipulations. You probably want to import "Filesystem.Path.CurrentOS"
-- instead, since it handles detecting which rules to use in the current
-- compilation.
--
module Filesystem.Path
( FilePath
, empty
-- * Basic properties
, null
, root
, directory
, parent
, filename
, dirname
, basename
, absolute
, relative
-- * Basic operations
, append
, (</>)
, concat
, commonPrefix
, stripPrefix
, collapse
-- * Extensions
, extension
, extensions
, hasExtension
, addExtension
, (<.>)
, dropExtension
, replaceExtension
, addExtensions
, dropExtensions
, replaceExtensions
, splitExtension
, splitExtensions
) where
import Prelude hiding (FilePath, concat, null)
import Data.List (foldl')
import Data.Maybe (isNothing)
import qualified Data.Monoid as M
import qualified Data.Text as T
import Filesystem.Path.Internal
instance M.Monoid FilePath where
mempty = empty
mappend = append
mconcat = concat
-------------------------------------------------------------------------------
-- Basic properties
-------------------------------------------------------------------------------
-- | @null p = (p == 'empty')@
null :: FilePath -> Bool
null = (== empty)
-- | Retrieves the 'FilePath'’s root.
root :: FilePath -> FilePath
root p = empty { pathRoot = pathRoot p }
-- | Retrieves the 'FilePath'’s directory. If the path is already a
-- directory, it is returned unchanged.
directory :: FilePath -> FilePath
directory p = empty
{ pathRoot = pathRoot p
, pathDirectories = let
starts = map Just [dot, dots]
dot' | safeHead (pathDirectories p) `elem` starts = []
| isNothing (pathRoot p) = [dot]
| otherwise = []
in dot' ++ pathDirectories p
}
-- | Retrieves the 'FilePath'’s parent directory.
parent :: FilePath -> FilePath
parent p = empty
{ pathRoot = pathRoot p
, pathDirectories = let
starts = map Just [dot, dots]
directories = if null (filename p)
then safeInit (pathDirectories p)
else pathDirectories p
dot' | safeHead directories `elem` starts = []
| isNothing (pathRoot p) = [dot]
| otherwise = []
in dot' ++ directories
}
-- | Retrieve a 'FilePath'’s filename component.
--
-- @
-- filename \"foo/bar.txt\" == \"bar.txt\"
-- @
filename :: FilePath -> FilePath
filename p = empty
{ pathBasename = pathBasename p
, pathExtensions = pathExtensions p
}
-- | Retrieve a 'FilePath'’s directory name. This is only the
-- /file name/ of the directory, not its full path.
--
-- @
-- dirname \"foo/bar/baz.txt\" == \"bar\"
-- dirname \"/\" == \"\"
-- @
--
-- Since: 0.3.2
dirname :: FilePath -> FilePath
dirname p = case reverse (pathDirectories p) of
[] -> FilePath Nothing [] Nothing []
(d:_) -> let
d':exts = T.split (== '.') (chunkText d)
chunk txt = d { chunkText = txt }
in FilePath Nothing [] (Just (chunk d')) (map chunk exts)
-- | Retrieve a 'FilePath'’s basename component.
--
-- @
-- basename \"foo/bar.txt\" == \"bar\"
-- @
basename :: FilePath -> FilePath
basename p = empty
{ pathBasename = pathBasename p
}
-- | Test whether a path is absolute.
absolute :: FilePath -> Bool
absolute p = case pathRoot p of
Just RootPosix -> True
Just (RootWindowsVolume _) -> True
_ -> False
-- | Test whether a path is relative.
relative :: FilePath -> Bool
relative p = case pathRoot p of
Just _ -> False
_ -> True
-------------------------------------------------------------------------------
-- Basic operations
-------------------------------------------------------------------------------
-- | Appends two 'FilePath's. If the second path is absolute, it is returned
-- unchanged.
append :: FilePath -> FilePath -> FilePath
append x y = cased where
cased = case pathRoot y of
Just RootPosix -> y
Just (RootWindowsVolume _) -> y
Just RootWindowsCurrentVolume -> case pathRoot x of
Just (RootWindowsVolume _) -> y { pathRoot = pathRoot x }
_ -> y
Nothing -> xy
xy = y
{ pathRoot = pathRoot x
, pathDirectories = directories
}
directories = xDirectories ++ pathDirectories y
xDirectories = (pathDirectories x ++) $ if null (filename x)
then []
else [filenameChunk True x]
-- | An alias for 'append'.
(</>) :: FilePath -> FilePath -> FilePath
(</>) = append
-- | A fold over 'append'.
concat :: [FilePath] -> FilePath
concat [] = empty
concat ps = foldr1 append ps
-- | Find the greatest common prefix between a list of 'FilePath's.
commonPrefix :: [FilePath] -> FilePath
commonPrefix [] = empty
commonPrefix ps = foldr1 step ps where
step x y = if pathRoot x /= pathRoot y
then empty
else let cs = commonDirectories x y in
if cs /= pathDirectories x || pathBasename x /= pathBasename y
then empty { pathRoot = pathRoot x, pathDirectories = cs }
else let exts = commonExtensions x y in
x { pathExtensions = exts }
commonDirectories x y = common (pathDirectories x) (pathDirectories y)
commonExtensions x y = common (pathExtensions x) (pathExtensions y)
common [] _ = []
common _ [] = []
common (x:xs) (y:ys) = if x == y
then x : common xs ys
else []
-- Remove a prefix from a path.
--
-- @
-- stripPrefix "/foo/" "/foo/bar/baz.txt" == Just "bar/baz.txt"
-- stripPrefix "/foo/" "/bar/baz.txt" == Nothing
-- @
--
-- Since: 0.3.2
stripPrefix :: FilePath -> FilePath -> Maybe FilePath
stripPrefix x y = if pathRoot x /= pathRoot y
then case pathRoot x of
Nothing -> Just y
Just _ -> Nothing
else do
dirs <- strip (pathDirectories x) (pathDirectories y)
case dirs of
[] -> case (pathBasename x, pathBasename y) of
(Nothing, Nothing) -> do
exts <- strip (pathExtensions x) (pathExtensions y)
return (y { pathRoot = Nothing, pathDirectories = dirs, pathExtensions = exts })
(Nothing, Just _) -> case pathExtensions x of
[] -> Just (y { pathRoot = Nothing, pathDirectories = dirs })
_ -> Nothing
(Just x_b, Just y_b) | x_b == y_b -> do
exts <- strip (pathExtensions x) (pathExtensions y)
return (empty { pathExtensions = exts })
_ -> Nothing
_ -> case (pathBasename x, pathExtensions x) of
(Nothing, []) -> Just (y { pathRoot = Nothing, pathDirectories = dirs })
_ -> Nothing
strip :: Eq a => [a] -> [a] -> Maybe [a]
strip [] ys = Just ys
strip _ [] = Nothing
strip (x:xs) (y:ys) = if x == y
then strip xs ys
else Nothing
-- | Remove @\".\"@ and @\"..\"@ directories from a path.
--
-- Note that if any of the elements are symbolic links, 'collapse' may change
-- which file the path resolves to.
--
-- Since: 0.2
collapse :: FilePath -> FilePath
collapse p = p { pathDirectories = reverse newDirs } where
(_, newDirs) = foldl' step (True, []) (pathDirectories p)
step (True, acc) c = (False, c:acc)
step (_, acc) c | c == dot = (False, acc)
step (_, acc) c | c == dots = case acc of
[] -> (False, c:acc)
(h:ts) | h == dot -> (False, c:ts)
| h == dots -> (False, c:acc)
| otherwise -> (False, ts)
step (_, acc) c = (False, c:acc)
-------------------------------------------------------------------------------
-- Extensions
-------------------------------------------------------------------------------
-- | Get a 'FilePath'’s last extension, or 'Nothing' if it has no
-- extensions.
extension :: FilePath -> Maybe T.Text
extension p = case extensions p of
[] -> Nothing
es -> Just (last es)
-- | Get a 'FilePath'’s full extension list.
extensions :: FilePath -> [T.Text]
extensions = map chunkText . pathExtensions
-- | Get whether a 'FilePath'’s last extension is the predicate.
hasExtension :: FilePath -> T.Text -> Bool
hasExtension p e = extension p == Just e
-- | Append an extension to the end of a 'FilePath'.
addExtension :: FilePath -> T.Text -> FilePath
addExtension p ext = addExtensions p [ext]
-- | Append many extensions to the end of a 'FilePath'.
addExtensions :: FilePath -> [T.Text] -> FilePath
addExtensions p exts = p { pathExtensions = newExtensions } where
newExtensions = pathExtensions p ++ chunks
chunks = map (\e -> Chunk e True) exts
-- | An alias for 'addExtension'.
(<.>) :: FilePath -> T.Text -> FilePath
(<.>) = addExtension
-- | Remove a 'FilePath'’s last extension.
dropExtension :: FilePath -> FilePath
dropExtension p = p { pathExtensions = safeInit (pathExtensions p) }
-- | Remove all extensions from a 'FilePath'.
dropExtensions :: FilePath -> FilePath
dropExtensions p = p { pathExtensions = [] }
-- | Replace a 'FilePath'’s last extension.
replaceExtension :: FilePath -> T.Text -> FilePath
replaceExtension = addExtension . dropExtension
-- | Remove all extensions from a 'FilePath', and replace them with a new
-- list.
replaceExtensions :: FilePath -> [T.Text] -> FilePath
replaceExtensions = addExtensions . dropExtensions
-- | @splitExtension p = ('dropExtension' p, 'extension' p)@
splitExtension :: FilePath -> (FilePath, Maybe T.Text)
splitExtension p = (dropExtension p, extension p)
-- | @splitExtensions p = ('dropExtensions' p, 'extensions' p)@
splitExtensions :: FilePath -> (FilePath, [T.Text])
splitExtensions p = (dropExtensions p, extensions p)
-------------------------------------------------------------------------------
-- Utils
-------------------------------------------------------------------------------
safeInit :: [a] -> [a]
safeInit xs = case xs of
[] -> []
_ -> init xs
safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:_) = Just x