module System.FilePath
( FilePath
, empty
, null
, root
, directory
, parent
, filename
, basename
, absolute
, relative
, append
, (</>)
, concat
, commonPrefix
, collapse
, 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 System.FilePath.Internal
instance M.Monoid FilePath where
mempty = empty
mappend = append
mconcat = concat
null :: FilePath -> Bool
null = (== empty)
root :: FilePath -> FilePath
root p = empty { pathRoot = pathRoot p }
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
}
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
}
filename :: FilePath -> FilePath
filename p = empty
{ pathBasename = pathBasename p
, pathExtensions = pathExtensions p
}
basename :: FilePath -> FilePath
basename p = empty
{ pathBasename = pathBasename p
}
absolute :: FilePath -> Bool
absolute p = case pathRoot p of
Just RootPosix -> True
Just (RootWindowsVolume _) -> True
_ -> False
relative :: FilePath -> Bool
relative p = case pathRoot p of
Just _ -> False
_ -> True
append :: FilePath -> FilePath -> FilePath
append x y = if absolute y then y else xy where
xy = y
{ pathRoot = pathRoot x
, pathDirectories = directories
}
directories = xDirectories ++ pathDirectories y
xDirectories = (pathDirectories x ++) $ if null (filename x)
then []
else [filenameChunk x]
(</>) :: FilePath -> FilePath -> FilePath
(</>) = append
concat :: [FilePath] -> FilePath
concat [] = empty
concat ps = foldr1 append ps
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 []
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)
extension :: FilePath -> Maybe T.Text
extension p = case extensions p of
[] -> Nothing
es -> Just (last es)
extensions :: FilePath -> [T.Text]
extensions = map chunkText . pathExtensions
hasExtension :: FilePath -> T.Text -> Bool
hasExtension p e = extension p == Just e
addExtension :: FilePath -> T.Text -> FilePath
addExtension p ext = addExtensions p [ext]
addExtensions :: FilePath -> [T.Text] -> FilePath
addExtensions p exts = p { pathExtensions = newExtensions } where
newExtensions = pathExtensions p ++ chunks
chunks = map (\e -> Chunk e True) exts
(<.>) :: FilePath -> T.Text -> FilePath
(<.>) = addExtension
dropExtension :: FilePath -> FilePath
dropExtension p = p { pathExtensions = safeInit (pathExtensions p) }
dropExtensions :: FilePath -> FilePath
dropExtensions p = p { pathExtensions = [] }
replaceExtension :: FilePath -> T.Text -> FilePath
replaceExtension = addExtension . dropExtension
replaceExtensions :: FilePath -> [T.Text] -> FilePath
replaceExtensions = addExtensions . dropExtensions
splitExtension :: FilePath -> (FilePath, Maybe T.Text)
splitExtension p = (dropExtension p, extension p)
splitExtensions :: FilePath -> (FilePath, [T.Text])
splitExtensions p = (dropExtensions p, extensions p)
safeInit :: [a] -> [a]
safeInit xs = case xs of
[] -> []
_ -> init xs
safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:_) = Just x