{-# LANGUAGE CPP #-}{- |
Module : Data.FileStore.Darcs
Copyright : Copyright (C) 2009 Gwern Branwen
License : BSD 3
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : GHC 6.10 required
A versioned filestore implemented using darcs.
Normally this module should not be imported: import
"Data.FileStore" instead. -}moduleData.FileStore.Darcs(darcsFileStore)whereimportControl.Exception(throwIO)importControl.Monad(when)importData.Time(formatTime)importSystem.Locale(defaultTimeLocale)importData.List(sort,isPrefixOf)#ifdef USE_MAXCOUNTimportData.List(isInfixOf)#endifimportSystem.Exit(ExitCode(..))importSystem.Directory(doesDirectoryExist,createDirectoryIfMissing)importSystem.FilePath((</>),dropFileName,addTrailingPathSeparator)importData.FileStore.DarcsXml(parseDarcsXML)importData.FileStore.TypesimportData.FileStore.Utils(withSanityCheck,hashsMatch,runShellCommand,ensureFileExists,grepSearchRepo,withVerifyDir)importCodec.Binary.UTF8.String(encodeString)importData.ByteString.Lazy.UTF8(toString)importqualifiedData.ByteString.LazyasB(ByteString,writeFile)-- | Return a filestore implemented using the Darcs distributed revision control system-- (<http://darcs.net/>).darcsFileStore::FilePath->FileStoredarcsFileStorerepo=FileStore{initialize=darcsInitrepo,save=darcsSaverepo,retrieve=darcsRetrieverepo,delete=darcsDeleterepo,rename=darcsMoverepo,history=darcsLogrepo,latest=darcsLatestRevIdrepo,revision=darcsGetRevisionrepo,index=darcsIndexrepo,directory=darcsDirectoryrepo,search=darcsSearchrepo,idsMatch=consthashsMatchrepo}-- | Run a darcs command and return error status, error output, standard output. The repository-- is used as working directory.runDarcsCommand::FilePath->String->[String]->IO(ExitCode,String,B.ByteString)runDarcsCommandrepocommandargs=do(status,err,out)<-runShellCommandrepoNothing"darcs"(command:args)return(status,toStringerr,out)----------------------------- End utility functions and types-- Begin repository creation & modification----------------------------- | Initialize a repository, creating the directory if needed.darcsInit::FilePath->IO()darcsInitrepo=doexists<-doesDirectoryExistrepowhenexists$withVerifyDirrepo$throwIORepositoryExistscreateDirectoryIfMissingTruerepo(status,err,_)<-runDarcsCommandrepo"init"[]ifstatus==ExitSuccessthenreturn()elsethrowIO$UnknownError$"darcs init failed:\n"++err-- | Save changes (creating the file and directory if needed), add, and commit.darcsSave::Contentsa=>FilePath->FilePath->Author->Description->a->IO()darcsSavereponameauthorlogMsgcontents=dowithSanityCheckrepo["_darcs"]name$B.writeFile(repo</>encodeStringname)$toByteStringcontents-- Just in case it hasn't been added yet; we ignore failures since darcs will-- fail if the file doesn't exist *and* if the file exists but has been added already.runDarcsCommandrepo"add"[name]darcsCommitrepo[name]authorlogMsg-- | Commit changes to a resource. Raise 'Unchanged' exception if there were none.-- This is not for creating a new file; see 'darcsSave'. This is just for updating.darcsCommit::FilePath->[FilePath]->Author->Description->IO()darcsCommitreponamesauthorlogMsg=doletargs=["--all","-A",(authorNameauthor++" <"++authorEmailauthor++">"),"-m",logMsg]++names(statusCommit,errCommit,_)<-runDarcsCommandrepo"record"argsifstatusCommit==ExitSuccessthenreturn()elsethrowIO$ifnullerrCommitthenUnchangedelseUnknownError$"Could not darcs record "++unwordsnames++"\n"++errCommit-- | Change the name of a resource.darcsMove::FilePath->FilePath->FilePath->Author->Description->IO()darcsMoverepooldNamenewNameauthorlogMsg=dowithSanityCheckrepo["_darcs"]newName$do(statusAdd,_,_)<-runDarcsCommandrepo"add"[dropFileNamenewName](statusAdd',_,_)<-runDarcsCommandrepo"mv"[oldName,newName]ifstatusAdd==ExitSuccess&&statusAdd'==ExitSuccessthendarcsCommitrepo[oldName,newName]authorlogMsgelsethrowIONotFound-- | Delete a resource from the repository.darcsDelete::FilePath->FilePath->Author->Description->IO()darcsDeletereponameauthorlogMsg=withSanityCheckrepo["_darcs"]name$dorunShellCommandrepoNothing"rm"[name]darcsCommitrepo[name]authorlogMsg----------------------------- End repository creation & modification-- Begin repository & history queries---------------------------- | Return list of log entries for the list of resources.-- If list of resources is empty, log entries for all resources are returned.darcsLog::FilePath->[FilePath]->TimeRange->IO[Revision]darcsLogreponames(TimeRangebeginend)=doletopts=timeOptsbeginenddo(status,err,output)<-runDarcsCommandrepo"changes"$["--xml-output","--summary"]++names++optsifstatus==ExitSuccessthencaseparseDarcsXML$toStringoutputofNothing->throwIOResourceExistsJustparsed->returnparsedelsethrowIO$UnknownError$"darcs changes returned error status.\n"++errwheretimeOpts::MaybeUTCTime->MaybeUTCTime->[String]timeOptsbe=case(b,e)of(Nothing,Nothing)->[](Justb',Juste')->fromb'++toe'(Justb',Nothing)->fromb'(Nothing,Juste')->toe'wherefromz=["--match=date \"after "++undatez++"\""]toz=["--to-match=date \"before "++undatez++"\""]undate=toSqlStringtoSqlString=formatTimedefaultTimeLocale"%FT%X"-- | Get revision information for a particular revision ID, or latest revision.darcsGetRevision::FilePath->RevisionId->IORevisiondarcsGetRevisionrepohash=do(_,_,output)<-runDarcsCommandrepo"changes"["--xml-output","--summary","--match=hash "++hash]lethists=parseDarcsXML$toStringoutputcasehistsofNothing->throwIONotFoundJusta->return$heada-- | Return revision ID for latest commit for a resource.darcsLatestRevId::FilePath->FilePath->IORevisionIddarcsLatestRevIdreponame=doensureFileExistsreponame#ifdef USE_MAXCOUNT(status,err,output)<-runDarcsCommandrepo"changes"["--xml-output","--max-count=1",name]when(status/=ExitSuccess&&"unrecognized option"`isInfixOf`err)$throwIONoMaxCount#else(_,_,output)<-runDarcsCommandrepo"changes"["--xml-output",name]#endifletpatchs=parseDarcsXML$toStringoutputcasepatchsofNothing->throwIONotFoundJustas->ifnullasthenthrowIONotFoundelsereturn$revId$headas-- | Retrieve the contents of a resource.darcsRetrieve::Contentsa=>FilePath->FilePath->MaybeRevisionId-- ^ @Just@ revision ID, or @Nothing@ for latest->IOadarcsRetrievereponamembId=doensureFileExistsreponameletopts=casembIdofNothing->["contents",name]Justrevid->["contents","--match=hash "++revid,name](status,err,output)<-runDarcsCommandrepo"query"optsifstatus==ExitSuccessthenreturn$fromByteStringoutputelsethrowIO$UnknownError$"Error in darcs query contents:\n"++err-- | Get a list of all known files inside and managed by a repository.darcsIndex::FilePath->IO[FilePath]darcsIndexrepo=withVerifyDirrepo$do(status,_errOutput,output)<-runDarcsCommandrepo"query"["files","--no-directories"]ifstatus==ExitSuccessthenreturn$map(drop2).lines.toString$outputelsereturn[]-- return empty list if invalid path (see gitIndex)-- | Get a list of all resources inside a directory in the repository.darcsDirectory::FilePath->FilePath->IO[Resource]darcsDirectoryrepodir=withVerifyDir(repo</>dir)$doletdir'=ifnulldirthen""elseaddTrailingPathSeparatordir(status1,_errOutput1,output1)<-runDarcsCommandrepo"query"["files","--no-directories"](status2,_errOutput2,output2)<-runDarcsCommandrepo"query"["files","--no-files"]ifstatus1==ExitSuccess&&status2==ExitSuccessthendoletfiles=adhocParsingdir'.lines.toString$output1-- We need to do 'drop $ length dir' + 3' because Darcs returns files like ["./foo/foobar"].letdirs=adhocParsingdir'.drop1.lines.toString$output2-- We need the drop 1 to eliminate the root directory, which appears first.-- Now, select the ones that are in THIS directory and convert to Resources:letfiles'=mapFSFile$filter('/'`notElem`)filesletdirs'=mapFSDirectory$filter('/'`notElem`)dirsreturn$sort(files'++dirs')elsereturn[]-- returns empty list for invalid path (see gitDirectory)whereadhocParsingd=map(drop$lengthd+2).filter(("."</>d)`isPrefixOf`)-- Use the generic grep-based search of a repo.darcsSearch::FilePath->SearchQuery->IO[SearchMatch]darcsSearch=grepSearchRepodarcsIndex