-------------------------------------------------------------------------------- -------------------------------------------------------------------------------- -- | --Module : Path --Author : Joe Fredette --License : BSD3 --Copyright : Joe Fredette -- --Maintainer : Joe Fredette --Stability : Unstable --Portability : Not portable (*nix style only) -- -------------------------------------------------------------------------------- --Description : Portable interaction with filesystem Paths, currently only works -- with *nix paths (where *nix path is of the form "/usr/bin/.../" -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- module HackMail.Data.Path ( Path (..) , VPath (..) , parse, parseV , splitOn, (+/+) , liftToPath1, liftToPath2 , pathExists, mkDeliverablePath , toFilePath ) where {- Needs to be rewritten to handle Windows/*nix/etc paths, - Needs to be rewritten to use Parsec - Needs Documentation -} --import Text.ParserCombinators.Parsec import Data.List import System.Directory {- Here we define a type which parses paths from Unix/Windows/etc into a generic type. -} 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 -- for now, this is hackish but it works. 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)