libgit 0.1.0 → 0.3.0

raw patch · 7 files changed

+52/−18 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Lib/Git.hs +8/−7
• Lib/Git/Index.hs +1/−0
• Lib/Git/Lowlevel.hs +9/−8
• Lib/Git/Tree.hs +2/−1
• Lib/Git/Type.hs +21/−1
• README +10/−0
• libgit.cabal +1/−1

@@ -43,9 +43,10 @@ 		Left _    -> return []  {- initialize a new repository database -}-initDB :: GitCtx ()-initDB = do-	o <- gitExec "init-db" ["--bare"] []+initDB :: Bool -> GitCtx ()+initDB bare = do+        let opts = if bare then ["--bare"] else []+	o <- gitExec "init-db" opts [] 	case o of 		Right _  -> return () 		Left err -> gitError err "init-db"@@ -69,11 +70,11 @@ 		Left err -> gitError err "rm"  {- commit change to the repository with optional filepaths -}-commit :: [ FilePath ] -> String -> String -> String -> GitCtx ()-commit rsrcs author author_email logmsg = do-	let authopts = [ "--author=", author ++ " <" ++ author_email ++ ">" ]+commit :: [ FilePath ] -> String -> String -> String -> [String] -> GitCtx ()+commit rsrcs author author_email logmsg extraopts = do+	let authopts = [ "--author", author ++ " <" ++ author_email ++ ">" ] 	let msgopts = [ "-m", logmsg ]-	let opts = authopts ++ msgopts ++ [ "--" ] ++ rsrcs+	let opts = authopts ++ msgopts ++ extraopts ++ [ "--" ] ++ rsrcs 	o <- gitExec "commit" opts [] 	case o of 		Right _  -> return ()

@@ -8,6 +8,7 @@  import Lib.Git.Type +{-| update index with the list of file -} indexUpdate :: [FilePath] -> GitCtx () indexUpdate files = do 	let args = [ "--" ] ++ files

@@ -25,7 +25,7 @@  -- revision can be specified as CommitID | TagID -{- revlist return a commit list in reverse chronological order l -}+{-| return a commit list in reverse chronological order l -} revlist :: Maybe Int -> Maybe CommitID -> [ FilePath ] -> GitCtx [ CommitID ] revlist lim topcommit paths = do 	let commitid = fromMaybe "HEAD" topcommit@@ -36,7 +36,7 @@ 		Right out -> return $ lines out 		Left err  -> gitError err "rev-list" -{- parse a tag/branch-name/commit into a commit if it exists -}+{-| parse a tag/branch-name/commit into a commit if it exists -} revparse :: String -> GitCtx (Maybe CommitID) revparse commitid = do 	o <- gitExec "rev-parse" [ commitid ] []@@ -44,7 +44,7 @@ 		Right out -> return $ Just (head $ lines out) 		Left err  -> gitError err "rev-parse" -{- return object type -}+{-| return object type if object exists -} getObjType :: ID -> GitCtx (Maybe Object) getObjType s = do 	let object_of o = objOfString (head $ lines o) s@@ -53,11 +53,11 @@ 		Right out -> return $ object_of out 		Left err  -> gitError err ("cat-file -t " ++ s) -{- return types of list of objects -}+{-| return object types if objects exists -} getObjsType :: [ID] -> GitCtx [Maybe Object] getObjsType = mapM getObjType -{- cat an object with type specified -}+{-| cat an object with type specified -} catType :: String -> ID -> GitCtx String catType ty obj = do 	o <- gitExec "cat-file" [ ty, obj ] []@@ -65,11 +65,12 @@ 		Right out -> return out 		Left err  -> gitError err "object doesn't exists or wrong type" --- cat specific objects type+-- | cat a blob objects catBlob :: BlobID -> GitCtx String-catTag :: TagID -> GitCtx String- catBlob = catType "blob"++-- | cat a tag objects+catTag :: TagID -> GitCtx String catTag = catType "tag"  {- perms SP file \0 sha1 -}

@@ -25,7 +25,8 @@ 	where 		rest = split delim cs -{- return tree list -}+-- | return a tree entity from a commitid+-- if commitid is ommitted, it uses HEAD. treeList :: Maybe CommitID -> GitCtx Treeent treeList commitid = do 	let treeent_of_line line =

@@ -28,12 +28,22 @@ import Control.Monad.Reader import System.IO (Handle, hFlush, hClose, hGetContents, hPutStr) +-- | any ID (git SHA1 string) type ID = String++-- | a commit ID type CommitID = ID++-- | a blob ID type BlobID = ID++-- | a tree ID type TreeID = ID++-- | a tag ID type TagID = ID +-- | Tagged ID of all possible types data Object = 	  Commit CommitID 	| Blob BlobID@@ -43,16 +53,22 @@  type GitFailure = (Int, String, String, String, [String]) -data Config = Config { configCwd :: FilePath, configGitPath :: Maybe FilePath }+{-| Represent a repository -}+data Config = Config+	{ configCwd     :: FilePath       -- ^ Path to the repository .git+	, configGitPath :: Maybe FilePath -- ^ Optional path to the git executable (otherwise resolved from $PATH)+	} deriving (Show)  newtype GitCtx a = GitCtx (ReaderT Config IO a) 	deriving (Monad, MonadIO, MonadReader Config) +-- | Commit object author/commiter representation data Person = Person 	{ personName  :: String 	, personEmail :: String 	} deriving (Show) +-- | Commit entity representation data Commitent = Commitent 	{ ceParents       :: [CommitID] 	, ceTree          :: TreeID@@ -82,6 +98,8 @@ 		"tag"    -> Just $ Tag gitid 		_        -> Nothing +{-| Run a git context from a config and returns the result+ -} runGit :: Config -> GitCtx t -> IO t runGit config (GitCtx a) = runReaderT a config @@ -97,6 +115,7 @@ 		  env = Just menv } 	return (inh, outh, errh, pid) +-- | internal function to execute a git command gitExec :: String -> [String] -> [(String, String)]         -> GitCtx (Either GitFailure String) gitExec cmd opts menv = do@@ -108,6 +127,7 @@ 		ExitSuccess   -> return $ Right out 		ExitFailure i -> return $ Left (i, out, err, configCwd cfg, cmd : opts) +-- | internal function to call on failure to make a friendly error message gitError :: GitFailure -> String -> b gitError (exitval, stdout, stderr, mcwd, cmd) msg = 	error $ concat [ "git error ", "[cwd: ", mcwd,

@@ -5,6 +5,16 @@  when time permit, the wrapper will be made as a binding on top of libgit2. +Example usage, in ghci++Prelude>:m +Lib.Git+Prelude Lib.Git> :m +System.Directory+Prelude Lib.Git System.Directory> createDirectoryIfMissing True "/tmp/repodir"+Prelude Lib.Git System.Directory> let cfg = makeConfig "/tmp/repodir" Nothing+Prelude Lib.Git System.Directory> runGit cfg (initDB False)++You will now have an initialised git repo in /tmp/repodir. + TODO: - clean the commit/tree parsing - make it more robust/better error checking

@@ -1,5 +1,5 @@ Name:                libgit-Version:             0.1.0+Version:             0.3.0 Description:     Simple git wrapper to access common git functions in a simple haskell way. License:             BSD3