{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}moduleLib.Git.Type(runGit,GitFailure,gitExec,gitError,GitCtx,makeConfig,Object(..),Config(..),Commitent(..),Person(..),ID,CommitID,BlobID,TreeID,TagID,toID,objToID,objOfString)whereimportSystem.ProcessimportSystem.ExitimportData.MaybeimportqualifiedControl.ExceptionasCimportControl.ConcurrentimportControl.Monad.ReaderimportSystem.IO(Handle,hFlush,hClose,hGetContents,hPutStr)-- | any ID (git SHA1 string)typeID=String-- | a commit IDtypeCommitID=ID-- | a blob IDtypeBlobID=ID-- | a tree IDtypeTreeID=ID-- | a tag IDtypeTagID=ID-- | Tagged ID of all possible typesdataObject=CommitCommitID|BlobBlobID|TreeTreeID|TagTagIDderiving(Show)typeGitFailure=(Int,String,String,String,[String]){-| Represent a repository -}dataConfig=Config{configCwd::FilePath-- ^ Path to the repository .git,configGitPath::MaybeFilePath-- ^ Optional path to the git executable (otherwise resolved from $PATH)}deriving(Show)newtypeGitCtxa=GitCtx(ReaderTConfigIOa)deriving(Monad,MonadIO,MonadReaderConfig)-- | Commit object author/commiter representationdataPerson=Person{personName::String,personEmail::String}deriving(Show)-- | Commit entity representationdataCommitent=Commitent{ceParents::[CommitID],ceTree::TreeID,ceAuthor::Person,ceAuthorTime::String,ceCommitter::Person,ceCommitterTime::String,ceCommitMsg::String}deriving(Show)-- read a string as an IDtoID::String->IDtoID=idobjToID::Object->IDobjToID(Commitgitid)=gitidobjToID(Treegitid)=gitidobjToID(Blobgitid)=gitidobjToID(Taggitid)=gitidobjOfString::String->ID->MaybeObjectobjOfStringsgitid=casesof"blob"->Just$Blobgitid"tree"->Just$Treegitid"commit"->Just$Commitgitid"tag"->Just$Taggitid_->Nothing{-| Run a git context from a config and returns the result
-}runGit::Config->GitCtxt->IOtrunGitconfig(GitCtxa)=runReaderTaconfig-- just exec with stdin/stdout/stderr as pipesexecProcWithPipes::FilePath->String->[String]->[(String,String)]->IO(Handle,Handle,Handle,ProcessHandle)execProcWithPipesmcwdcommandargsmenv=do(Justinh,Justouth,Justerrh,pid)<-createProcess(proccommandargs){std_in=CreatePipe,std_out=CreatePipe,std_err=CreatePipe,cwd=Justmcwd,env=Justmenv}return(inh,outh,errh,pid)-- | internal function to execute a git commandgitExec::String->[String]->[(String,String)]->GitCtx(EitherGitFailureString)gitExeccmdoptsmenv=docfg<-askletargs=cmd:optsletgitpath=fromMaybe"git"(configGitPathcfg)(ec,out,err)<-liftIO$readProc(configCwdcfg)gitpathargsmenv""caseecofExitSuccess->return$RightoutExitFailurei->return$Left(i,out,err,configCwdcfg,cmd:opts)-- | internal function to call on failure to make a friendly error messagegitError::GitFailure->String->bgitError(exitval,stdout,stderr,mcwd,cmd)msg=error$concat["git error ","[cwd: ",mcwd,"][exec: ",concatcmd,"][exit: ",showexitval,"][msg: ",msg,"] ","stdout: ",stdout," stderr: ",stderr]-- same as readProcessWithExitCode but having a configurable cwd and env,readProc::FilePath->String->[String]->[(String,String)]->String->IO(ExitCode,String,String)readProcmcwdcommandargsmenvinput=do(inh,outh,errh,pid)<-execProcWithPipesmcwdcommandargsmenvoutMVar<-newEmptyMVarout<-hGetContentsouth_<-forkIO$C.evaluate(lengthout)>>putMVaroutMVar()err<-hGetContentserrh_<-forkIO$C.evaluate(lengtherr)>>putMVaroutMVar()when(lengthinput>0)$dohPutStrinhinput;hFlushinhhCloseinhtakeMVaroutMVartakeMVaroutMVarhCloseouthhCloseerrhex<-waitForProcesspidreturn(ex,out,err){- initialize a git context. just a path for now could take limit afterwards -}makeConfig::FilePath->MaybeFilePath->ConfigmakeConfigpathgitpath=Config{configCwd=path,configGitPath=gitpath}