module HsShellScript.Paths where
import Data.List
import System.Directory
slice_path :: String
-> [String]
slice_path :: String -> [String]
slice_path String
p =
case String
p of
(Char
'/':String
p') -> case String -> [String]
slice_path' String
p' of
[] -> [String
"/"]
(String
c:[String]
cs) -> ((Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String
c)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
cs)
String
_ -> String -> [String]
slice_path' String
p
where
slice_path' :: String -> [String]
slice_path' String
p = (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
p)
split :: String -> [String]
split String
"" = []
split (Char
'/':String
p) = String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
split String
p
split (Char
x:String
xs) = case String -> [String]
split String
xs of
[] -> [[Char
x]]
(String
y:[String]
ys) -> ((Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
y)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ys)
unslice_path :: [String]
-> String
unslice_path :: [String] -> String
unslice_path [] = String
"."
unslice_path [String]
cs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"/" [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' String
filename =
case String
filename of
(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
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse 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
'/':String
p] -> (String
"/", String
p)
[String
fn] -> (String
".", String
fn)
[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
p, String
q) = [String] -> String
unsplit_parts [String
p, String
q]
unsplit_parts :: [String]
-> String
unsplit_parts :: [String] -> String
unsplit_parts [] = String
"."
unsplit_parts [String]
parts =
let abs :: String
abs = case [String]
parts of
(Char
'/':String
p1):[String]
rest -> String
"/"
[String]
_ -> String
""
parts' :: [String]
parts' = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
part -> case String
part of
Char
'/':String
rest -> String
rest
String
_ -> String
part
)
[String]
parts
in case (String
abs String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"/" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
part -> String
part String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
&& String
part String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
".") [String]
parts'))
of String
"" -> String
"."
String
path -> String
path
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
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"/" ([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 path :: String
path@(Char
'/':String
p) = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
path
absolute_path String
path = do
String
cwd <- IO String
getCurrentDirectory
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
cwd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path)
absolute_path_by :: String
-> String
-> String
absolute_path_by :: String -> String -> String
absolute_path_by String
absdir path :: String
path@(Char
'/':String
p) = String
path
absolute_path_by String
absdir String
path =
String
absdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path
absolute_path' :: String
-> String
-> String
absolute_path' :: String -> String -> String
absolute_path' path :: String
path@(Char
'/':String
p) String
dir = String
path
absolute_path' String
path String
dir = String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path
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