module FilePaths(AFilePath,rootPath,aFilePath,filePath,
                 compactPath,isAbsolute,joinPaths,pathRelativeTo,
		 extendPath,pathTail,pathHead,pathLength) where
import Data.List(intersperse)
--import IO(openDirectory, statFile)
--import ListUtil(chopList,breakAt)
import Utils(segments)

newtype AFilePath = P [String] deriving (AFilePath -> AFilePath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AFilePath -> AFilePath -> Bool
$c/= :: AFilePath -> AFilePath -> Bool
== :: AFilePath -> AFilePath -> Bool
$c== :: AFilePath -> AFilePath -> Bool
Eq,Eq AFilePath
AFilePath -> AFilePath -> Bool
AFilePath -> AFilePath -> Ordering
AFilePath -> AFilePath -> AFilePath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AFilePath -> AFilePath -> AFilePath
$cmin :: AFilePath -> AFilePath -> AFilePath
max :: AFilePath -> AFilePath -> AFilePath
$cmax :: AFilePath -> AFilePath -> AFilePath
>= :: AFilePath -> AFilePath -> Bool
$c>= :: AFilePath -> AFilePath -> Bool
> :: AFilePath -> AFilePath -> Bool
$c> :: AFilePath -> AFilePath -> Bool
<= :: AFilePath -> AFilePath -> Bool
$c<= :: AFilePath -> AFilePath -> Bool
< :: AFilePath -> AFilePath -> Bool
$c< :: AFilePath -> AFilePath -> Bool
compare :: AFilePath -> AFilePath -> Ordering
$ccompare :: AFilePath -> AFilePath -> Ordering
Ord)
-- data AFilePath = Root | Cwd | AFilePath :/ String

aFilePath :: FilePath -> AFilePath
aFilePath :: String -> AFilePath
aFilePath = [String] -> AFilePath
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitpath

rootPath :: AFilePath
rootPath = [String] -> AFilePath
P [String
""]

filePath :: AFilePath -> FilePath
filePath :: AFilePath -> String
filePath (P [String]
path) = [String] -> String
joinpath [String]
path

compactPath :: AFilePath -> AFilePath
compactPath (P [String]
path) = [String] -> AFilePath
P ([String] -> [String]
compactpath [String]
path)

extendPath :: AFilePath -> String -> AFilePath
extendPath (P [String]
path) String
node = [String] -> AFilePath
P (String
nodeforall a. a -> [a] -> [a]
:[String]
path)

pathTail :: AFilePath -> String
pathTail :: AFilePath -> String
pathTail (P []) = String
"." -- ??
pathTail (P [String
""]) = String
"/" -- ??
pathTail (P (String
t:[String]
_)) =  String
t

pathHead :: AFilePath -> AFilePath
pathHead (P []) = ([String] -> AFilePath
P []) -- ??
pathHead (P (String
t:[String]
h)) = [String] -> AFilePath
P [String]
h

pathLength :: AFilePath -> Int
pathLength (P [String]
path) = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
path

isAbsolute :: AFilePath -> Bool
isAbsolute (P [String]
ns) = forall {t :: * -> *} {a}. Foldable t => [t a] -> Bool
isabsolute [String]
ns

joinPaths :: AFilePath -> AFilePath -> AFilePath
joinPaths (P [String]
parent) (P [String]
child) =
 if forall {t :: * -> *} {a}. Foldable t => [t a] -> Bool
isabsolute [String]
child
 then [String] -> AFilePath
P [String]
child
 else [String] -> AFilePath
P ([String]
childforall a. [a] -> [a] -> [a]
++[String]
parent) -- compactpath?

P [String]
file pathRelativeTo :: AFilePath -> AFilePath -> AFilePath
`pathRelativeTo` P [String]
dir =
    if forall a. Int -> [a] -> [a]
take Int
dirlen [String]
rfile forall a. Eq a => a -> a -> Bool
== [String]
rdir
    then [String] -> AFilePath
P (forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
drop Int
dirlen [String]
rfile))
    else [String] -> AFilePath
P [String]
file
  where
    rdir :: [String]
rdir = forall a. [a] -> [a]
reverse [String]
dir
    rfile :: [String]
rfile = forall a. [a] -> [a]
reverse [String]
file
    dirlen :: Int
dirlen = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
rdir

isabsolute :: [t a] -> Bool
isabsolute [] = Bool
False
isabsolute [t a]
ns = forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. [a] -> a
last [t a]
ns)

splitpath :: String -> [String]
splitpath = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> Bool) -> [a] -> [[a]]
segments (forall a. Eq a => a -> a -> Bool
/=Char
'/')

joinpath :: [String] -> String
joinpath [] = String
"."
joinpath [String
""] = String
"/"
joinpath [String]
ns = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. a -> [a] -> [a]
intersperse String
"/" (forall a. [a] -> [a]
reverse [String]
ns))

compactpath :: [String] -> [String]
compactpath [] = []
compactpath (String
".." : [String]
xs) =
  case [String] -> [String]
compactpath [String]
xs of
    [String
""] -> [String
""] -- parent of root directory, stay in root directory
    ys :: [String]
ys@(String
"..":[String]
_) -> String
".."forall a. a -> [a] -> [a]
:[String]
ys -- relative path to grandparent, keep ".."
    String
_:[String]
ys -> [String]
ys -- parent of child, optimize
    [String]
ys -> String
".."forall a. a -> [a] -> [a]
:[String]
ys -- other, keep ".."
--compactpath ["..",""] = [""] -- parent of root directory
--compactpath (".." : "." : xs) = compactpath ("..":xs)
--compactpath (".." : x : xs) | x /= ".." = compactpath xs
compactpath (String
"" : xs :: [String]
xs@(String
_:[String]
_)) = [String] -> [String]
compactpath [String]
xs
compactpath (String
"." : [String]
xs) = [String] -> [String]
compactpath [String]
xs
compactpath (String
x : [String]
xs) = String
x forall a. a -> [a] -> [a]
: [String] -> [String]
compactpath [String]
xs

{-
ls s =
    let paths = map (: s) . sort . filter (/= ".")
    in  case openDirectory (joinpath s) of
          Right files -> paths files
          Left msg -> [msg : s]

isdir s =
    case statFile (joinpath s) of
      Right ns -> let mode = ns !! (3 - 1)
                  in  bitand mode 61440 == 16384
      Left _ -> False

-}