module Data.Git.Named
( RefSpecTy(..)
, RefContentTy(..)
, RefName(..)
, readPackedRefs
, PackedRefs(..)
, existsRefFile
, writeRefFile
, readRefFile
, looseHeadsList
, looseTagsList
, looseRemotesList
) where
import Control.Applicative ((<$>))
import qualified Filesystem as F
import qualified Filesystem.Path.Rules as FP (posix, decode, encode, encodeString, decodeString)
import Filesystem.Path.CurrentOS hiding (root)
import Data.String
import Data.Git.Path
import Data.Git.Ref
import Data.List (isPrefixOf)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Prelude hiding (FilePath)
data RefSpecTy = RefHead
| RefOrigHead
| RefFetchHead
| RefBranch RefName
| RefTag RefName
| RefRemote RefName
| RefPatches String
| RefStash
| RefOther String
deriving (Show,Eq,Ord)
data RefContentTy = RefDirect Ref
| RefLink RefSpecTy
| RefContentUnknown B.ByteString
deriving (Show,Eq)
newtype RefName = RefName { refNameRaw :: String }
deriving (Show,Eq,Ord)
instance IsString RefName where
fromString s
| isValidRefName s = RefName s
| otherwise = error ("invalid RefName " ++ show s)
isValidRefName :: String -> Bool
isValidRefName s = not (or $ map isBadChar s)
where isBadChar :: Char -> Bool
isBadChar c = c <= ' ' || c >= toEnum 0x7f || c `elem` badAscii
badAscii = [ '~', '^', ':', '\\', '*', '?', '[' ]
isValidRefFilepath :: FilePath -> Bool
isValidRefFilepath f
| valid f = isValidRefName $ encodeString f
| otherwise = False
pathDecode :: B.ByteString -> FilePath
pathDecode = FP.decode FP.posix
pathEncode :: FilePath -> B.ByteString
pathEncode = FP.encode FP.posix
toRefTy :: String -> RefSpecTy
toRefTy s
| "refs/tags/" `isPrefixOf` s = RefTag $ RefName $ drop 10 s
| "refs/heads/" `isPrefixOf` s = RefBranch $ RefName $ drop 11 s
| "refs/remotes/" `isPrefixOf` s = RefRemote $ RefName $ drop 13 s
| "refs/patches/" `isPrefixOf` s = RefPatches $ drop 13 s
| "refs/stash" == s = RefStash
| "HEAD" == s = RefHead
| "ORIG_HEAD" == s = RefOrigHead
| "FETCH_HEAD" == s = RefFetchHead
| otherwise = RefOther $ s
fromRefTy :: RefSpecTy -> String
fromRefTy (RefBranch h) = "refs/heads/" ++ refNameRaw h
fromRefTy (RefTag h) = "refs/tags/" ++ refNameRaw h
fromRefTy (RefRemote h) = "refs/remotes/" ++ refNameRaw h
fromRefTy (RefPatches h) = "refs/patches/" ++ h
fromRefTy RefStash = "refs/stash"
fromRefTy RefHead = "HEAD"
fromRefTy RefOrigHead = "ORIG_HEAD"
fromRefTy RefFetchHead = "FETCH_HEAD"
fromRefTy (RefOther h) = h
toPath :: FilePath -> RefSpecTy -> FilePath
toPath gitRepo (RefBranch h) = gitRepo </> "refs" </> "heads" </> fromString (refNameRaw h)
toPath gitRepo (RefTag h) = gitRepo </> "refs" </> "tags" </> fromString (refNameRaw h)
toPath gitRepo (RefRemote h) = gitRepo </> "refs" </> "remotes" </> fromString (refNameRaw h)
toPath gitRepo (RefPatches h) = gitRepo </> "refs" </> "patches" </> fromString h
toPath gitRepo RefStash = gitRepo </> "refs" </> "stash"
toPath gitRepo RefHead = gitRepo </> "HEAD"
toPath gitRepo RefOrigHead = gitRepo </> "ORIG_HEAD"
toPath gitRepo RefFetchHead = gitRepo </> "FETCH_HEAD"
toPath gitRepo (RefOther h) = gitRepo </> fromString h
data PackedRefs a = PackedRefs
{ packedRemotes :: a
, packedBranchs :: a
, packedTags :: a
}
readPackedRefs :: FilePath
-> ([(RefName, Ref)] -> a)
-> IO (PackedRefs a)
readPackedRefs gitRepo constr = do
exists <- F.isFile (packedRefsPath gitRepo)
if exists then readLines else return $ finalize emptyPackedRefs
where emptyPackedRefs = PackedRefs [] [] []
readLines = finalize . foldl accu emptyPackedRefs . BC.lines <$> F.readFile (packedRefsPath gitRepo)
finalize (PackedRefs a b c) = PackedRefs (constr a) (constr b) (constr c)
accu a l
| "#" `BC.isPrefixOf` l = a
| otherwise =
let (ref, r) = B.splitAt 40 l
name = FP.encodeString FP.posix $ pathDecode $ B.tail r
in case toRefTy name of
RefTag refname -> a { packedTags = (refname, fromHex ref) : packedTags a }
RefBranch refname -> a { packedBranchs = (refname, fromHex ref) : packedBranchs a }
RefRemote refname -> a { packedRemotes = (refname, fromHex ref) : packedRemotes a }
_ -> a
listRefs :: FilePath -> IO [RefName]
listRefs root = listRefsAcc [] root
where listRefsAcc acc dir = do
files <- F.listDirectory dir
getRefsRecursively dir acc files
getRefsRecursively _ acc [] = return acc
getRefsRecursively dir acc (x:xs) = do
isDir <- F.isDirectory x
extra <- if isDir
then listRefsAcc [] dir
else let r = stripRoot x
in if isValidRefFilepath r
then return [fromString $ encodeString r]
else return []
getRefsRecursively dir (extra ++ acc) xs
stripRoot p = maybe (error "stripRoot invalid") id $ stripPrefix root p
looseHeadsList :: FilePath -> IO [RefName]
looseHeadsList gitRepo = listRefs (headsPath gitRepo)
looseTagsList :: FilePath -> IO [RefName]
looseTagsList gitRepo = listRefs (tagsPath gitRepo)
looseRemotesList :: FilePath -> IO [RefName]
looseRemotesList gitRepo = listRefs (remotesPath gitRepo)
existsRefFile :: FilePath -> RefSpecTy -> IO Bool
existsRefFile gitRepo specty = F.isFile $ toPath gitRepo specty
writeRefFile :: FilePath -> RefSpecTy -> RefContentTy -> IO ()
writeRefFile gitRepo specty refcont = F.writeFile filepath $ fromRefContent refcont
where filepath = toPath gitRepo specty
fromRefContent (RefLink link) = B.concat ["ref: ", pathEncode $ FP.decodeString FP.posix $ fromRefTy link, B.singleton 0xa]
fromRefContent (RefDirect ref) = B.concat [toHex ref, B.singleton 0xa]
fromRefContent (RefContentUnknown c) = c
readRefFile :: FilePath -> RefSpecTy -> IO RefContentTy
readRefFile gitRepo specty = toRefContent <$> F.readFile filepath
where filepath = toPath gitRepo specty
toRefContent content
| "ref: " `B.isPrefixOf` content = RefLink $ toRefTy $ FP.encodeString FP.posix $ pathDecode $ head $ BC.lines $ B.drop 5 content
| B.length content < 42 = RefDirect $ fromHex $ B.take 40 content
| otherwise = RefContentUnknown content