{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module System.Path.NameManip where
import Data.List (intercalate, unfoldr)
import System.Directory (getCurrentDirectory)
import System.FilePath (isPathSeparator, pathSeparator, (</>))
slice_path :: String
-> [String]
slice_path :: [Char] -> [[Char]]
slice_path [Char]
"" = []
slice_path (Char
c:[Char]
cs) = if Char -> Bool
isPathSeparator Char
c
then case [Char] -> [[Char]]
slice_path' [Char]
cs of
[] -> [[Char
c]]
([Char]
p:[[Char]]
ps) -> (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
p)[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
ps
else [Char] -> [[Char]]
slice_path' (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
cs)
where
slice_path' :: [Char] -> [[Char]]
slice_path' [Char]
o = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
c -> [Char]
c [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"" Bool -> Bool -> Bool
&& [Char]
c [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
".") ([Char] -> [[Char]]
split [Char]
o)
split :: [Char] -> [[Char]]
split [Char]
xs = ([Char] -> Maybe ([Char], [Char])) -> [Char] -> [[Char]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr [Char] -> Maybe ([Char], [Char])
f [Char]
xs
where
f :: [Char] -> Maybe ([Char], [Char])
f [Char]
"" = Maybe ([Char], [Char])
forall a. Maybe a
Nothing
f [Char]
xs = ([Char], [Char]) -> Maybe ([Char], [Char])
forall a. a -> Maybe a
Just (([Char], [Char]) -> Maybe ([Char], [Char]))
-> ([Char], [Char]) -> Maybe ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> ([Char], [Char]) -> ([Char], [Char])
forall a b. (a -> b) -> ([Char], a) -> ([Char], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> [Char]
forall {a}. [a] -> [a]
tail' (([Char], [Char]) -> ([Char], [Char]))
-> ([Char], [Char]) -> ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSeparator [Char]
xs
tail' :: [a] -> [a]
tail' [] = []
tail' [a]
xs = [a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
xs
unslice_path :: [String]
-> String
unslice_path :: [[Char]] -> [Char]
unslice_path [] = [Char]
"."
unslice_path [[Char]]
cs = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char
pathSeparator] [[Char]]
cs
normalise_path :: String
-> String
normalise_path :: [Char] -> [Char]
normalise_path = [[Char]] -> [Char]
unslice_path ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
slice_path
slice_filename :: String
-> [String]
slice_filename :: [Char] -> [[Char]]
slice_filename [Char]
path =
let comps :: [[Char]]
comps = [Char] -> [[Char]]
slice_path [Char]
path
in if [[Char]]
comps [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== []
then []
else
let ([Char]
base:[[Char]]
suffixes) = [Char] -> [[Char]]
slice_filename' ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
last [[Char]]
comps)
in ([[Char]] -> [Char]
unslice_path ([[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
init [[Char]]
comps [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
base]) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
suffixes)
slice_filename' :: String
-> [String]
slice_filename' :: [Char] -> [[Char]]
slice_filename' = \case
(Char
'.':[Char]
filename') -> case [Char] -> [[Char]]
slice_filename'' [Char]
filename' of
[] -> [[Char]
"."]
([Char]
t:[[Char]]
ts) -> (Char
'.'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
t) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
ts
[Char]
filename -> [Char] -> [[Char]]
slice_filename'' [Char]
filename
where
slice_filename'' :: String -> [String]
slice_filename'' :: [Char] -> [[Char]]
slice_filename'' [Char]
"" = []
slice_filename'' [Char]
fn =
let ([Char]
beg,[Char]
rest) = [Char] -> ([Char], [Char])
split1 [Char]
fn
in ([Char]
beg [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
slice_filename'' [Char]
rest)
split1 :: String -> (String, String)
split1 :: [Char] -> ([Char], [Char])
split1 (Char
x:Char
y:[Char]
r) =
if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
&& Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.' then ([Char]
"", Char
yChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
r)
else let ([Char]
beg,[Char]
rest) = [Char] -> ([Char], [Char])
split1 (Char
yChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
r)
in (Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
beg,[Char]
rest)
split1 [Char]
str = ([Char]
str, [Char]
"")
unslice_filename :: [String]
-> String
unslice_filename :: [[Char]] -> [Char]
unslice_filename = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"."
split_path :: String
-> (String, String)
split_path :: [Char] -> ([Char], [Char])
split_path [Char]
"" = ([Char]
"",[Char]
"")
split_path [Char]
path =
case [Char] -> [[Char]]
slice_path [Char]
path of
[] -> ([Char]
".", [Char]
".")
[[Char]
""] -> ([Char]
".", [Char]
"")
[Char
f:[Char]
fs] -> if Char -> Bool
isPathSeparator Char
f then ([Char
pathSeparator], [Char]
fs) else ([Char]
".", Char
fChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
fs)
[[Char]]
parts -> ( [[Char]] -> [Char]
unslice_path ([[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
init [[Char]]
parts)
, [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
last [[Char]]
parts
)
dir_part :: String -> String
dir_part :: [Char] -> [Char]
dir_part = ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst (([Char], [Char]) -> [Char])
-> ([Char] -> ([Char], [Char])) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ([Char], [Char])
split_path
filename_part :: String -> String
filename_part :: [Char] -> [Char]
filename_part = ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd (([Char], [Char]) -> [Char])
-> ([Char] -> ([Char], [Char])) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ([Char], [Char])
split_path
unsplit_path :: ( String, String )
-> String
unsplit_path :: ([Char], [Char]) -> [Char]
unsplit_path ([Char]
".", [Char]
"") = [Char]
"."
unsplit_path ([Char]
"", [Char]
".") = [Char]
"."
unsplit_path ([Char]
".", [Char]
q) = [Char]
q
unsplit_path ([Char]
"", [Char]
q) = [Char]
q
unsplit_path ([Char]
p, [Char]
"") = [Char]
p
unsplit_path ([Char]
p, [Char]
".") = [Char]
p
unsplit_path ([Char]
p, [Char]
q) = [Char]
p [Char] -> [Char] -> [Char]
</> [Char]
q
split_filename :: String
-> (String, String)
split_filename :: [Char] -> ([Char], [Char])
split_filename [Char]
"" = ([Char]
"", [Char]
"")
split_filename [Char]
path =
case [Char] -> [[Char]]
slice_path [Char]
path of
[] -> ([Char]
".",[Char]
"")
[[Char]]
comps -> let ([Char]
pref_fn, [Char]
suff_fn) = [Char] -> ([Char], [Char])
split_filename' ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
last [[Char]]
comps)
in ( [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char
pathSeparator] ([[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
init [[Char]]
comps [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
pref_fn])
, [Char]
suff_fn
)
split_filename' :: String
-> (String, String)
split_filename' :: [Char] -> ([Char], [Char])
split_filename' [Char]
"" = ([Char]
"", [Char]
"")
split_filename' [Char]
fn =
let parts :: [[Char]]
parts = [Char] -> [[Char]]
slice_filename' [Char]
fn
in case [[Char]]
parts of
[] -> ([Char]
".", [Char]
"")
[[Char]
base] -> ([Char]
base, [Char]
"")
[[Char]]
p -> ([[Char]] -> [Char]
unslice_filename ([[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
init [[Char]]
p), [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
last [[Char]]
p)
unsplit_filename :: (String, String)
-> String
unsplit_filename :: ([Char], [Char]) -> [Char]
unsplit_filename ([Char]
prefix, [Char]
suffix) =
if [Char]
suffix [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" then [Char]
prefix else [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
suffix
split3 :: String
-> (String, String, String)
split3 :: [Char] -> ([Char], [Char], [Char])
split3 [Char]
"" = ([Char]
"",[Char]
"",[Char]
"")
split3 [Char]
path =
let comps :: [[Char]]
comps = [Char] -> [[Char]]
slice_path [Char]
path
([Char]
base, [Char]
suffix) = [Char] -> ([Char], [Char])
split_filename' ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
last [[Char]]
comps)
in ([[Char]] -> [Char]
unslice_path ([[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
init [[Char]]
comps), [Char]
base, [Char]
suffix)
unsplit3 :: (String, String, String)
-> String
unsplit3 :: ([Char], [Char], [Char]) -> [Char]
unsplit3 ([Char]
dir, [Char]
base, [Char]
suffix) =
([Char], [Char]) -> [Char]
unsplit_path ([Char]
dir, (([Char], [Char]) -> [Char]
unsplit_filename ([Char]
base,[Char]
suffix)))
test_suffix :: String
-> String
-> Maybe String
test_suffix :: [Char] -> [Char] -> Maybe [Char]
test_suffix [Char]
suffix [Char]
path =
let ([Char]
prefix, [Char]
suff) = [Char] -> ([Char], [Char])
split_filename [Char]
path
in if [Char]
suff [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
suffix then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
prefix
else Maybe [Char]
forall a. Maybe a
Nothing
absolute_path :: String
-> IO String
absolute_path :: [Char] -> IO [Char]
absolute_path [Char]
path = ([Char] -> [Char]) -> IO [Char] -> IO [Char]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Char] -> [Char]
absolute_path' [Char]
path) IO [Char]
getCurrentDirectory
absolute_path_by :: String
-> String
-> String
absolute_path_by :: [Char] -> [Char] -> [Char]
absolute_path_by = [Char] -> [Char] -> [Char]
(</>)
absolute_path' :: String
-> String
-> String
absolute_path' :: [Char] -> [Char] -> [Char]
absolute_path' = ([Char] -> [Char] -> [Char]) -> [Char] -> [Char] -> [Char]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [Char] -> [Char]
absolute_path_by
guess_dotdot_comps :: [String]
-> Maybe [String]
guess_dotdot_comps :: [[Char]] -> Maybe [[Char]]
guess_dotdot_comps = [[Char]] -> [[Char]] -> Maybe [[Char]]
guess_dotdot_comps' []
where
guess_dotdot_comps' :: [[Char]] -> [[Char]] -> Maybe [[Char]]
guess_dotdot_comps' [[Char]]
schon [] = [[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just [[Char]]
schon
guess_dotdot_comps' [] ([Char]
"..":[[Char]]
_) = Maybe [[Char]]
forall a. Maybe a
Nothing
guess_dotdot_comps' [[Char]]
schon ([Char]
"..":[[Char]]
teile) = [[Char]] -> [[Char]] -> Maybe [[Char]]
guess_dotdot_comps' ([[Char]] -> [[Char]]
forall {a}. [a] -> [a]
reverse ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
tail ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall {a}. [a] -> [a]
reverse ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
schon) [[Char]]
teile
guess_dotdot_comps' [[Char]]
schon ([Char]
teil:[[Char]]
teile) = [[Char]] -> [[Char]] -> Maybe [[Char]]
guess_dotdot_comps' ([[Char]]
schon [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
teil]) [[Char]]
teile
guess_dotdot :: String
-> Maybe String
guess_dotdot :: [Char] -> Maybe [Char]
guess_dotdot =
([[Char]] -> [Char]) -> Maybe [[Char]] -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Char]] -> [Char]
unslice_path (Maybe [[Char]] -> Maybe [Char])
-> ([Char] -> Maybe [[Char]]) -> [Char] -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Maybe [[Char]]
guess_dotdot_comps ([[Char]] -> Maybe [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> Maybe [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
slice_path