module HsShellScript.Paths where
import Data.List
import System.Directory
slice_path :: String
-> [String]
slice_path :: String -> [String]
slice_path p :: String
p =
case String
p of
('/':p' :: String
p') -> case String -> [String]
slice_path' String
p' of
[] -> ["/"]
(c :: String
c:cs :: [String]
cs) -> (('/'Char -> String -> String
forall a. a -> [a] -> [a]
:String
c)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
cs)
_ -> String -> [String]
slice_path' String
p
where
slice_path' :: String -> [String]
slice_path' p :: String
p = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\c :: String
c -> String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "" Bool -> Bool -> Bool
&& String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= ".") (String -> [String]
split String
p)
split :: String -> [String]
split "" = []
split ('/':p :: String
p) = "" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
split String
p
split (x :: Char
x:xs :: String
xs) = case String -> [String]
split String
xs of
[] -> [[Char
x]]
(y :: String
y:ys :: [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 [] = "."
unslice_path cs :: [String]
cs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse "/" [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 path :: 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 (base :: String
base:suffixes :: [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' filename :: String
filename =
case String
filename of
('.':filename' :: String
filename') -> case String -> [String]
slice_filename'' String
filename' of
[] -> ["."]
(t :: String
t:ts :: [String]
ts) -> ('.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ts
filename :: String
filename -> String -> [String]
slice_filename'' String
filename
where
slice_filename'' :: String -> [String]
slice_filename'' :: String -> [String]
slice_filename'' "" = []
slice_filename'' fn :: String
fn =
let (beg :: String
beg,rest :: 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 (x :: Char
x:y :: Char
y:r :: String
r) =
if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' Bool -> Bool -> Bool
&& Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '.' then ("", Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:String
r)
else let (beg :: String
beg,rest :: 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 str :: String
str = (String
str, "")
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 "."
split_path :: String
-> (String, String)
split_path :: String -> (String, String)
split_path "" = ("","")
split_path path :: String
path =
case String -> [String]
slice_path String
path of
[] -> (".",".")
["/"] -> ("/", ".")
['/':p :: String
p] -> ("/", String
p)
[fn :: String
fn] -> (".", String
fn)
parts :: [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 ("", "") = ""
unsplit_path (p :: String
p, q :: String
q) = [String] -> String
unsplit_parts [String
p, String
q]
unsplit_parts :: [String]
-> String
unsplit_parts :: [String] -> String
unsplit_parts [] = "."
unsplit_parts parts :: [String]
parts =
let abs :: String
abs = case [String]
parts of
('/':p1 :: String
p1):rest :: [String]
rest -> "/"
_ -> ""
parts' :: [String]
parts' = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\part :: String
part -> case String
part of
'/':rest :: String
rest -> String
rest
_ -> 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]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\part :: String
part -> String
part String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "" Bool -> Bool -> Bool
&& String
part String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= ".") [String]
parts'))
of "" -> "."
path :: String
path -> String
path
split_filename :: String
-> (String, String)
split_filename :: String -> (String, String)
split_filename "" = ("", "")
split_filename path :: String
path =
case String -> [String]
slice_path String
path of
[] -> (".","")
comps :: [String]
comps -> let (pref_fn :: String
pref_fn, suff_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]
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' "" = ("", "")
split_filename' fn :: String
fn =
let parts :: [String]
parts = String -> [String]
slice_filename' String
fn
in case [String]
parts of
[] -> (".", "")
[base :: String
base] -> (String
base, "")
p :: [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 (prefix :: String
prefix, suffix :: String
suffix) =
if String
suffix String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" then String
prefix else String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ "." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix
split3 :: String
-> (String, String, String)
split3 :: String -> (String, String, String)
split3 "" = ("","","")
split3 path :: String
path =
let comps :: [String]
comps = String -> [String]
slice_path String
path
(base :: String
base, suffix :: 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 (dir :: String
dir, base :: String
base, suffix :: 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 suffix :: String
suffix path :: String
path =
let (prefix :: String
prefix, suff :: 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@('/':p :: String
p) = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
path
absolute_path 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
forall a. [a] -> [a] -> [a]
++ String
path)
absolute_path_by :: String
-> String
-> String
absolute_path_by :: String -> String -> String
absolute_path_by absdir :: String
absdir path :: String
path@('/':p :: String
p) = String
path
absolute_path_by absdir :: String
absdir path :: String
path =
String
absdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/" 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@('/':p :: String
p) dir :: String
dir = String
path
absolute_path' path :: String
path dir :: String
dir = String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/" 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' schon :: [String]
schon [] = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
schon
guess_dotdot_comps' [] ("..":_) = Maybe [String]
forall a. Maybe a
Nothing
guess_dotdot_comps' schon :: [String]
schon ("..":teile :: [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' schon :: [String]
schon (teil :: String
teil:teile :: [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