{-# OPTIONS_GHC -fno-warn-orphans #-}
module Filesystem.Path
( FilePath
, empty
, null
, root
, directory
, parent
, filename
, dirname
, basename
, absolute
, relative
, append
, (</>)
, concat
, commonPrefix
, stripPrefix
, collapse
, splitDirectories
, extension
, extensions
, hasExtension
, addExtension
, (<.>)
, dropExtension
, replaceExtension
, addExtensions
, dropExtensions
, replaceExtensions
, splitExtension
, splitExtensions
) where
import Prelude hiding (FilePath, concat, null)
import qualified Prelude as Prelude
import Data.List (foldl')
import Data.Maybe (isJust, isNothing)
import qualified Data.Semigroup as Sem
import qualified Data.Monoid as M
import qualified Data.Text as T
import Filesystem.Path.Internal
instance Sem.Semigroup FilePath where
<> :: FilePath -> FilePath -> FilePath
(<>) = FilePath -> FilePath -> FilePath
append
instance M.Monoid FilePath where
mempty :: FilePath
mempty = FilePath
empty
mappend :: FilePath -> FilePath -> FilePath
mappend = FilePath -> FilePath -> FilePath
append
mconcat :: [FilePath] -> FilePath
mconcat = [FilePath] -> FilePath
concat
null :: FilePath -> Bool
null :: FilePath -> Bool
null = (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
empty)
root :: FilePath -> FilePath
root :: FilePath -> FilePath
root FilePath
p = FilePath
empty { pathRoot = pathRoot p }
directory :: FilePath -> FilePath
directory :: FilePath -> FilePath
directory FilePath
p = FilePath
empty
{ pathRoot = pathRoot p
, pathDirectories = let
dot' | Maybe Root -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe Root
pathRoot FilePath
p) = []
| [Directory] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null (FilePath -> [Directory]
pathDirectories FilePath
p) = [Directory
dot]
| Bool
otherwise = []
in dot' ++ pathDirectories p
}
parent :: FilePath -> FilePath
parent :: FilePath -> FilePath
parent FilePath
p = FilePath
empty
{ pathRoot = pathRoot p
, pathDirectories = let
starts = (Directory -> Maybe Directory) -> [Directory] -> [Maybe Directory]
forall a b. (a -> b) -> [a] -> [b]
map Directory -> Maybe Directory
forall a. a -> Maybe a
Just [Directory
dot, Directory
dots]
directories = if FilePath -> Bool
null (FilePath -> FilePath
filename FilePath
p)
then [Directory] -> [Directory]
forall a. [a] -> [a]
safeInit (FilePath -> [Directory]
pathDirectories FilePath
p)
else FilePath -> [Directory]
pathDirectories FilePath
p
dot' | [Directory] -> Maybe Directory
forall a. [a] -> Maybe a
safeHead [Directory]
directories Maybe Directory -> [Maybe Directory] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Directory]
starts = []
| Maybe Root -> Bool
forall a. Maybe a -> Bool
isNothing (FilePath -> Maybe Root
pathRoot FilePath
p) = [Directory
dot]
| Bool
otherwise = []
in dot' ++ directories
}
filename :: FilePath -> FilePath
filename :: FilePath -> FilePath
filename FilePath
p = FilePath
empty
{ pathBasename = pathBasename p
, pathExtensions = pathExtensions p
}
dirname :: FilePath -> FilePath
dirname :: FilePath -> FilePath
dirname FilePath
p = case [Directory] -> [Directory]
forall a. [a] -> [a]
reverse (FilePath -> [Directory]
pathDirectories FilePath
p) of
[] -> Maybe Root
-> [Directory] -> Maybe Directory -> [Directory] -> FilePath
FilePath Maybe Root
forall a. Maybe a
Nothing [] Maybe Directory
forall a. Maybe a
Nothing []
(Directory
d:[Directory]
_) -> case Directory -> (Maybe Directory, [Directory])
parseFilename Directory
d of
(Maybe Directory
base, [Directory]
exts) -> Maybe Root
-> [Directory] -> Maybe Directory -> [Directory] -> FilePath
FilePath Maybe Root
forall a. Maybe a
Nothing [] Maybe Directory
base [Directory]
exts
basename :: FilePath -> FilePath
basename :: FilePath -> FilePath
basename FilePath
p = FilePath
empty
{ pathBasename = pathBasename p
}
absolute :: FilePath -> Bool
absolute :: FilePath -> Bool
absolute FilePath
p = case FilePath -> Maybe Root
pathRoot FilePath
p of
Just Root
RootPosix -> Bool
True
Just RootWindowsVolume{} -> Bool
True
Just Root
RootWindowsCurrentVolume -> Bool
False
Just RootWindowsUnc{} -> Bool
True
Just Root
RootWindowsDoubleQMark -> Bool
True
Maybe Root
Nothing -> Bool
False
relative :: FilePath -> Bool
relative :: FilePath -> Bool
relative FilePath
p = case FilePath -> Maybe Root
pathRoot FilePath
p of
Just Root
_ -> Bool
False
Maybe Root
_ -> Bool
True
append :: FilePath -> FilePath -> FilePath
append :: FilePath -> FilePath -> FilePath
append FilePath
x FilePath
y = FilePath
cased where
cased :: FilePath
cased = case FilePath -> Maybe Root
pathRoot FilePath
y of
Just Root
RootPosix -> FilePath
y
Just RootWindowsVolume{} -> FilePath
y
Just Root
RootWindowsCurrentVolume -> case FilePath -> Maybe Root
pathRoot FilePath
x of
Just RootWindowsVolume{} -> FilePath
y { pathRoot = pathRoot x }
Maybe Root
_ -> FilePath
y
Just RootWindowsUnc{} -> FilePath
y
Just Root
RootWindowsDoubleQMark -> FilePath
y
Maybe Root
Nothing -> FilePath
xy
xy :: FilePath
xy = FilePath
y
{ pathRoot = pathRoot x
, pathDirectories = directories
}
directories :: [Directory]
directories = [Directory]
xDirectories [Directory] -> [Directory] -> [Directory]
forall a. [a] -> [a] -> [a]
++ FilePath -> [Directory]
pathDirectories FilePath
y
xDirectories :: [Directory]
xDirectories = (FilePath -> [Directory]
pathDirectories FilePath
x [Directory] -> [Directory] -> [Directory]
forall a. [a] -> [a] -> [a]
++) ([Directory] -> [Directory]) -> [Directory] -> [Directory]
forall a b. (a -> b) -> a -> b
$ if FilePath -> Bool
null (FilePath -> FilePath
filename FilePath
x)
then []
else [FilePath -> Directory
filenameChunk FilePath
x]
(</>) :: FilePath -> FilePath -> FilePath
</> :: FilePath -> FilePath -> FilePath
(</>) = FilePath -> FilePath -> FilePath
append
concat :: [FilePath] -> FilePath
concat :: [FilePath] -> FilePath
concat [] = FilePath
empty
concat [FilePath]
ps = (FilePath -> FilePath -> FilePath) -> [FilePath] -> FilePath
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 FilePath -> FilePath -> FilePath
append [FilePath]
ps
commonPrefix :: [FilePath] -> FilePath
commonPrefix :: [FilePath] -> FilePath
commonPrefix [] = FilePath
empty
commonPrefix [FilePath]
ps = (FilePath -> FilePath -> FilePath) -> [FilePath] -> FilePath
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 FilePath -> FilePath -> FilePath
step [FilePath]
ps where
step :: FilePath -> FilePath -> FilePath
step FilePath
x FilePath
y = if FilePath -> Maybe Root
pathRoot FilePath
x Maybe Root -> Maybe Root -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> Maybe Root
pathRoot FilePath
y
then FilePath
empty
else let cs :: [Directory]
cs = FilePath -> FilePath -> [Directory]
commonDirectories FilePath
x FilePath
y in
if [Directory]
cs [Directory] -> [Directory] -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> [Directory]
pathDirectories FilePath
x Bool -> Bool -> Bool
|| FilePath -> Maybe Directory
pathBasename FilePath
x Maybe Directory -> Maybe Directory -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> Maybe Directory
pathBasename FilePath
y
then FilePath
empty { pathRoot = pathRoot x, pathDirectories = cs }
else let exts :: [Directory]
exts = FilePath -> FilePath -> [Directory]
commonExtensions FilePath
x FilePath
y in
FilePath
x { pathExtensions = exts }
commonDirectories :: FilePath -> FilePath -> [Directory]
commonDirectories FilePath
x FilePath
y = [Directory] -> [Directory] -> [Directory]
forall {a}. Eq a => [a] -> [a] -> [a]
common (FilePath -> [Directory]
pathDirectories FilePath
x) (FilePath -> [Directory]
pathDirectories FilePath
y)
commonExtensions :: FilePath -> FilePath -> [Directory]
commonExtensions FilePath
x FilePath
y = [Directory] -> [Directory] -> [Directory]
forall {a}. Eq a => [a] -> [a] -> [a]
common (FilePath -> [Directory]
pathExtensions FilePath
x) (FilePath -> [Directory]
pathExtensions FilePath
y)
common :: [a] -> [a] -> [a]
common [] [a]
_ = []
common [a]
_ [] = []
common (a
x:[a]
xs) (a
y:[a]
ys) = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
then a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
common [a]
xs [a]
ys
else []
stripPrefix :: FilePath -> FilePath -> Maybe FilePath
stripPrefix :: FilePath -> FilePath -> Maybe FilePath
stripPrefix FilePath
x FilePath
y = if FilePath -> Maybe Root
pathRoot FilePath
x Maybe Root -> Maybe Root -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> Maybe Root
pathRoot FilePath
y
then case FilePath -> Maybe Root
pathRoot FilePath
x of
Maybe Root
Nothing -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
y
Just Root
_ -> Maybe FilePath
forall a. Maybe a
Nothing
else do
dirs <- [Directory] -> [Directory] -> Maybe [Directory]
forall a. Eq a => [a] -> [a] -> Maybe [a]
strip (FilePath -> [Directory]
pathDirectories FilePath
x) (FilePath -> [Directory]
pathDirectories FilePath
y)
case dirs of
[] -> case (FilePath -> Maybe Directory
pathBasename FilePath
x, FilePath -> Maybe Directory
pathBasename FilePath
y) of
(Maybe Directory
Nothing, Maybe Directory
Nothing) -> do
exts <- [Directory] -> [Directory] -> Maybe [Directory]
forall a. Eq a => [a] -> [a] -> Maybe [a]
strip (FilePath -> [Directory]
pathExtensions FilePath
x) (FilePath -> [Directory]
pathExtensions FilePath
y)
return (y { pathRoot = Nothing, pathDirectories = dirs, pathExtensions = exts })
(Maybe Directory
Nothing, Just Directory
_) -> case FilePath -> [Directory]
pathExtensions FilePath
x of
[] -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
y { pathRoot = Nothing, pathDirectories = dirs })
[Directory]
_ -> Maybe FilePath
forall a. Maybe a
Nothing
(Just Directory
x_b, Just Directory
y_b) | Directory
x_b Directory -> Directory -> Bool
forall a. Eq a => a -> a -> Bool
== Directory
y_b -> do
exts <- [Directory] -> [Directory] -> Maybe [Directory]
forall a. Eq a => [a] -> [a] -> Maybe [a]
strip (FilePath -> [Directory]
pathExtensions FilePath
x) (FilePath -> [Directory]
pathExtensions FilePath
y)
return (empty { pathExtensions = exts })
(Maybe Directory, Maybe Directory)
_ -> Maybe FilePath
forall a. Maybe a
Nothing
[Directory]
_ -> case (FilePath -> Maybe Directory
pathBasename FilePath
x, FilePath -> [Directory]
pathExtensions FilePath
x) of
(Maybe Directory
Nothing, []) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
y { pathRoot = Nothing, pathDirectories = dirs })
(Maybe Directory, [Directory])
_ -> Maybe FilePath
forall a. Maybe a
Nothing
strip :: Eq a => [a] -> [a] -> Maybe [a]
strip :: forall a. Eq a => [a] -> [a] -> Maybe [a]
strip [] [a]
ys = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
ys
strip [a]
_ [] = Maybe [a]
forall a. Maybe a
Nothing
strip (a
x:[a]
xs) (a
y:[a]
ys) = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
then [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
strip [a]
xs [a]
ys
else Maybe [a]
forall a. Maybe a
Nothing
collapse :: FilePath -> FilePath
collapse :: FilePath -> FilePath
collapse FilePath
p = FilePath
p { pathDirectories = newDirs } where
newDirs :: [Directory]
newDirs = case FilePath -> Maybe Root
pathRoot FilePath
p of
Maybe Root
Nothing -> [Directory] -> [Directory]
forall a. [a] -> [a]
reverse [Directory]
revNewDirs
Just Root
_ -> (Directory -> Bool) -> [Directory] -> [Directory]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Directory
x -> Directory
x Directory -> Directory -> Bool
forall a. Eq a => a -> a -> Bool
== Directory
dot Bool -> Bool -> Bool
|| Directory
x Directory -> Directory -> Bool
forall a. Eq a => a -> a -> Bool
== Directory
dots) ([Directory] -> [Directory]
forall a. [a] -> [a]
reverse [Directory]
revNewDirs)
(Bool
_, [Directory]
revNewDirs) = ((Bool, [Directory]) -> Directory -> (Bool, [Directory]))
-> (Bool, [Directory]) -> [Directory] -> (Bool, [Directory])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool, [Directory]) -> Directory -> (Bool, [Directory])
step (Bool
True, []) (FilePath -> [Directory]
pathDirectories FilePath
p)
step :: (Bool, [Directory]) -> Directory -> (Bool, [Directory])
step (Bool
True, [Directory]
acc) Directory
c = (Bool
False, Directory
cDirectory -> [Directory] -> [Directory]
forall a. a -> [a] -> [a]
:[Directory]
acc)
step (Bool
_, [Directory]
acc) Directory
c | Directory
c Directory -> Directory -> Bool
forall a. Eq a => a -> a -> Bool
== Directory
dot = (Bool
False, [Directory]
acc)
step (Bool
_, [Directory]
acc) Directory
c | Directory
c Directory -> Directory -> Bool
forall a. Eq a => a -> a -> Bool
== Directory
dots = case [Directory]
acc of
[] -> (Bool
False, Directory
cDirectory -> [Directory] -> [Directory]
forall a. a -> [a] -> [a]
:[Directory]
acc)
(Directory
h:[Directory]
ts) | Directory
h Directory -> Directory -> Bool
forall a. Eq a => a -> a -> Bool
== Directory
dot -> (Bool
False, Directory
cDirectory -> [Directory] -> [Directory]
forall a. a -> [a] -> [a]
:[Directory]
ts)
| Directory
h Directory -> Directory -> Bool
forall a. Eq a => a -> a -> Bool
== Directory
dots -> (Bool
False, Directory
cDirectory -> [Directory] -> [Directory]
forall a. a -> [a] -> [a]
:[Directory]
acc)
| Bool
otherwise -> (Bool
False, [Directory]
ts)
step (Bool
_, [Directory]
acc) Directory
c = (Bool
False, Directory
cDirectory -> [Directory] -> [Directory]
forall a. a -> [a] -> [a]
:[Directory]
acc)
splitDirectories :: FilePath -> [FilePath]
splitDirectories :: FilePath -> [FilePath]
splitDirectories FilePath
p = [FilePath]
rootName [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
dirNames [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
fileName where
rootName :: [FilePath]
rootName = case FilePath -> Maybe Root
pathRoot FilePath
p of
Maybe Root
Nothing -> []
Maybe Root
r -> [FilePath
empty { pathRoot = r }]
dirNames :: [FilePath]
dirNames = (Directory -> FilePath) -> [Directory] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\Directory
d -> FilePath
empty { pathDirectories = [d] }) (FilePath -> [Directory]
pathDirectories FilePath
p)
fileName :: [FilePath]
fileName = case (FilePath -> Maybe Directory
pathBasename FilePath
p, FilePath -> [Directory]
pathExtensions FilePath
p) of
(Maybe Directory
Nothing, []) -> []
(Maybe Directory, [Directory])
_ -> [FilePath -> FilePath
filename FilePath
p]
extension :: FilePath -> Maybe T.Text
extension :: FilePath -> Maybe Text
extension FilePath
p = case FilePath -> [Text]
extensions FilePath
p of
[] -> Maybe Text
forall a. Maybe a
Nothing
[Text]
es -> Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
es)
extensions :: FilePath -> [T.Text]
extensions :: FilePath -> [Text]
extensions = (Directory -> Text) -> [Directory] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Directory -> Text
unescape' ([Directory] -> [Text])
-> (FilePath -> [Directory]) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [Directory]
pathExtensions
hasExtension :: FilePath -> T.Text -> Bool
hasExtension :: FilePath -> Text -> Bool
hasExtension FilePath
p Text
e = FilePath -> Maybe Text
extension FilePath
p Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
e
addExtension :: FilePath -> T.Text -> FilePath
addExtension :: FilePath -> Text -> FilePath
addExtension FilePath
p Text
ext = FilePath -> [Text] -> FilePath
addExtensions FilePath
p [Text
ext]
addExtensions :: FilePath -> [T.Text] -> FilePath
addExtensions :: FilePath -> [Text] -> FilePath
addExtensions FilePath
p [Text]
exts = FilePath
p { pathExtensions = newExtensions } where
newExtensions :: [Directory]
newExtensions = FilePath -> [Directory]
pathExtensions FilePath
p [Directory] -> [Directory] -> [Directory]
forall a. [a] -> [a] -> [a]
++ (Text -> Directory) -> [Text] -> [Directory]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Directory
escape [Text]
exts
(<.>) :: FilePath -> T.Text -> FilePath
<.> :: FilePath -> Text -> FilePath
(<.>) = FilePath -> Text -> FilePath
addExtension
dropExtension :: FilePath -> FilePath
dropExtension :: FilePath -> FilePath
dropExtension FilePath
p = FilePath
p { pathExtensions = safeInit (pathExtensions p) }
dropExtensions :: FilePath -> FilePath
dropExtensions :: FilePath -> FilePath
dropExtensions FilePath
p = FilePath
p { pathExtensions = [] }
replaceExtension :: FilePath -> T.Text -> FilePath
replaceExtension :: FilePath -> Text -> FilePath
replaceExtension = FilePath -> Text -> FilePath
addExtension (FilePath -> Text -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropExtension
replaceExtensions :: FilePath -> [T.Text] -> FilePath
replaceExtensions :: FilePath -> [Text] -> FilePath
replaceExtensions = FilePath -> [Text] -> FilePath
addExtensions (FilePath -> [Text] -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> [Text] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropExtensions
splitExtension :: FilePath -> (FilePath, Maybe T.Text)
splitExtension :: FilePath -> (FilePath, Maybe Text)
splitExtension FilePath
p = (FilePath -> FilePath
dropExtension FilePath
p, FilePath -> Maybe Text
extension FilePath
p)
splitExtensions :: FilePath -> (FilePath, [T.Text])
splitExtensions :: FilePath -> (FilePath, [Text])
splitExtensions FilePath
p = (FilePath -> FilePath
dropExtensions FilePath
p, FilePath -> [Text]
extensions FilePath
p)
safeInit :: [a] -> [a]
safeInit :: forall a. [a] -> [a]
safeInit [a]
xs = case [a]
xs of
[] -> []
[a]
_ -> [a] -> [a]
forall a. HasCallStack => [a] -> [a]
init [a]
xs
safeHead :: [a] -> Maybe a
safeHead :: forall a. [a] -> Maybe a
safeHead [] = Maybe a
forall a. Maybe a
Nothing
safeHead (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x