{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE ViewPatterns #-}{-# LANGUAGE DeriveDataTypeable #-}-- |-- Module : Data.Git.Repository-- License : BSD-style-- Maintainer : Vincent Hanquez <vincent@snarc.org>-- Stability : experimental-- Portability : unix--moduleData.Git.Repository(Git,HTree,HTreeEnt(..),getCommitMaybe,getCommit,getTreeMaybe,getTree,rewrite,buildHTree,resolvePath,resolveTreeish,resolveRevision,initRepo,isRepo)whereimportControl.Applicative((<$>))importControl.MonadimportControl.Exception(Exception,throw)importData.Maybe(fromMaybe)importData.List(find)importData.DataimportData.ByteString(ByteString)importData.Git.NamedimportData.Git.TypesimportData.Git.Storage.ObjectimportData.Git.StorageimportData.Git.RevisionimportData.Git.Storage.LooseimportData.Git.Storage.CacheFileimportData.Git.RefimportqualifiedData.MapasM-- | hierarchy tree, either a reference to a blob (file) or a tree (directory).dataHTreeEnt=TreeDirRefHTree|TreeFileReftypeHTree=[(Int,ByteString,HTreeEnt)]-- | Exception when trying to convert an object pointed by 'Ref' to-- a type that is differentdataInvalidType=InvalidTypeRefObjectTypederiving(Show,Eq,Data,Typeable)instanceExceptionInvalidType-- should be a standard function that do that...mapJustMf(Justo)=fomapJustM_Nothing=returnNothing-- | get a specified commitgetCommitMaybe::Git->Ref->IO(MaybeCommit)getCommitMaybegitref=maybeNothingobjectToCommit<$>getObjectgitrefTrue-- | get a specified commit but raises an exception if doesn't exists or type is not appropriategetCommit::Git->Ref->IOCommitgetCommitgitref=maybeerrid.objectToCommit<$>getObject_gitrefTruewhereerr=throw$InvalidTyperefTypeCommit-- | get a specified treegetTreeMaybe::Git->Ref->IO(MaybeTree)getTreeMaybegitref=maybeNothingobjectToTree<$>getObjectgitrefTrue-- | get a specified tree but raisegetTree::Git->Ref->IOTreegetTreegitref=maybeerrid.objectToTree<$>getObject_gitrefTruewhereerr=throw$InvalidTyperefTypeTree-- | try to resolve a string to a specific commit ref-- for example: HEAD, HEAD^, master~3, shortRefresolveRevision::Git->Revision->IO(MaybeRef)resolveRevisiongit(Revisionprefixmodifiers)=getCacheVal(packedNamedgit)>>=\c->resolvePrefixc>>=modfmodifierswhereresolvePrefixlookupCache=tryResolvers[resolveNamedPrefixlookupCachenamedResolvers,resolvePrePrefix]resolveNamedPrefix_[]=returnNothingresolveNamedPrefixlookupCache(x:xs)=followToRef(resolveNamedPrefixlookupCachexs)xwherefollowToRefonFailurerefty=doexists<-existsRefFile(gitRepoPathgit)reftyifexiststhendorefcont<-readRefFile(gitRepoPathgit)reftycaserefcontofRefDirectref->return$JustrefRefLinkrefspecty->followToRefonFailurerefspecty_->error"cannot handle reference content"elsecaseM.lookupreftylookupCacheofNothing->onFailurey->returnynamedResolvers=caseprefixof"HEAD"->[RefHead]"ORIG_HEAD"->[RefOrigHead]"FETCH_HEAD"->[RefFetchHead]_->[RefTagprefix,RefBranchprefix,RefRemoteprefix]tryResolvers::[IO(MaybeRef)]->IOReftryResolvers[]=return$fromHexStringprefixtryResolvers(resolver:xs)=resolver>>=isResolvedwhereisResolved(Justr)=returnrisResolvedNothing=tryResolversxsresolvePrePrefix::IO(MaybeRef)resolvePrePrefix=dorefs<-findReferencesWithPrefixgitprefixcaserefsof[]->returnNothing[r]->return(Justr)_->error"multiple references with this prefix"modf[]ref=return(Justref)modf(RevModParenti:xs)ref=doparentRefs<-getParentRefsrefcaseiof0->error"revision modifier ^0 is not implemented"_->casedrop(i-1)parentRefsof[]->error"no such parent"(p:_)->modfxspmodf(RevModParentFirstN1:xs)ref=modf(RevModParent1:xs)refmodf(RevModParentFirstNn:xs)ref=doparentRefs<-getParentRefsrefmodf(RevModParentFirstN(n-1):xs)(headparentRefs)modf(_:_)_=error"unimplemented revision modifier"getParentRefsref=commitParents<$>getCommitgitref-- | returns a tree from a ref that might be either a commit, a tree or a tag.resolveTreeish::Git->Ref->IO(MaybeTree)resolveTreeishgitref=getObjectgitrefTrue>>=mapJustMrecToTreewhererecToTree(objectToCommit->Just(Commit{commitTreeish=tree}))=resolveTreeishgittreerecToTree(objectToTag->Just(Tagtref____))=resolveTreeishgittrefrecToTree(objectToTree->Justt@(Tree_))=return$JusttrecToTree_=returnNothing-- | Rewrite a set of commits from a revision and returns the new ref.---- If during revision traversal (diving) there's a commit with zero or multiple-- parents then the traversal will stop regardless of the amount of parent requested.---- calling "rewrite f 2 (revisionOf d)" on the following tree:---- a <-- b <-- c <-- d---- result in the following tree after mapping with f:---- a <-- f(b) <-- f(c) <-- f(d)--rewrite::Git-- ^ Repository->(Commit->IOCommit)-- ^ Mapping function->Revision-- ^ revision to start from->Int-- ^ the number of parents to map->IORef-- ^ return the new head REFrewritegitmapCommitrevisionnbParent=doref<-fromMaybe(error"revision cannot be found")<$>resolveRevisiongitrevisionresolveParentsnbParentref>>=process.reversewhereresolveParents::Int->Ref->IO[(Ref,Commit)]resolveParents0ref=(:[]).(,)ref<$>getCommitgitrefresolveParentsnref=docommit<-getCommitgitrefcasecommitParentscommitof[parentRef]->liftM((ref,commit):)(resolveParents(n-1)parentRef)_->return[(ref,commit)]process[]=error"nothing to rewrite"process((_,commit):next)=mapCommitcommit>>=looseWrite(gitRepoPathgit).toObject>>=fliprewriteOnenextrewriteOneprevRef[]=returnprevRefrewriteOneprevRef((_,commit):next)=donewCommit<-mapCommit$commit{commitParents=[prevRef]}ref<-looseWrite(gitRepoPathgit)(toObjectnewCommit)rewriteOnerefnext-- | build a hierarchy tree from a tree objectbuildHTree::Git->Tree->IOHTreebuildHTreegit(Treeents)=mapMresolveTreeentswhereresolveTree(perm,ent,ref)=doobj<-getObjectTypegitrefcaseobjofJustTypeBlob->return(perm,ent,TreeFileref)JustTypeTree->doctree<-getTreegitrefdir<-buildHTreegitctreereturn(perm,ent,TreeDirrefdir)Just_->error"wrong type embedded in tree object"Nothing->error"unknown reference in tree object"-- | resolve the ref (tree or blob) related to a path at a specific commit refresolvePath::Git-- ^ repository->Ref-- ^ commit reference->[ByteString]-- ^ paths->IO(MaybeRef)resolvePathgitcommitRefpaths=getCommitgitcommitRef>>=\commit->resolve(commitTreeishcommit)pathswhereresolve::Ref->[ByteString]->IO(MaybeRef)resolvetreeRef[]=return$JusttreeRefresolvetreeRef(x:xs)=do(Treeents)<-getTreegittreeRefletcEnt=treeEntRef<$>findEntxentsifxs==[]thenreturncEntelsemaybe(returnNothing)(\z->resolvezxs)cEntfindEntx=find(\(_,b,_)->b==x)treeEntRef(_,_,r)=r