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