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
(AFilePath -> AFilePath -> Bool)
-> (AFilePath -> AFilePath -> Bool) -> Eq AFilePath
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
Eq AFilePath
-> (AFilePath -> AFilePath -> Ordering)
-> (AFilePath -> AFilePath -> Bool)
-> (AFilePath -> AFilePath -> Bool)
-> (AFilePath -> AFilePath -> Bool)
-> (AFilePath -> AFilePath -> Bool)
-> (AFilePath -> AFilePath -> AFilePath)
-> (AFilePath -> AFilePath -> AFilePath)
-> Ord 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
$cp1Ord :: Eq AFilePath
Ord)
-- data AFilePath = Root | Cwd | AFilePath :/ String

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

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

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

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

extendPath :: AFilePath -> FilePath -> AFilePath
extendPath (P [FilePath]
path) FilePath
node = [FilePath] -> AFilePath
P (FilePath
nodeFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
path)

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

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

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

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

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

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

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

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

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

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

-}