{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} module Data.Git.Reference ( RefTarget(..) , Reference(..) , createRef , lookupRef , listRefNames , allRefsFlag , oidRefsFlag , looseOidRefsFlag , symbolicRefsFlag , mapRefs , mapAllRefs , mapOidRefs , mapLooseOidRefs , mapSymbolicRefs , lookupId , writeRef , writeRef_ ) where import Bindings.Libgit2 import Data.ByteString.Unsafe import Data.Git.Internal import qualified Data.Text as T import qualified Data.Text.Encoding as E import Foreign.Marshal.Array import qualified Prelude import Prelude ((+),(-)) default (Text) data RefTarget = RefTargetId Oid | RefTargetSymbolic Text deriving (Show, Eq) data Reference = Reference { refRepo :: Repository , refName :: Text , refTarget :: RefTarget , refObj :: ObjPtr C'git_reference } deriving Show -- int git_reference_lookup(git_reference **reference_out, -- git_repository *repo, const char *name) createRef :: Text -> RefTarget -> Repository -> Reference createRef name target repo = Reference { refRepo = repo , refName = name , refTarget = target , refObj = Nothing } lookupRef :: Text -> Repository -> IO (Maybe Reference) lookupRef name repo = alloca $ \ptr -> do r <- withForeignPtr (repositoryPtr repo) $ \repoPtr -> withCStringable name $ \namePtr -> c'git_reference_lookup ptr repoPtr namePtr if r < 0 then return Nothing else do ref <- peek ptr fptr <- newForeignPtr p'git_reference_free ref return $ Just $ Reference { refRepo = repo , refName = name , refTarget = undefined , refObj = Just fptr } writeRef :: Reference -> IO Reference writeRef ref = alloca $ \ptr -> do withForeignPtr repo $ \repoPtr -> withCStringable (refName ref) $ \namePtr -> do r <- case refTarget ref of RefTargetId (PartialOid {}) -> throwIO RefCannotCreateFromPartialOid RefTargetId (Oid (COid coid)) -> withForeignPtr coid $ \coidPtr -> c'git_reference_create_oid ptr repoPtr namePtr coidPtr (fromBool True) RefTargetSymbolic symName -> withCStringable symName $ \symPtr -> c'git_reference_create_symbolic ptr repoPtr namePtr symPtr (fromBool True) when (r < 0) $ throwIO ReferenceCreateFailed fptr <- newForeignPtr_ =<< peek ptr return ref { refObj = Just fptr } where repo = fromMaybe (error "Repository invalid") (repoObj (refRepo ref)) writeRef_ :: Reference -> IO () writeRef_ = void . writeRef -- int git_reference_name_to_oid(git_oid *out, git_repository *repo, -- const char *name) lookupId :: Text -> Repository -> IO Oid lookupId name repos = alloca $ \ptr -> withCStringable name $ \namePtr -> withForeignPtr repo $ \repoPtr -> do r <- c'git_reference_name_to_oid ptr repoPtr namePtr when (r < 0) $ throwIO ReferenceLookupFailed Oid <$> COid <$> newForeignPtr_ ptr where repo = fromMaybe (error "Repository invalid") (repoObj repos) -- int git_reference_create_symbolic(git_reference **ref_out, -- git_repository *repo, const char *name, const char *target, int force) --createSymbolicRef = c'git_reference_create_symbolic -- int git_reference_create_oid(git_reference **ref_out, git_repository *repo, -- const char *name, const git_oid *id, int force) --createNamedRef = c'git_reference_create_oid -- const git_oid * git_reference_oid(git_reference *ref) --refId = c'git_reference_oid -- const char * git_reference_target(git_reference *ref) --refTarget = c'git_reference_target -- git_ref_t git_reference_type(git_reference *ref) --refType = c'git_reference_type -- const char * git_reference_name(git_reference *ref) --refName = c'git_reference_name -- int git_reference_resolve(git_reference **resolved_ref, git_reference *ref) --resolveRef = c'git_reference_resolve -- int git_reference_set_target(git_reference *ref, const char *target) --setRefTarget = c'git_reference_set_target -- int git_reference_set_oid(git_reference *ref, const git_oid *id) --setRefId = c'git_reference_set_oid -- int git_reference_rename(git_reference *ref, const char *new_name, -- int force) --renameRef = c'git_reference_rename -- int git_reference_delete(git_reference *ref) --deleteRef = c'git_reference_delete -- int git_reference_packall(git_repository *repo) --packallRefs = c'git_reference_packall data ListFlags = ListFlags { listFlagInvalid :: Bool , listFlagOid :: Bool , listFlagSymbolic :: Bool , listFlagPacked :: Bool , listFlagHasPeel :: Bool } deriving (Show, Eq) allRefsFlag :: ListFlags allRefsFlag = ListFlags { listFlagInvalid = False , listFlagOid = True , listFlagSymbolic = True , listFlagPacked = True , listFlagHasPeel = False } symbolicRefsFlag :: ListFlags symbolicRefsFlag = ListFlags { listFlagInvalid = False , listFlagOid = False , listFlagSymbolic = True , listFlagPacked = False , listFlagHasPeel = False } oidRefsFlag :: ListFlags oidRefsFlag = ListFlags { listFlagInvalid = False , listFlagOid = True , listFlagSymbolic = False , listFlagPacked = True , listFlagHasPeel = False } looseOidRefsFlag :: ListFlags looseOidRefsFlag = ListFlags { listFlagInvalid = False , listFlagOid = True , listFlagSymbolic = False , listFlagPacked = False , listFlagHasPeel = False } gitStrArray2List :: Ptr C'git_strarray -> IO [Text] gitStrArray2List gitStrs = do count <- fromIntegral <$> ( peek $ p'git_strarray'count gitStrs ) strings <- peek $ p'git_strarray'strings gitStrs r0 <- Foreign.Marshal.Array.peekArray count strings r1 <- sequence $ fmap peekCString r0 return $ fmap T.pack r1 flagsToInt :: ListFlags -> CUInt flagsToInt flags = (if listFlagOid flags then 1 else 0) + (if listFlagSymbolic flags then 2 else 0) + (if listFlagPacked flags then 4 else 0) + (if listFlagHasPeel flags then 8 else 0) listRefNames :: Repository -> ListFlags -> IO [Text] listRefNames repo flags = alloca $ \c'refs -> withForeignPtr (repositoryPtr repo) $ \repoPtr -> do r <- c'git_reference_list c'refs repoPtr (flagsToInt flags) when (r < 0) $ throwIO ReferenceLookupFailed refs <- gitStrArray2List c'refs c'git_strarray_free c'refs return refs --listRefs = c'git_reference_list -- int git_reference_foreach(git_repository *repo, unsigned int list_flags, -- int (*callback)(const char *, void *), void *payload) type ForeachRefCallback = Text -> IO () foreachRefCallbackThunk :: ForeachRefCallback -> CString -> Ptr () -> IO CInt foreachRefCallbackThunk callback name _ = do nameText <- E.decodeUtf8 <$> unsafePackCString name callback nameText return 0 mapRefs :: Repository -> ListFlags -> ForeachRefCallback -> IO () mapRefs repo flags cb = withForeignPtr (repositoryPtr repo) $ \repoPtr -> do fun <- mk'git_reference_foreach_callback (foreachRefCallbackThunk cb) r <- c'git_reference_foreach repoPtr (flagsToInt flags) fun nullPtr -- jww (2012-12-14): Does the return type mean anything here? when (r < 0) $ return () return () mapAllRefs :: Repository -> ForeachRefCallback -> IO () mapAllRefs repo = mapRefs repo allRefsFlag mapOidRefs :: Repository -> ForeachRefCallback -> IO () mapOidRefs repo = mapRefs repo oidRefsFlag mapLooseOidRefs :: Repository -> ForeachRefCallback -> IO () mapLooseOidRefs repo = mapRefs repo looseOidRefsFlag mapSymbolicRefs :: Repository -> ForeachRefCallback -> IO () mapSymbolicRefs repo = mapRefs repo symbolicRefsFlag {- foreachRefCallbackThunk :: Storable a => ForeachRefCallback a -> CString -> Ptr () -> IO CInt foreachRefCallbackThunk callback name payload = do nameText <- E.decodeUtf8 <$> unsafePackCString name payloadValue <- peek (castPtr payload) maybe (-1) (const 0) <$> callback nameText payloadValue mapRefsWith :: Storable a => Repository -> ListFlags -> a -> ForeachRefCallback a -> IO () mapRefsWith repo flags payload cb = withForeignPtr (repositoryPtr repo) $ \repoPtr -> do fun <- mk'git_reference_foreach_callback (foreachRefCallbackThunk cb) with payload $ \payloadPtr -> do r <- c'git_reference_foreach repoPtr (flagsToInt flags) fun (castPtr payloadPtr) -- jww (2012-12-14): Does the return type mean anything here? when (r < 0) $ return () return () -} -- int git_reference_is_packed(git_reference *ref) --refIsPacked = c'git_reference_is_packed -- int git_reference_reload(git_reference *ref) --reloadRef = c'git_reference_reload -- void git_reference_free(git_reference *ref) --freeRef = c'git_reference_free -- int git_reference_cmp(git_reference *ref1, git_reference *ref2) --compareRef = c'git_reference_cmp -- Refs.hs