module Lib.Git
( module Lib.Git.Type
, module Lib.Git.Tree
, module Lib.Git.Index
, module Lib.Git.Lowlevel
, taglist
, initDB
, add
, rm
, commit
, checkout
, hasDiff
, resolveFilePath
) where
import Data.Maybe
import qualified Data.List
import Lib.Git.Type
import Lib.Git.Tree
import Lib.Git.Index
import Lib.Git.Lowlevel
taglist :: GitCtx [ TagID ]
taglist = do
o <- gitExec "tag" [] []
case o of
Right out -> return $ lines out
Left _ -> return []
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"
add :: [ FilePath ] -> GitCtx ()
add paths = do
let opts = "--" : paths
o <- gitExec "add" opts []
case o of
Right _ -> return ()
Left err -> gitError err "add"
rm :: [ FilePath ] -> GitCtx ()
rm paths = do
let opts = "--" : paths
o <- gitExec "rm" opts []
case o of
Right _ -> return ()
Left err -> gitError err "rm"
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 ++ extraopts ++ [ "--" ] ++ rsrcs
o <- gitExec "commit" opts []
case o of
Right _ -> return ()
Left err -> gitError err "commit"
checkout :: Maybe CommitID -> Maybe String -> GitCtx ()
checkout rev branch = do
let bopt = maybe [] (\b -> [ "-b", b ]) branch
let copt = maybeToList rev
_ <- gitExec "checkout" (bopt ++ copt) []
return ()
hasDiff :: GitCtx Bool
hasDiff = do
o <- gitExec "diff" [ "--exit-code" ] []
case o of
Left (1, _, _, _, _) -> return True
Right _ -> return False
Left err -> gitError err "hasdiff"
resolveFilePath :: Commitent -> FilePath -> GitCtx [ (FilePath, Object) ]
resolveFilePath commitent filepath = do
let treeid = ceTree commitent
t <- catTree treeid
resolveFilePathTree t filepath
resolveFilePathTree :: Treeent -> FilePath -> GitCtx [ (FilePath, Object) ]
resolveFilePathTree tree filepath =
case break (== '/') filepath of
("", path) -> resolveFilePathTree tree (tail path)
(ent, "") -> do
let obj = objOfTreepath tree ent
case obj of
Just o -> return [ (ent, o) ]
Nothing -> error ("missing last ent " ++ ent)
(ent, path) ->
let obj = objOfTreepath tree ent in
case obj of
Just (Tree treeid) -> do
childtree <- catTree treeid
ret <- resolveFilePathTree childtree (tail path)
return ((ent, fromJust obj) : ret)
Just (Blob _) ->
return [ (ent, fromJust obj) ]
Just _ ->
error "assertion failed: expecting tree or blob"
Nothing ->
error ("missing ent " ++ ent)
objOfTreepath :: Treeent -> String -> Maybe Object
objOfTreepath treeent path =
case Data.List.find (\(_, _, p) -> p == path) treeent of
Nothing -> Nothing
Just (_, obj, _) -> Just obj