module HackMail.Data.Path
( Path (..)
, VPath (..)
, parse, parseV
, splitOn, (+/+)
, liftToPath1, liftToPath2
, pathExists, mkDeliverablePath
, toFilePath
) where
import Data.List
import System.Directory
type FileName = String
data Path = P { virtualPath :: VPath
, relative :: Bool
}
deriving (Eq, Show)
data VPath = VPath :/: String
| Root
deriving (Eq)
instance Show VPath where
show Root = ""
show (d :/: r) = (show d) ++ "/" ++ r
parse :: FilePath -> Path
parse "" = error "Cannot parse an empty path"
parse s@(c:cs)
| c == '/' = P (adj cs) False
| otherwise = P (adj s) True
where adj q = parseV $ if last q == '/' then q else q++"/"
parseV :: FilePath -> VPath
parseV s = fromList tokPath
where tokPath = splitOn '/' s
splitOn :: Eq a => a -> [a] -> [[a]]
splitOn _ [] = []
splitOn c ls = f : (splitOn c (tail l))
where (f, l) = span (/=c) ls
(+/+) :: Path -> Path -> Path
(+/+) = (liftToPath2 catVPaths)
catVPaths :: VPath -> VPath -> VPath
catVPaths p q = fromList $ (toList p) ++ (toList q)
toList :: VPath -> [String]
toList Root = []
toList (p :/: p') = (toList p) ++ [p']
fromList :: [String] -> VPath
fromList tokPath = foldl (:/:) Root tokPath
pathExists :: Path -> IO Bool
pathExists (P p b) = doesDirectoryExist (adj $ show p)
where adj = if b then tail else id
mkDeliverablePath :: Path -> FileName -> FilePath
mkDeliverablePath (P p b) fn = adj $ (show p) ++ "/" ++ fn
where adj = if b then tail else id
toFilePath :: Path -> FilePath
toFilePath p = mkDeliverablePath p ""
liftToPath1 f (P p b) = (P (f p) b)
liftToPath2 f (P p1 b1) (P p2 b2) = (P (f p1 p2) b1)