{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE OverloadedStrings #-}-- |-- Module : Data.Git.Storage-- License : BSD-style-- Maintainer : Vincent Hanquez <vincent@snarc.org>-- Stability : experimental-- Portability : unix--moduleData.Git.Storage(Git,packedNamed,gitRepoPath,openRepo,closeRepo,withRepo,withCurrentRepo,findRepo,isRepo,initRepo,iterateIndexes,findReference,findReferencesWithPrefix-- * getting objects,getObjectRaw,getObjectRawAt,getObject,getObjectAt,getObjectType-- * setting objects,setObject)whereimportFilesystemimportFilesystem.Pathhiding(concat)importFilesystem.Path.RulesimportSystem.EnvironmentimportControl.Applicative((<$>))importControl.ExceptionimportqualifiedControl.ExceptionasEimportControl.MonadimportData.StringimportData.List((\\),isPrefixOf)importData.IORefimportData.WordimportData.Git.NamedimportData.Git.Path(packedRefsPath)importData.Git.DeltaimportData.Git.Storage.FileReaderimportData.Git.Storage.PackIndeximportData.Git.Storage.ObjectimportData.Git.Storage.PackimportData.Git.Storage.LooseimportData.Git.Storage.CacheFileimportData.Git.RefimportqualifiedData.MapasMimportPreludehiding(FilePath)dataPackIndexReader=PackIndexReaderPackIndexHeaderFileReader-- | this is a cache representation of the packed-ref filetypePackedRef=CacheFile(M.MapRefSpecTyRef)-- | represent an git repo, with possibly already opened filereaders-- for indexes and packsdataGit=Git{gitRepoPath::FilePath,indexReaders::IORef[(Ref,PackIndexReader)],packReaders::IORef[(Ref,FileReader)],packedNamed::PackedRef}-- | open a new git repository contextopenRepo::FilePath->IOGitopenRepopath=liftM3(Gitpath)(newIORef[])(newIORef[])packedRefwherepackedRef=newCacheVal(packedRefsPathpath)(M.fromList<$>readPackedRefspath)M.empty-- | close a git repository context, closing all remaining fileReaders.closeRepo::Git->IO()closeRepo(Git{indexReaders=ireaders,packReaders=preaders})=domapM_(closeIndexReader.snd)=<<readIORefireadersmapM_(fileReaderClose.snd)=<<readIORefpreaderswherecloseIndexReader(PackIndexReader_fr)=fileReaderClosefr-- | Find the git repository from the current directory.---- If the environment variable GIT_DIR is set then it's used,-- otherwise iterate from current directory, up to 128 parents for a .git directoryfindRepo::IOFilePathfindRepo=domenvDir<-E.catch(Just.decodeStringposix_ghc704<$>getEnv"GIT_DIR")(\(_::SomeException)->returnNothing)casemenvDirofNothing->getWorkingDirectory>>=checkDir0JustenvDir->doe<-isRepoenvDirwhen(note)$error"environment GIT_DIR is not a git repository"returnenvDirwherecheckDir::Int->FilePath->IOFilePathcheckDir128_=error"not a git repository"checkDirnwd=doletfilepath=wd</>".git"e<-isRepofilepathifethenreturnfilepathelsecheckDir(n+1)(ifabsolutewdthenparentwdelsewd</>"..")-- | execute a function f with a git context.withRepopathf=bracket(openRepopath)closeRepof-- | execute a function on the current repository.---- check findRepo to see how the git repository is found.withCurrentRepo::(Git->IOa)->IOawithCurrentRepof=findRepo>>=\path->withRepopathf-- | basic checks to see if a specific path looks like a git repo.isRepo::FilePath->IOBoolisRepopath=dodir<-isDirectorypathsubDirs<-mapM(isDirectory.(path</>))["branches","hooks","info","logs","objects","refs","refs"</>"heads","refs"</>"tags"]return$and([dir]++subDirs)-- | initialize a new repository at a specific location.initRepo::FilePath->IO()initRepopath=doexists<-isDirectorypathwhenexists$error"destination directory already exists"createDirectoryTruepathmapM_(createDirectoryFalse.(path</>))["branches","hooks","info","logs","objects","refs","refs"</>"heads","refs"</>"tags"]iterateIndexesgitfinitAcc=doallIndexes<-packIndexEnumerate(gitRepoPathgit)readers<-readIORef(indexReadersgit)(a,terminate)<-loopinitAccreadersifterminatethenreturnaelsereadRemainingIndexesa(allIndexes\\mapfstreaders)whereloopacc[]=return(acc,False)loopacc(r:rs)=do(nacc,terminate)<-faccrifterminatethenreturn(nacc,True)elseloopnaccrsreadRemainingIndexesacc[]=returnaccreadRemainingIndexesacc(idxref:idxs)=dofr<-packIndexOpen(gitRepoPathgit)idxrefidx<-packIndexReadHeaderfrletidxreader=PackIndexReaderidxfrletr=(idxref,idxreader)modifyIORef(indexReadersgit)(\l->r:l)(nacc,terminate)<-faccrifterminatethenreturnnaccelsereadRemainingIndexesnaccidxs-- | Get the object location of a specific referencefindReference::Git->Ref->IOObjectLocationfindReferencegitref=maybeNotFoundid<$>(findLoose`mplusIO`findInIndexes)wherefindLoose::IO(MaybeObjectLocation)findLoose=doisLoose<-looseExists(gitRepoPathgit)refifisLoosethenreturn(Just$Looseref)elsereturnNothingfindInIndexes::IO(MaybeObjectLocation)findInIndexes=iterateIndexesgitisinIndexNothing--f -> (a -> IndexReader -> IO (a,Bool)) -> a -> IO aisinIndexacc(idxref,(PackIndexReaderidxhdrindexreader))=domloc<-packIndexGetReferenceLocationidxhdrindexreaderrefcasemlocofNothing->return(acc,False)Justloc->return(Just$Packedidxrefloc,True)mplusIO::IO(Maybea)->IO(Maybea)->IO(Maybea)mplusIOfg=f>>=\vopt->casevoptofNothing->gJustv->return$Justv-- | get all the references that start by a specific prefixfindReferencesWithPrefix::Git->String->IO[Ref]findReferencesWithPrefixgitpre|invalidLength=error("not a valid prefix: "++showpre)|not(isHexStringpre)=error("reference prefix contains non hexchar: "++showpre)|otherwise=dolooseRefs<-looseEnumerateWithPrefixFilter(gitRepoPathgit)(take2pre)matchRefpackedRefs<-concat<$>iterateIndexesgitidxPrefixMatch[]return(looseRefs++packedRefs)where-- not very efficient way to do that... will do for now.matchRefref=pre`isPrefixOf`toHexStringrefinvalidLength=lengthpre<2||lengthpre>39idxPrefixMatchacc(_,(PackIndexReaderidxhdrindexreader))=dorefs<-packIndexGetReferencesWithPrefixidxhdrindexreaderprereturn(refs:acc,False)readRawFromPack::Git->Ref->Word64->IO(FileReader,PackedObjectRaw)readRawFromPackgitprefoffset=doreaders<-readIORef(packReadersgit)reader<-maybegetDefaultreturn$lookupprefreaderspo<-packReadRawAtOffsetreaderoffsetreturn(reader,po)wheregetDefault=dop<-packOpen(gitRepoPathgit)prefmodifyIORef(packReadersgit)((pref,p):)returnpreadFromPack::Git->Ref->Word64->Bool->IO(MaybeObjectInfo)readFromPackgitpreforesolveDelta=do(reader,x)<-readRawFromPackgitprefoifresolveDeltathenresolvereaderoxelsereturn$Just$generifyHeaderxwheregenerifyHeader::PackedObjectRaw->ObjectInfogenerifyHeader(po,objData)=ObjectInfo{oiHeader=hdr,oiData=objData,oiChains=[]}wherehdr=(poiTypepo,poiActualSizepo,poiExtrapo)resolve::FileReader->Word64->PackedObjectRaw->IO(MaybeObjectInfo)resolvereaderoffset(po,objData)=docase(poiTypepo,poiExtrapo)of(TypeDeltaOff,Justptr@(PtrOfsdoff))->doletdelta=deltaReadobjDataletnoffset=offset-doffbase<-resolvereadernoffset=<<packReadRawAtOffsetreadernoffsetreturn$addToChainptr$applyDeltadeltabase(TypeDeltaRef,Justptr@(PtrRefbref))->doletdelta=deltaReadobjDatabase<-getObjectRawgitbrefTruereturn$addToChainptr$applyDeltadeltabase_->return$Just$generifyHeader(po,objData)addToChainptr(Justoi)=Just(oi{oiChains=ptr:oiChainsoi})addToChain_Nothing=NothingapplyDelta::MaybeDelta->MaybeObjectInfo->MaybeObjectInfoapplyDelta(Justdelta@(Delta_rSize_))(JustobjInfo)=Just$objInfo{oiHeader=(\(a,_,c)->(a,rSize,c))$oiHeaderobjInfo,oiData=deltaApply(oiDataobjInfo)delta}applyDelta__=Nothing-- | get an object from repositorygetObjectRawAt::Git->ObjectLocation->Bool->IO(MaybeObjectInfo)getObjectRawAt_NotFound_=returnNothinggetObjectRawAtgit(Looseref)_=Just.(\(h,d)->ObjectInfohd[])<$>looseReadRaw(gitRepoPathgit)refgetObjectRawAtgit(Packedprefo)resolveDelta=readFromPackgitpreforesolveDelta-- | get an object from repositorygetObjectRaw::Git->Ref->Bool->IO(MaybeObjectInfo)getObjectRawgitrefresolveDelta=doloc<-findReferencegitrefgetObjectRawAtgitlocresolveDelta-- | get an object type from repositorygetObjectType::Git->Ref->IO(MaybeObjectType)getObjectTypegitref=findReferencegitref>>=getObjectTypeAtwheregetObjectTypeAtNotFound=returnNothinggetObjectTypeAt(Loose_)=Just.(\(t,_,_)->t)<$>looseReadHeader(gitRepoPathgit)refgetObjectTypeAt(Packedprefo)=fmap((\(ty,_,_)->ty).oiHeader)<$>readFromPackgitprefoTrue-- | get an object from repository using a location to reference it.getObjectAt::Git->ObjectLocation->Bool->IO(MaybeObject)getObjectAtgitlocresolveDelta=maybeNothingtoObj<$>getObjectRawAtgitlocresolveDeltawheretoObj(ObjectInfo{oiHeader=(ty,_,extra),oiData=objData})=packObjectFromRaw(ty,extra,objData)-- | get an object from repository using a ref.getObject::Git-- ^ repository->Ref-- ^ the object's reference to->Bool-- ^ whether to resolve deltas if found->IO(MaybeObject)-- ^ returned object if foundgetObjectgitrefresolveDelta=maybeNothingtoObj<$>getObjectRawgitrefresolveDeltawheretoObj(ObjectInfo{oiHeader=(ty,_,extra),oiData=objData})=packObjectFromRaw(ty,extra,objData)-- | set an object in the store and returns the new ref-- this is always going to create a loose object.setObject::Git->Object->IORefsetObjectgitobj=looseWrite(gitRepoPathgit)obj