module Git.Path (
gitPath
, gitRoot
, gitDeref
, pathExistOr
) where
import Control.Monad ((<=<))
import Control.Monad.Trans (liftIO)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C
import System.FilePath hiding (normalise)
import System.Directory
import System.Posix.Files
gitPath :: FilePath -> IO FilePath
gitPath f = do
root <- gitRoot
return $ root </> ".git" </> f
gitRoot :: IO FilePath
gitRoot = do
mp <- liftIO $ gitRoot' "."
case mp of
Just path -> return (path ++ [pathSeparator])
Nothing -> error "fatal: Not a git repository (or any of the parent directories)"
gitRoot' :: FilePath -> IO (Maybe FilePath)
gitRoot' path = do
b <- fileExist path
case b of
True -> do
d <- dirIsRoot path
case d of
True -> return (Just (normalise path))
False -> do
let newPath = ".." </> path
canPath <- canonicalizePath path
canNewPath <- canonicalizePath newPath
if (canPath == canNewPath)
then return Nothing
else gitRoot' newPath
False -> return Nothing
where
dirIsRoot p = liftIO $ fileExist (p </> ".git")
gitDeref :: String -> IO C.ByteString
gitDeref = deref <=< L.readFile <=< gitPath
where
deref bs
| refHeader `L.isPrefixOf` bs = gitDeref refPath
| otherwise = return (chomp bs)
where
refHeader = C.pack "ref: "
refPath = C.unpack (chomp $ L.drop 5 bs)
chomp = C.takeWhile (/= '\n')
pathExistOr :: (FilePath -> IO FilePath) -> FilePath -> IO FilePath
pathExistOr f path = do
exists <- doesFileExist path
if exists
then return path
else f path
normalise :: FilePath -> FilePath
normalise path = joinDrive (normaliseDrive drv) (f pth)
++ [pathSeparator | isDirPath pth]
where
(drv,pth) = splitDrive path
isDirPath xs = lastSep xs
|| not (null xs) && last xs == '.' && lastSep (init xs)
lastSep xs = not (null xs) && isPathSeparator (last xs)
f = joinPath . dropDots [] . splitDirectories . propSep
propSep (a:b:xs)
| isPathSeparator a && isPathSeparator b = propSep (a:xs)
propSep (a:xs)
| isPathSeparator a = pathSeparator : propSep xs
propSep (x:xs) = x : propSep xs
propSep [] = []
dropDots _ xs | all (==".") xs = ["."]
dropDots acc xs = dropDots' acc xs
dropDots' acc (".":xs) = dropDots' acc xs
dropDots' acc (x:xs) = dropDots' (x:acc) xs
dropDots' acc [] = reverse acc
normaliseDrive :: FilePath -> FilePath
normaliseDrive = id