-- Copyright 2015 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE DeriveDataTypeable #-}
-- | Higher level wrapper around the hlibgit2 binding to libgit2.
module Util.Git (
    initialize
    -- * OID
    , Blob, Tree
    , Repo, FileName, Ref
    -- * repo
    , init
    -- * blob
    , write_blob, read_blob
    -- * tree
    , Modification(..), ModifyDir, ModifyFile(..), modifications_to_dir
    , write_tree, modify_tree, read_tree
    -- * commit
    , CommitData(..)
    , parse_commit, write_commit, read_commit
    -- * diff
    , diff_commits, diff_trees
    -- * refs
    , write_ref, read_ref
    -- ** symbolic refs
    , read_refs, read_ref_map
    , write_symbolic_ref, read_symbolic_ref
    -- ** HEAD ref
    , update_head, read_head_commit, write_head, read_head
    -- * revwalk
    , read_log, read_log_from, read_log_head
    -- * dir
    , Dir, File(..)
    , make_dir, flatten_dir
    , write_dir, read_dir
    -- * misc
    , gc
    -- * errors
    , throw, GitException(..)
) where
import           Prelude hiding (init)
import qualified Bindings.Libgit2 as G
import qualified Control.Exception as Exception
import qualified Data.Bits as Bits
import qualified Data.ByteString as ByteString
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Unsafe as ByteString.Unsafe
import qualified Data.Char as Char
import qualified Data.IORef as IORef
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Text.Encoding as Encoding
import qualified Data.Typeable as Typeable

import qualified System.Directory as Directory
import qualified System.Exit as Exit
import           System.FilePath ((</>))

import           Util.GitT (Commit(..), Repo)
import qualified Util.Processes as Processes
import qualified Util.Seq as Seq

import           Foreign
import           Foreign.C
import           Global


-- | The library has to be initialized before you call any functions.
initialize :: IO a -> IO a
initialize :: forall a. IO a -> IO a
initialize =
    IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
Exception.bracket_ ([Char] -> IO Error -> IO ()
check [Char]
"git_threads_init" IO Error
G.c'git_threads_init)
        IO ()
G.c'git_threads_shutdown

-- * OID

-- | This should be a bytestring of length 40 containing the git object ID.
newtype OID = OID ByteString deriving (OID -> OID -> Bool
(OID -> OID -> Bool) -> (OID -> OID -> Bool) -> Eq OID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OID -> OID -> Bool
$c/= :: OID -> OID -> Bool
== :: OID -> OID -> Bool
$c== :: OID -> OID -> Bool
Eq, Eq OID
Eq OID
-> (OID -> OID -> Ordering)
-> (OID -> OID -> Bool)
-> (OID -> OID -> Bool)
-> (OID -> OID -> Bool)
-> (OID -> OID -> Bool)
-> (OID -> OID -> OID)
-> (OID -> OID -> OID)
-> Ord OID
OID -> OID -> Bool
OID -> OID -> Ordering
OID -> OID -> OID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OID -> OID -> OID
$cmin :: OID -> OID -> OID
max :: OID -> OID -> OID
$cmax :: OID -> OID -> OID
>= :: OID -> OID -> Bool
$c>= :: OID -> OID -> Bool
> :: OID -> OID -> Bool
$c> :: OID -> OID -> Bool
<= :: OID -> OID -> Bool
$c<= :: OID -> OID -> Bool
< :: OID -> OID -> Bool
$c< :: OID -> OID -> Bool
compare :: OID -> OID -> Ordering
$ccompare :: OID -> OID -> Ordering
Ord, Int -> OID -> ShowS
[OID] -> ShowS
OID -> [Char]
(Int -> OID -> ShowS)
-> (OID -> [Char]) -> ([OID] -> ShowS) -> Show OID
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OID] -> ShowS
$cshowList :: [OID] -> ShowS
show :: OID -> [Char]
$cshow :: OID -> [Char]
showsPrec :: Int -> OID -> ShowS
$cshowsPrec :: Int -> OID -> ShowS
Show)

with_oid :: OID -> (Ptr G.C'git_oid -> IO a) -> IO a
with_oid :: forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid (OID ByteString
bytes) Ptr C'git_oid -> IO a
action =
    ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.Unsafe.unsafeUseAsCStringLen ByteString
bytes ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(CString
bytesp, Int
len) ->
        (Ptr C'git_oid -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'git_oid -> IO a) -> IO a)
-> (Ptr C'git_oid -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> do
            [Char] -> IO Error -> IO ()
check ([Char]
"OID poke " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
bytes) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
                Ptr C'git_oid -> CString -> CSize -> IO Error
G.c'git_oid_fromstrn Ptr C'git_oid
oidp CString
bytesp (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
            Ptr C'git_oid -> IO a
action Ptr C'git_oid
oidp

peek_oid :: Ptr G.C'git_oid -> IO OID
peek_oid :: Ptr C'git_oid -> IO OID
peek_oid Ptr C'git_oid
oidp = Int -> (CString -> IO OID) -> IO OID
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((CString -> IO OID) -> IO OID) -> (CString -> IO OID) -> IO OID
forall a b. (a -> b) -> a -> b
$ \CString
bufferp -> do
    CString -> Ptr C'git_oid -> IO ()
G.c'git_oid_fmt CString
bufferp Ptr C'git_oid
oidp
    ByteString -> OID
OID (ByteString -> OID) -> IO ByteString -> IO OID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CStringLen -> IO ByteString
Char8.packCStringLen (CString
bufferp, Int
40)

cuchar_to_oid :: [CUChar] -> IO OID
cuchar_to_oid :: [CUChar] -> IO OID
cuchar_to_oid [CUChar]
bytes = (Ptr C'git_oid -> IO OID) -> IO OID
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'git_oid -> IO OID) -> IO OID)
-> (Ptr C'git_oid -> IO OID) -> IO OID
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> do
    let bs :: ByteString
bs = [Word8] -> ByteString
ByteString.pack ((CUChar -> Word8) -> [CUChar] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map CUChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral [CUChar]
bytes)
    ByteString -> (CString -> IO OID) -> IO OID
forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.Unsafe.unsafeUseAsCString ByteString
bs ((CString -> IO OID) -> IO OID) -> (CString -> IO OID) -> IO OID
forall a b. (a -> b) -> a -> b
$ \CString
bytesp -> do
        Ptr C'git_oid -> Ptr CUChar -> IO ()
G.c'git_oid_fromraw Ptr C'git_oid
oidp (CString -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr CString
bytesp)
        Ptr C'git_oid -> IO OID
peek_oid Ptr C'git_oid
oidp

newtype Blob = Blob OID deriving (Blob -> Blob -> Bool
(Blob -> Blob -> Bool) -> (Blob -> Blob -> Bool) -> Eq Blob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Blob -> Blob -> Bool
$c/= :: Blob -> Blob -> Bool
== :: Blob -> Blob -> Bool
$c== :: Blob -> Blob -> Bool
Eq, Eq Blob
Eq Blob
-> (Blob -> Blob -> Ordering)
-> (Blob -> Blob -> Bool)
-> (Blob -> Blob -> Bool)
-> (Blob -> Blob -> Bool)
-> (Blob -> Blob -> Bool)
-> (Blob -> Blob -> Blob)
-> (Blob -> Blob -> Blob)
-> Ord Blob
Blob -> Blob -> Bool
Blob -> Blob -> Ordering
Blob -> Blob -> Blob
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Blob -> Blob -> Blob
$cmin :: Blob -> Blob -> Blob
max :: Blob -> Blob -> Blob
$cmax :: Blob -> Blob -> Blob
>= :: Blob -> Blob -> Bool
$c>= :: Blob -> Blob -> Bool
> :: Blob -> Blob -> Bool
$c> :: Blob -> Blob -> Bool
<= :: Blob -> Blob -> Bool
$c<= :: Blob -> Blob -> Bool
< :: Blob -> Blob -> Bool
$c< :: Blob -> Blob -> Bool
compare :: Blob -> Blob -> Ordering
$ccompare :: Blob -> Blob -> Ordering
Ord, Int -> Blob -> ShowS
[Blob] -> ShowS
Blob -> [Char]
(Int -> Blob -> ShowS)
-> (Blob -> [Char]) -> ([Blob] -> ShowS) -> Show Blob
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Blob] -> ShowS
$cshowList :: [Blob] -> ShowS
show :: Blob -> [Char]
$cshow :: Blob -> [Char]
showsPrec :: Int -> Blob -> ShowS
$cshowsPrec :: Int -> Blob -> ShowS
Show)
newtype Tree = Tree OID deriving (Tree -> Tree -> Bool
(Tree -> Tree -> Bool) -> (Tree -> Tree -> Bool) -> Eq Tree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree -> Tree -> Bool
$c/= :: Tree -> Tree -> Bool
== :: Tree -> Tree -> Bool
$c== :: Tree -> Tree -> Bool
Eq, Eq Tree
Eq Tree
-> (Tree -> Tree -> Ordering)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Bool)
-> (Tree -> Tree -> Tree)
-> (Tree -> Tree -> Tree)
-> Ord Tree
Tree -> Tree -> Bool
Tree -> Tree -> Ordering
Tree -> Tree -> Tree
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tree -> Tree -> Tree
$cmin :: Tree -> Tree -> Tree
max :: Tree -> Tree -> Tree
$cmax :: Tree -> Tree -> Tree
>= :: Tree -> Tree -> Bool
$c>= :: Tree -> Tree -> Bool
> :: Tree -> Tree -> Bool
$c> :: Tree -> Tree -> Bool
<= :: Tree -> Tree -> Bool
$c<= :: Tree -> Tree -> Bool
< :: Tree -> Tree -> Bool
$c< :: Tree -> Tree -> Bool
compare :: Tree -> Tree -> Ordering
$ccompare :: Tree -> Tree -> Ordering
Ord, Int -> Tree -> ShowS
[Tree] -> ShowS
Tree -> [Char]
(Int -> Tree -> ShowS)
-> (Tree -> [Char]) -> ([Tree] -> ShowS) -> Show Tree
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Tree] -> ShowS
$cshowList :: [Tree] -> ShowS
show :: Tree -> [Char]
$cshow :: Tree -> [Char]
showsPrec :: Int -> Tree -> ShowS
$cshowsPrec :: Int -> Tree -> ShowS
Show)

instance Pretty Blob where
    pretty :: Blob -> Text
pretty (Blob (OID ByteString
oid)) = [Char] -> Text
txt ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
Char8.unpack ByteString
oid
instance Pretty Tree where
    pretty :: Tree -> Text
pretty (Tree (OID ByteString
oid)) = [Char] -> Text
txt ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
Char8.unpack ByteString
oid

-- | Repo-internal path.
type FileName = FilePath
-- | This has the initial refs/ stripped off.
type Ref = FilePath

-- | Pointer to git_repository C type.
type RepoP = Ptr G.C'git_repository

to_commit :: OID -> Commit
to_commit :: OID -> Commit
to_commit (OID ByteString
bs) = ByteString -> Commit
Commit ByteString
bs

from_commit :: Commit -> OID
from_commit :: Commit -> OID
from_commit (Commit ByteString
bs) = ByteString -> OID
OID ByteString
bs

-- * repo

-- | True if it already existed.
init :: Repo -> IO Bool
init :: [Char] -> IO Bool
init [Char]
repo = IO Bool -> IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM IO Bool
is_git (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
    (Ptr (Ptr C'git_repository) -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_repository) -> IO ()) -> IO ())
-> (Ptr (Ptr C'git_repository) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_repository)
repopp -> [Char] -> (CString -> IO ()) -> IO ()
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
repo ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
pathp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"init " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
repo) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr C'git_repository) -> CString -> CUInt -> IO Error
G.c'git_repository_init Ptr (Ptr C'git_repository)
repopp CString
pathp CUInt
1
        Ptr C'git_repository
repop <- Ptr (Ptr C'git_repository) -> IO (Ptr C'git_repository)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_repository)
repopp
        Ptr C'git_repository -> IO ()
G.c'git_repository_free Ptr C'git_repository
repop
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    where
    is_git :: IO Bool
is_git = [IO Bool] -> IO Bool
forall (m :: * -> *). Monad m => [m Bool] -> m Bool
andM [[Char] -> IO Bool
Directory.doesDirectoryExist [Char]
repo,
        [Char] -> IO Bool
Directory.doesDirectoryExist ([Char]
repo [Char] -> ShowS
</> [Char]
"objects")]

with_repo :: Repo -> (RepoP -> IO a) -> IO a
with_repo :: forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
path Ptr C'git_repository -> IO a
action = [Char] -> (CString -> IO a) -> IO a
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
path ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
pathp -> (Ptr (Ptr C'git_repository) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_repository) -> IO a) -> IO a)
-> (Ptr (Ptr C'git_repository) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_repository)
repopp -> do
    [Char] -> IO Error -> IO ()
check ([Char]
"open " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
path) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr C'git_repository) -> CString -> IO Error
G.c'git_repository_open Ptr (Ptr C'git_repository)
repopp CString
pathp
    Ptr C'git_repository
repop <- Ptr (Ptr C'git_repository) -> IO (Ptr C'git_repository)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_repository)
repopp
    Either GitException a
result <- IO a -> IO (Either GitException a)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (IO a -> IO (Either GitException a))
-> IO a -> IO (Either GitException a)
forall a b. (a -> b) -> a -> b
$ Ptr C'git_repository -> IO a
action Ptr C'git_repository
repop
    Ptr C'git_repository -> IO ()
G.c'git_repository_free Ptr C'git_repository
repop
    case Either GitException a
result of
        Right a
ok -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
ok
        Left (GitException [Char]
err) ->
            [Char] -> IO a
forall a. [Char] -> IO a
throw ([Char] -> IO a) -> [Char] -> IO a
forall a b. (a -> b) -> a -> b
$ [Char]
"repo " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
path [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err

-- * blob

write_blob :: Repo -> ByteString -> IO Blob
write_blob :: [Char] -> ByteString -> IO Blob
write_blob [Char]
repo ByteString
bytes = [Char] -> (Ptr C'git_repository -> IO Blob) -> IO Blob
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO Blob) -> IO Blob)
-> (Ptr C'git_repository -> IO Blob) -> IO Blob
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> Ptr C'git_repository -> ByteString -> IO Blob
write_blob_repo Ptr C'git_repository
repop ByteString
bytes

write_blob_repo :: RepoP -> ByteString -> IO Blob
write_blob_repo :: Ptr C'git_repository -> ByteString -> IO Blob
write_blob_repo Ptr C'git_repository
repop ByteString
bytes = (Ptr C'git_oid -> IO Blob) -> IO Blob
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'git_oid -> IO Blob) -> IO Blob)
-> (Ptr C'git_oid -> IO Blob) -> IO Blob
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp ->
    ByteString -> (CStringLen -> IO Blob) -> IO Blob
forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.Unsafe.unsafeUseAsCStringLen ByteString
bytes ((CStringLen -> IO Blob) -> IO Blob)
-> (CStringLen -> IO Blob) -> IO Blob
forall a b. (a -> b) -> a -> b
$ \(CString
bytesp, Int
len) -> do
        [Char] -> IO Error -> IO ()
check [Char]
"write_blob" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr C'git_oid
-> Ptr C'git_repository -> Ptr () -> CSize -> IO Error
G.c'git_blob_create_frombuffer Ptr C'git_oid
oidp Ptr C'git_repository
repop (CString -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr CString
bytesp)
                (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
        OID -> Blob
Blob (OID -> Blob) -> IO OID -> IO Blob
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'git_oid -> IO OID
peek_oid Ptr C'git_oid
oidp

read_blob :: Repo -> Blob -> IO ByteString
read_blob :: [Char] -> Blob -> IO ByteString
read_blob [Char]
repo Blob
blob = [Char] -> (Ptr C'git_repository -> IO ByteString) -> IO ByteString
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO ByteString) -> IO ByteString)
-> (Ptr C'git_repository -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> Ptr C'git_repository -> Blob -> IO ByteString
read_blob_repo Ptr C'git_repository
repop Blob
blob

read_blob_repo :: RepoP -> Blob -> IO ByteString
read_blob_repo :: Ptr C'git_repository -> Blob -> IO ByteString
read_blob_repo Ptr C'git_repository
repop (Blob OID
blob) =
    OID -> (Ptr C'git_oid -> IO ByteString) -> IO ByteString
forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid OID
blob ((Ptr C'git_oid -> IO ByteString) -> IO ByteString)
-> (Ptr C'git_oid -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> (Ptr (Ptr C'git_blob) -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_blob) -> IO ByteString) -> IO ByteString)
-> (Ptr (Ptr C'git_blob) -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_blob)
blobpp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"blob_lookup: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ OID -> [Char]
forall a. Show a => a -> [Char]
show OID
blob) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr (Ptr C'git_blob)
-> Ptr C'git_repository -> Ptr C'git_oid -> IO Error
G.c'git_blob_lookup Ptr (Ptr C'git_blob)
blobpp Ptr C'git_repository
repop Ptr C'git_oid
oidp
        Ptr C'git_blob
blobp <- Ptr (Ptr C'git_blob) -> IO (Ptr C'git_blob)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_blob)
blobpp
        Ptr ()
bufp <- Ptr C'git_blob -> IO (Ptr ())
G.c'git_blob_rawcontent Ptr C'git_blob
blobp
        CLong
len <- Ptr C'git_blob -> IO CLong
G.c'git_blob_rawsize Ptr C'git_blob
blobp
        ByteString
bytes <- CStringLen -> IO ByteString
Char8.packCStringLen (Ptr () -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
bufp, CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
len)
        Ptr C'git_blob -> IO ()
G.c'git_blob_free Ptr C'git_blob
blobp
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes

-- * tree

-- | Add fname Nothing means add a directory.
data Modification = Remove FilePath | Add FilePath ByteString
    deriving (Modification -> Modification -> Bool
(Modification -> Modification -> Bool)
-> (Modification -> Modification -> Bool) -> Eq Modification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Modification -> Modification -> Bool
$c/= :: Modification -> Modification -> Bool
== :: Modification -> Modification -> Bool
$c== :: Modification -> Modification -> Bool
Eq, Int -> Modification -> ShowS
[Modification] -> ShowS
Modification -> [Char]
(Int -> Modification -> ShowS)
-> (Modification -> [Char])
-> ([Modification] -> ShowS)
-> Show Modification
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Modification] -> ShowS
$cshowList :: [Modification] -> ShowS
show :: Modification -> [Char]
$cshow :: Modification -> [Char]
showsPrec :: Int -> Modification -> ShowS
$cshowsPrec :: Int -> Modification -> ShowS
Show)

instance Pretty Modification where
    pretty :: Modification -> Text
pretty (Remove [Char]
fn) = Text
"rm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
txt [Char]
fn
    pretty (Add [Char]
fn ByteString
bytes) = Text
"add" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
txt [Char]
fn
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" {" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt (ByteString -> Int
Char8.length ByteString
bytes) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

type ModifyDir = [(FileName, ModifyFile)]
data ModifyFile = ModifyFile (Maybe ByteString) | ModifyDir ModifyDir
    deriving (ModifyFile -> ModifyFile -> Bool
(ModifyFile -> ModifyFile -> Bool)
-> (ModifyFile -> ModifyFile -> Bool) -> Eq ModifyFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyFile -> ModifyFile -> Bool
$c/= :: ModifyFile -> ModifyFile -> Bool
== :: ModifyFile -> ModifyFile -> Bool
$c== :: ModifyFile -> ModifyFile -> Bool
Eq, Int -> ModifyFile -> ShowS
[ModifyFile] -> ShowS
ModifyFile -> [Char]
(Int -> ModifyFile -> ShowS)
-> (ModifyFile -> [Char])
-> ([ModifyFile] -> ShowS)
-> Show ModifyFile
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ModifyFile] -> ShowS
$cshowList :: [ModifyFile] -> ShowS
show :: ModifyFile -> [Char]
$cshow :: ModifyFile -> [Char]
showsPrec :: Int -> ModifyFile -> ShowS
$cshowsPrec :: Int -> ModifyFile -> ShowS
Show)

modifications_to_dir :: [Modification] -> ModifyDir
modifications_to_dir :: [Modification] -> ModifyDir
modifications_to_dir [Modification]
mods = [([Char], Maybe ByteString)] -> ModifyDir
go ([Modification] -> [([Char], Maybe ByteString)]
strip [Modification]
mods)
    where
    go :: [([Char], Maybe ByteString)] -> ModifyDir
go [([Char], Maybe ByteString)]
entries = (([Char], [([Char], Maybe ByteString)]) -> ModifyDir)
-> [([Char], [([Char], Maybe ByteString)])] -> ModifyDir
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], [([Char], Maybe ByteString)]) -> ModifyDir
make ([([Char], Maybe ByteString)]
-> [([Char], [([Char], Maybe ByteString)])]
forall {c}. [([Char], c)] -> [([Char], [([Char], c)])]
by_dir [([Char], Maybe ByteString)]
entries)
    make :: ([Char], [([Char], Maybe ByteString)]) -> ModifyDir
make ([Char]
dir, [([Char], Maybe ByteString)]
entries) = ModifyDir
dirs ModifyDir -> ModifyDir -> ModifyDir
forall a. [a] -> [a] -> [a]
++ ModifyDir
files
        where
        dirs :: ModifyDir
dirs = if [([Char], Maybe ByteString)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], Maybe ByteString)]
dir_ents then [] else [([Char]
dir, ModifyDir -> ModifyFile
ModifyDir ([([Char], Maybe ByteString)] -> ModifyDir
go [([Char], Maybe ByteString)]
dir_ents))]
        files :: ModifyDir
files = case [([Char], Maybe ByteString)] -> Maybe ([Char], Maybe ByteString)
forall a. [a] -> Maybe a
Seq.last [([Char], Maybe ByteString)]
file_ents of
            Maybe ([Char], Maybe ByteString)
Nothing -> []
            Just ([Char]
_, Maybe ByteString
bytes) -> [([Char]
dir, Maybe ByteString -> ModifyFile
ModifyFile Maybe ByteString
bytes)]
        ([([Char], Maybe ByteString)]
file_ents, [([Char], Maybe ByteString)]
dir_ents) = (([Char], Maybe ByteString) -> Bool)
-> [([Char], Maybe ByteString)]
-> ([([Char], Maybe ByteString)], [([Char], Maybe ByteString)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool)
-> (([Char], Maybe ByteString) -> [Char])
-> ([Char], Maybe ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Maybe ByteString) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], Maybe ByteString)]
entries
    by_dir :: [([Char], c)] -> [([Char], [([Char], c)])]
by_dir [([Char], c)]
entries = [([Char]
dir, (([Char], c) -> ([Char], c)) -> [([Char], c)] -> [([Char], c)]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> ([Char], c) -> ([Char], c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ShowS
drop_dir) [([Char], c)]
subs)
        | ([Char]
dir, [([Char], c)]
subs) <- (([Char], c) -> [Char])
-> [([Char], c)] -> [([Char], [([Char], c)])]
forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
Seq.keyed_group_sort ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'/') ShowS -> (([Char], c) -> [Char]) -> ([Char], c) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], c) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], c)]
entries]
    drop_dir :: ShowS
drop_dir = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'/')
    -- Strip out redundent modifications.
    strip :: [Modification] -> [([Char], Maybe ByteString)]
strip = Map [Char] (Maybe ByteString) -> [([Char], Maybe ByteString)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map [Char] (Maybe ByteString) -> [([Char], Maybe ByteString)])
-> ([Modification] -> Map [Char] (Maybe ByteString))
-> [Modification]
-> [([Char], Maybe ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Char], Maybe ByteString)] -> Map [Char] (Maybe ByteString)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], Maybe ByteString)] -> Map [Char] (Maybe ByteString))
-> ([Modification] -> [([Char], Maybe ByteString)])
-> [Modification]
-> Map [Char] (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modification -> ([Char], Maybe ByteString))
-> [Modification] -> [([Char], Maybe ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map Modification -> ([Char], Maybe ByteString)
extract
    extract :: Modification -> ([Char], Maybe ByteString)
extract (Remove [Char]
fn) = ([Char]
fn, Maybe ByteString
forall a. Maybe a
Nothing)
    extract (Add [Char]
fn ByteString
bytes) = ([Char]
fn, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bytes)

write_tree :: Repo -> Maybe Tree -> [(FileName, Maybe (Either Blob Tree))]
    -> IO Tree
write_tree :: [Char]
-> Maybe Tree -> [([Char], Maybe (Either Blob Tree))] -> IO Tree
write_tree [Char]
repo Maybe Tree
maybe_from [([Char], Maybe (Either Blob Tree))]
files = [Char] -> (Ptr C'git_repository -> IO Tree) -> IO Tree
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO Tree) -> IO Tree)
-> (Ptr C'git_repository -> IO Tree) -> IO Tree
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    Ptr C'git_repository -> (Ptr C'git_tree -> IO Tree) -> IO Tree
forall {a}.
Ptr C'git_repository -> (Ptr C'git_tree -> IO a) -> IO a
maybe_with Ptr C'git_repository
repop ((Ptr C'git_tree -> IO Tree) -> IO Tree)
-> (Ptr C'git_tree -> IO Tree) -> IO Tree
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
fromp -> (Ptr (Ptr C'git_treebuilder) -> IO Tree) -> IO Tree
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_treebuilder) -> IO Tree) -> IO Tree)
-> (Ptr (Ptr C'git_treebuilder) -> IO Tree) -> IO Tree
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_treebuilder)
builderpp -> do
        [Char] -> IO Error -> IO ()
check [Char]
"treebuilder_create" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr C'git_treebuilder) -> Ptr C'git_tree -> IO Error
G.c'git_treebuilder_create Ptr (Ptr C'git_treebuilder)
builderpp
            Ptr C'git_tree
fromp
        Ptr C'git_treebuilder
builderp <- Ptr (Ptr C'git_treebuilder) -> IO (Ptr C'git_treebuilder)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_treebuilder)
builderpp
        (([Char], Maybe (Either Blob Tree)) -> IO ())
-> [([Char], Maybe (Either Blob Tree))] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ptr C'git_treebuilder
-> ([Char], Maybe (Either Blob Tree)) -> IO ()
modify Ptr C'git_treebuilder
builderp) [([Char], Maybe (Either Blob Tree))]
files
        OID
oid <- (Ptr C'git_oid -> IO OID) -> IO OID
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'git_oid -> IO OID) -> IO OID)
-> (Ptr C'git_oid -> IO OID) -> IO OID
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> do
            [Char] -> IO Error -> IO ()
check [Char]
"treebuilder_write" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
                Ptr C'git_oid
-> Ptr C'git_repository -> Ptr C'git_treebuilder -> IO Error
G.c'git_treebuilder_write Ptr C'git_oid
oidp Ptr C'git_repository
repop Ptr C'git_treebuilder
builderp
            Ptr C'git_oid -> IO OID
peek_oid Ptr C'git_oid
oidp
        Ptr C'git_treebuilder -> IO ()
G.c'git_treebuilder_free Ptr C'git_treebuilder
builderp
        Tree -> IO Tree
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree -> IO Tree) -> Tree -> IO Tree
forall a b. (a -> b) -> a -> b
$ OID -> Tree
Tree OID
oid
    where
    maybe_with :: Ptr C'git_repository -> (Ptr C'git_tree -> IO a) -> IO a
maybe_with Ptr C'git_repository
repop Ptr C'git_tree -> IO a
io = case Maybe Tree
maybe_from of
        Just Tree
tree -> Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
tree Ptr C'git_tree -> IO a
io
        Maybe Tree
Nothing -> Ptr C'git_tree -> IO a
io Ptr C'git_tree
forall a. Ptr a
nullPtr
    modify :: Ptr C'git_treebuilder
-> ([Char], Maybe (Either Blob Tree)) -> IO ()
modify Ptr C'git_treebuilder
builderp ([Char]
name, Maybe (Either Blob Tree)
val) = [Char] -> (CString -> IO ()) -> IO ()
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
namep -> case Maybe (Either Blob Tree)
val of
        Maybe (Either Blob Tree)
Nothing -> Ptr C'git_treebuilder -> [Char] -> CString -> IO ()
treebuilder_remove Ptr C'git_treebuilder
builderp [Char]
name CString
namep
        Just (Left Blob
blob) -> Ptr C'git_treebuilder -> [Char] -> CString -> Blob -> IO ()
treebuilder_insert_file Ptr C'git_treebuilder
builderp [Char]
name CString
namep Blob
blob
        Just (Right Tree
tree) -> Ptr C'git_treebuilder -> [Char] -> CString -> Tree -> IO ()
treebuilder_insert_dir Ptr C'git_treebuilder
builderp [Char]
name CString
namep Tree
tree

-- | Apply a list of modifications to an existing tree.
modify_tree :: Repo -> Tree -> [Modification] -> IO Tree
modify_tree :: [Char] -> Tree -> [Modification] -> IO Tree
modify_tree [Char]
repo Tree
tree [Modification]
mods = [Char] -> (Ptr C'git_repository -> IO Tree) -> IO Tree
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO Tree) -> IO Tree)
-> (Ptr C'git_repository -> IO Tree) -> IO Tree
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    Ptr C'git_repository -> Maybe Tree -> ModifyDir -> IO Tree
go Ptr C'git_repository
repop (Tree -> Maybe Tree
forall a. a -> Maybe a
Just Tree
tree) ([Modification] -> ModifyDir
modifications_to_dir [Modification]
mods)
    where
    go :: Ptr C'git_repository -> Maybe Tree -> ModifyDir -> IO Tree
go Ptr C'git_repository
repop Maybe Tree
maybe_tree ModifyDir
entries =
        Ptr C'git_repository
-> Maybe Tree -> (Ptr C'git_tree -> IO Tree) -> IO Tree
forall {a}.
Ptr C'git_repository
-> Maybe Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_maybe_tree Ptr C'git_repository
repop Maybe Tree
maybe_tree ((Ptr C'git_tree -> IO Tree) -> IO Tree)
-> (Ptr C'git_tree -> IO Tree) -> IO Tree
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
treep -> (Ptr (Ptr C'git_treebuilder) -> IO Tree) -> IO Tree
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_treebuilder) -> IO Tree) -> IO Tree)
-> (Ptr (Ptr C'git_treebuilder) -> IO Tree) -> IO Tree
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_treebuilder)
builderpp -> do
            [Char] -> IO Error -> IO ()
check [Char]
"treebuilder_create" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
                Ptr (Ptr C'git_treebuilder) -> Ptr C'git_tree -> IO Error
G.c'git_treebuilder_create Ptr (Ptr C'git_treebuilder)
builderpp Ptr C'git_tree
treep
            Ptr C'git_treebuilder
builderp <- Ptr (Ptr C'git_treebuilder) -> IO (Ptr C'git_treebuilder)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_treebuilder)
builderpp
            (([Char], ModifyFile) -> IO ()) -> ModifyDir -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ptr C'git_repository
-> Ptr C'git_treebuilder -> ([Char], ModifyFile) -> IO ()
modify Ptr C'git_repository
repop Ptr C'git_treebuilder
builderp) ModifyDir
entries
            OID
oid <- (Ptr C'git_oid -> IO OID) -> IO OID
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'git_oid -> IO OID) -> IO OID)
-> (Ptr C'git_oid -> IO OID) -> IO OID
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> do
                [Char] -> IO Error -> IO ()
check [Char]
"treebuilder_write" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
                    Ptr C'git_oid
-> Ptr C'git_repository -> Ptr C'git_treebuilder -> IO Error
G.c'git_treebuilder_write Ptr C'git_oid
oidp Ptr C'git_repository
repop Ptr C'git_treebuilder
builderp
                Ptr C'git_oid -> IO OID
peek_oid Ptr C'git_oid
oidp
            Ptr C'git_treebuilder -> IO ()
G.c'git_treebuilder_free Ptr C'git_treebuilder
builderp
            Tree -> IO Tree
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree -> IO Tree) -> Tree -> IO Tree
forall a b. (a -> b) -> a -> b
$ OID -> Tree
Tree OID
oid
    with_maybe_tree :: Ptr C'git_repository
-> Maybe Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_maybe_tree Ptr C'git_repository
_ Maybe Tree
Nothing Ptr C'git_tree -> IO a
io = Ptr C'git_tree -> IO a
io Ptr C'git_tree
forall a. Ptr a
nullPtr
    with_maybe_tree Ptr C'git_repository
repop (Just Tree
tree) Ptr C'git_tree -> IO a
io = Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
tree Ptr C'git_tree -> IO a
io

    modify :: Ptr C'git_repository
-> Ptr C'git_treebuilder -> ([Char], ModifyFile) -> IO ()
modify Ptr C'git_repository
repop Ptr C'git_treebuilder
builderp ([Char]
name, ModifyFile Maybe ByteString
maybe_bytes) =
        [Char] -> (CString -> IO ()) -> IO ()
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
namep -> case Maybe ByteString
maybe_bytes of
            Maybe ByteString
Nothing -> Ptr C'git_treebuilder -> [Char] -> CString -> IO ()
treebuilder_remove Ptr C'git_treebuilder
builderp [Char]
name CString
namep
            Just ByteString
bytes -> do
                Blob
blob <- Ptr C'git_repository -> ByteString -> IO Blob
write_blob_repo Ptr C'git_repository
repop ByteString
bytes
                Ptr C'git_treebuilder -> [Char] -> CString -> Blob -> IO ()
treebuilder_insert_file Ptr C'git_treebuilder
builderp [Char]
name CString
namep Blob
blob
    modify Ptr C'git_repository
repop Ptr C'git_treebuilder
builderp ([Char]
name, ModifyDir ModifyDir
entries) =
        [Char] -> (CString -> IO ()) -> IO ()
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
namep -> do
            Ptr C'git_tree_entry
entryp <- Ptr C'git_treebuilder -> CString -> IO (Ptr C'git_tree_entry)
G.c'git_treebuilder_get Ptr C'git_treebuilder
builderp CString
namep
            Maybe Tree
maybe_tree <- if Ptr C'git_tree_entry
entryp Ptr C'git_tree_entry -> Ptr C'git_tree_entry -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'git_tree_entry
forall a. Ptr a
nullPtr
                then Maybe Tree -> IO (Maybe Tree)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Tree
forall a. Maybe a
Nothing
                else Tree -> Maybe Tree
forall a. a -> Maybe a
Just (Tree -> Maybe Tree) -> (OID -> Tree) -> OID -> Maybe Tree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OID -> Tree
Tree (OID -> Maybe Tree) -> IO OID -> IO (Maybe Tree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr C'git_oid -> IO OID
peek_oid (Ptr C'git_oid -> IO OID) -> IO (Ptr C'git_oid) -> IO OID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'git_tree_entry -> IO (Ptr C'git_oid)
G.c'git_tree_entry_id Ptr C'git_tree_entry
entryp)
            Tree
tree <- Ptr C'git_repository -> Maybe Tree -> ModifyDir -> IO Tree
go Ptr C'git_repository
repop Maybe Tree
maybe_tree ModifyDir
entries
            -- Delete empty directories automatically.  This shouldn't be
            -- necessary, but without it git_diff_tree_to_tree gets extraneous
            -- Removes.
            IO Bool -> IO () -> IO () -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Ptr C'git_repository -> Tree -> IO Bool
empty_tree_repo Ptr C'git_repository
repop Tree
tree)
                (Ptr C'git_treebuilder -> [Char] -> CString -> IO ()
treebuilder_remove Ptr C'git_treebuilder
builderp [Char]
name CString
namep)
                (Ptr C'git_treebuilder -> [Char] -> CString -> Tree -> IO ()
treebuilder_insert_dir Ptr C'git_treebuilder
builderp [Char]
name CString
namep Tree
tree)

treebuilder_remove :: Ptr G.C'git_treebuilder -> String -> CString -> IO ()
treebuilder_remove :: Ptr C'git_treebuilder -> [Char] -> CString -> IO ()
treebuilder_remove Ptr C'git_treebuilder
builderp [Char]
name CString
namep =
    [Char] -> IO Error -> IO ()
check ([Char]
"git_treebuilder_remove: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
name) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
        Ptr C'git_treebuilder -> CString -> IO Error
G.c'git_treebuilder_remove Ptr C'git_treebuilder
builderp CString
namep

treebuilder_insert_file :: Ptr G.C'git_treebuilder -> String -> CString
    -> Blob -> IO ()
treebuilder_insert_file :: Ptr C'git_treebuilder -> [Char] -> CString -> Blob -> IO ()
treebuilder_insert_file Ptr C'git_treebuilder
builderp [Char]
name CString
namep (Blob OID
oid) =
    [Char] -> IO Error -> IO ()
check ([Char]
"git_treebuilder_insert: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
name) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$ OID -> (Ptr C'git_oid -> IO Error) -> IO Error
forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid OID
oid ((Ptr C'git_oid -> IO Error) -> IO Error)
-> (Ptr C'git_oid -> IO Error) -> IO Error
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp ->
        Ptr (Ptr C'git_tree_entry)
-> Ptr C'git_treebuilder
-> CString
-> Ptr C'git_oid
-> CUInt
-> IO Error
G.c'git_treebuilder_insert Ptr (Ptr C'git_tree_entry)
forall a. Ptr a
nullPtr Ptr C'git_treebuilder
builderp CString
namep Ptr C'git_oid
oidp CUInt
0o100644

treebuilder_insert_dir :: Ptr G.C'git_treebuilder -> String -> CString
    -> Tree -> IO ()
treebuilder_insert_dir :: Ptr C'git_treebuilder -> [Char] -> CString -> Tree -> IO ()
treebuilder_insert_dir Ptr C'git_treebuilder
builderp [Char]
name CString
namep (Tree OID
oid) =
    [Char] -> IO Error -> IO ()
check ([Char]
"git_treebuilder_insert: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show ([Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/")) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
    OID -> (Ptr C'git_oid -> IO Error) -> IO Error
forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid OID
oid ((Ptr C'git_oid -> IO Error) -> IO Error)
-> (Ptr C'git_oid -> IO Error) -> IO Error
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp ->
        Ptr (Ptr C'git_tree_entry)
-> Ptr C'git_treebuilder
-> CString
-> Ptr C'git_oid
-> CUInt
-> IO Error
G.c'git_treebuilder_insert Ptr (Ptr C'git_tree_entry)
forall a. Ptr a
nullPtr Ptr C'git_treebuilder
builderp CString
namep Ptr C'git_oid
oidp CUInt
0o040000

read_tree :: Repo -> Tree -> IO [(FileName, Either Blob Tree)]
read_tree :: [Char] -> Tree -> IO [([Char], Either Blob Tree)]
read_tree [Char]
repo Tree
tree = [Char]
-> (Ptr C'git_repository -> IO [([Char], Either Blob Tree)])
-> IO [([Char], Either Blob Tree)]
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO [([Char], Either Blob Tree)])
 -> IO [([Char], Either Blob Tree)])
-> (Ptr C'git_repository -> IO [([Char], Either Blob Tree)])
-> IO [([Char], Either Blob Tree)]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    Ptr C'git_repository
-> Tree
-> (Ptr C'git_tree -> IO [([Char], Either Blob Tree)])
-> IO [([Char], Either Blob Tree)]
forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
tree ((Ptr C'git_tree -> IO [([Char], Either Blob Tree)])
 -> IO [([Char], Either Blob Tree)])
-> (Ptr C'git_tree -> IO [([Char], Either Blob Tree)])
-> IO [([Char], Either Blob Tree)]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
treep -> do
        CSize
count <- Ptr C'git_tree -> IO CSize
G.c'git_tree_entrycount Ptr C'git_tree
treep
        [Ptr C'git_tree_entry]
entries <- (CSize -> IO (Ptr C'git_tree_entry))
-> [CSize] -> IO [Ptr C'git_tree_entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr C'git_tree -> CSize -> IO (Ptr C'git_tree_entry)
G.c'git_tree_entry_byindex Ptr C'git_tree
treep)
            (CSize -> CSize -> CSize -> [CSize]
forall a. (Num a, Ord a) => a -> a -> a -> [a]
Seq.range' CSize
0 CSize
count CSize
1)
        (Ptr C'git_tree_entry -> IO ([Char], Either Blob Tree))
-> [Ptr C'git_tree_entry] -> IO [([Char], Either Blob Tree)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ptr C'git_tree_entry -> IO ([Char], Either Blob Tree)
peek_entry [Ptr C'git_tree_entry]
entries
    where
    peek_entry :: Ptr C'git_tree_entry -> IO ([Char], Either Blob Tree)
peek_entry Ptr C'git_tree_entry
entryp = do
        Error
typ <- Ptr C'git_tree_entry -> IO Error
G.c'git_tree_entry_type Ptr C'git_tree_entry
entryp
        [Char]
name <- CString -> IO [Char]
peekCString (CString -> IO [Char]) -> IO CString -> IO [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'git_tree_entry -> IO CString
G.c'git_tree_entry_name Ptr C'git_tree_entry
entryp
        OID
oid <- Ptr C'git_oid -> IO OID
peek_oid (Ptr C'git_oid -> IO OID) -> IO (Ptr C'git_oid) -> IO OID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'git_tree_entry -> IO (Ptr C'git_oid)
G.c'git_tree_entry_id Ptr C'git_tree_entry
entryp
        Either Blob Tree
val <- if Error
typ Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
forall a. Num a => a
G.c'GIT_OBJ_TREE then Either Blob Tree -> IO (Either Blob Tree)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tree -> Either Blob Tree
forall a b. b -> Either a b
Right (OID -> Tree
Tree OID
oid)) else
            if Error
typ Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
forall a. Num a => a
G.c'GIT_OBJ_BLOB then Either Blob Tree -> IO (Either Blob Tree)
forall (m :: * -> *) a. Monad m => a -> m a
return (Blob -> Either Blob Tree
forall a b. a -> Either a b
Left (OID -> Blob
Blob OID
oid)) else
            [Char] -> IO (Either Blob Tree)
forall a. [Char] -> IO a
throw ([Char] -> IO (Either Blob Tree))
-> [Char] -> IO (Either Blob Tree)
forall a b. (a -> b) -> a -> b
$ OID -> [Char]
forall a. Show a => a -> [Char]
show OID
oid [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" expected tree or blob: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Error -> [Char]
forall a. Show a => a -> [Char]
show Error
typ
        ([Char], Either Blob Tree) -> IO ([Char], Either Blob Tree)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
name, Either Blob Tree
val)

empty_tree_repo :: RepoP -> Tree -> IO Bool
empty_tree_repo :: Ptr C'git_repository -> Tree -> IO Bool
empty_tree_repo Ptr C'git_repository
repop Tree
tree = Ptr C'git_repository
-> Tree -> (Ptr C'git_tree -> IO Bool) -> IO Bool
forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
tree ((Ptr C'git_tree -> IO Bool) -> IO Bool)
-> (Ptr C'git_tree -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
treep -> do
    CSize
count <- Ptr C'git_tree -> IO CSize
G.c'git_tree_entrycount Ptr C'git_tree
treep
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CSize
count CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
== CSize
0

with_tree :: RepoP -> Tree -> (Ptr G.C'git_tree -> IO a) -> IO a
with_tree :: forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop (Tree OID
oid) Ptr C'git_tree -> IO a
io = OID -> (Ptr C'git_oid -> IO a) -> IO a
forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid OID
oid ((Ptr C'git_oid -> IO a) -> IO a)
-> (Ptr C'git_oid -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> (Ptr (Ptr C'git_tree) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_tree) -> IO a) -> IO a)
-> (Ptr (Ptr C'git_tree) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_tree)
treepp -> do
    [Char] -> IO Error -> IO ()
check ([Char]
"tree_lookup: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ OID -> [Char]
forall a. Show a => a -> [Char]
show OID
oid) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
        Ptr (Ptr C'git_tree)
-> Ptr C'git_repository -> Ptr C'git_oid -> IO Error
G.c'git_tree_lookup Ptr (Ptr C'git_tree)
treepp Ptr C'git_repository
repop Ptr C'git_oid
oidp
    Ptr C'git_tree
treep <- Ptr (Ptr C'git_tree) -> IO (Ptr C'git_tree)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_tree)
treepp
    Ptr C'git_tree -> IO a
io Ptr C'git_tree
treep IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`Exception.finally` Ptr C'git_tree -> IO ()
G.c'git_tree_free Ptr C'git_tree
treep

-- * commit

parse_commit :: String -> Maybe Commit
parse_commit :: [Char] -> Maybe Commit
parse_commit [Char]
str
    | [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
40 = Commit -> Maybe Commit
forall a. a -> Maybe a
Just (Commit -> Maybe Commit) -> Commit -> Maybe Commit
forall a b. (a -> b) -> a -> b
$ ByteString -> Commit
Commit (ByteString -> Commit) -> ByteString -> Commit
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
Char8.pack [Char]
str
    | Bool
otherwise = Maybe Commit
forall a. Maybe a
Nothing

write_commit :: Repo -> Text -> Text -> [Commit] -> Tree -> String
    -> IO Commit
write_commit :: [Char] -> Text -> Text -> [Commit] -> Tree -> [Char] -> IO Commit
write_commit [Char]
repo Text
user Text
email [Commit]
parents Tree
tree [Char]
description =
    [Char] -> (Ptr C'git_repository -> IO Commit) -> IO Commit
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO Commit) -> IO Commit)
-> (Ptr C'git_repository -> IO Commit) -> IO Commit
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> (Ptr C'git_signature -> IO Commit) -> IO Commit
forall {a}. (Ptr C'git_signature -> IO a) -> IO a
with_sig ((Ptr C'git_signature -> IO Commit) -> IO Commit)
-> (Ptr C'git_signature -> IO Commit) -> IO Commit
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_signature
sigp ->
    Ptr C'git_repository
-> [Commit]
-> (Int -> Ptr (Ptr C'git_commit) -> IO Commit)
-> IO Commit
forall {a}.
Ptr C'git_repository
-> [Commit] -> (Int -> Ptr (Ptr C'git_commit) -> IO a) -> IO a
with_commits Ptr C'git_repository
repop [Commit]
parents ((Int -> Ptr (Ptr C'git_commit) -> IO Commit) -> IO Commit)
-> (Int -> Ptr (Ptr C'git_commit) -> IO Commit) -> IO Commit
forall a b. (a -> b) -> a -> b
$ \Int
parents_len Ptr (Ptr C'git_commit)
parentsp ->
    Ptr C'git_repository
-> Tree -> (Ptr C'git_tree -> IO Commit) -> IO Commit
forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
tree ((Ptr C'git_tree -> IO Commit) -> IO Commit)
-> (Ptr C'git_tree -> IO Commit) -> IO Commit
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
treep -> [Char] -> (CString -> IO Commit) -> IO Commit
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
description ((CString -> IO Commit) -> IO Commit)
-> (CString -> IO Commit) -> IO Commit
forall a b. (a -> b) -> a -> b
$ \CString
descp ->
    [Char] -> (CString -> IO Commit) -> IO Commit
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
"HEAD" ((CString -> IO Commit) -> IO Commit)
-> (CString -> IO Commit) -> IO Commit
forall a b. (a -> b) -> a -> b
$ \CString
headp -> (Ptr C'git_oid -> IO Commit) -> IO Commit
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'git_oid -> IO Commit) -> IO Commit)
-> (Ptr C'git_oid -> IO Commit) -> IO Commit
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
commitp -> do
        [Char] -> IO Error -> IO ()
check [Char]
"write_commit" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr C'git_oid
-> Ptr C'git_repository
-> CString
-> Ptr C'git_signature
-> Ptr C'git_signature
-> CString
-> CString
-> Ptr C'git_tree
-> Error
-> Ptr (Ptr C'git_commit)
-> IO Error
G.c'git_commit_create Ptr C'git_oid
commitp Ptr C'git_repository
repop CString
headp
            Ptr C'git_signature
sigp Ptr C'git_signature
sigp CString
forall a. Ptr a
nullPtr CString
descp Ptr C'git_tree
treep (Int -> Error
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
parents_len) Ptr (Ptr C'git_commit)
parentsp
        OID -> Commit
to_commit (OID -> Commit) -> IO OID -> IO Commit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr C'git_oid -> IO OID
peek_oid Ptr C'git_oid
commitp
    where
    with_sig :: (Ptr C'git_signature -> IO a) -> IO a
with_sig Ptr C'git_signature -> IO a
io = Text -> (CString -> IO a) -> IO a
forall a. Text -> (CString -> IO a) -> IO a
withText Text
user ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
userp -> Text -> (CString -> IO a) -> IO a
forall a. Text -> (CString -> IO a) -> IO a
withText Text
email ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
emailp ->
        (Ptr (Ptr C'git_signature) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_signature) -> IO a) -> IO a)
-> (Ptr (Ptr C'git_signature) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_signature)
sigpp -> do
            [Char] -> IO Error -> IO ()
check [Char]
"signature_now" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr C'git_signature) -> CString -> CString -> IO Error
G.c'git_signature_now Ptr (Ptr C'git_signature)
sigpp CString
userp CString
emailp
            Ptr C'git_signature
sigp <- Ptr (Ptr C'git_signature) -> IO (Ptr C'git_signature)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_signature)
sigpp
            Ptr C'git_signature -> IO a
io Ptr C'git_signature
sigp IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`Exception.finally` Ptr C'git_signature -> IO ()
G.c'git_signature_free Ptr C'git_signature
sigp
    with_commits :: Ptr C'git_repository
-> [Commit] -> (Int -> Ptr (Ptr C'git_commit) -> IO a) -> IO a
with_commits Ptr C'git_repository
repop [Commit]
commits Int -> Ptr (Ptr C'git_commit) -> IO a
io = [Ptr C'git_commit]
-> [Commit] -> ([Ptr C'git_commit] -> IO a) -> IO a
forall {a}.
[Ptr C'git_commit]
-> [Commit] -> ([Ptr C'git_commit] -> IO a) -> IO a
go [] [Commit]
commits (([Ptr C'git_commit] -> IO a) -> IO a)
-> ([Ptr C'git_commit] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \[Ptr C'git_commit]
ps -> [Ptr C'git_commit]
-> (Int -> Ptr (Ptr C'git_commit) -> IO a) -> IO a
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Ptr C'git_commit]
ps Int -> Ptr (Ptr C'git_commit) -> IO a
io
        where
        go :: [Ptr C'git_commit]
-> [Commit] -> ([Ptr C'git_commit] -> IO a) -> IO a
go [Ptr C'git_commit]
ps [] [Ptr C'git_commit] -> IO a
cont = [Ptr C'git_commit] -> IO a
cont ([Ptr C'git_commit] -> [Ptr C'git_commit]
forall a. [a] -> [a]
reverse [Ptr C'git_commit]
ps)
        go [Ptr C'git_commit]
ps (Commit
c:[Commit]
cs) [Ptr C'git_commit] -> IO a
cont = Ptr C'git_repository
-> Commit -> (Ptr C'git_commit -> IO a) -> IO a
forall a.
Ptr C'git_repository
-> Commit -> (Ptr C'git_commit -> IO a) -> IO a
with_commit Ptr C'git_repository
repop Commit
c ((Ptr C'git_commit -> IO a) -> IO a)
-> (Ptr C'git_commit -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_commit
p -> [Ptr C'git_commit]
-> [Commit] -> ([Ptr C'git_commit] -> IO a) -> IO a
go (Ptr C'git_commit
pPtr C'git_commit -> [Ptr C'git_commit] -> [Ptr C'git_commit]
forall a. a -> [a] -> [a]
:[Ptr C'git_commit]
ps) [Commit]
cs [Ptr C'git_commit] -> IO a
cont

data CommitData = CommitData {
    CommitData -> Tree
commit_tree :: !Tree
    , CommitData -> [Commit]
commit_parents :: ![Commit]
    , CommitData -> [Char]
commit_author :: !String
    , CommitData -> [Char]
commit_text :: !String
    } deriving (CommitData -> CommitData -> Bool
(CommitData -> CommitData -> Bool)
-> (CommitData -> CommitData -> Bool) -> Eq CommitData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommitData -> CommitData -> Bool
$c/= :: CommitData -> CommitData -> Bool
== :: CommitData -> CommitData -> Bool
$c== :: CommitData -> CommitData -> Bool
Eq, Int -> CommitData -> ShowS
[CommitData] -> ShowS
CommitData -> [Char]
(Int -> CommitData -> ShowS)
-> (CommitData -> [Char])
-> ([CommitData] -> ShowS)
-> Show CommitData
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CommitData] -> ShowS
$cshowList :: [CommitData] -> ShowS
show :: CommitData -> [Char]
$cshow :: CommitData -> [Char]
showsPrec :: Int -> CommitData -> ShowS
$cshowsPrec :: Int -> CommitData -> ShowS
Show)

read_commit :: Repo -> Commit -> IO CommitData
read_commit :: [Char] -> Commit -> IO CommitData
read_commit [Char]
repo Commit
commit =
    [Char] -> (Ptr C'git_repository -> IO CommitData) -> IO CommitData
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO CommitData) -> IO CommitData)
-> (Ptr C'git_repository -> IO CommitData) -> IO CommitData
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> Ptr C'git_repository -> Commit -> IO CommitData
read_commit_repo Ptr C'git_repository
repop Commit
commit

read_commit_repo :: RepoP -> Commit -> IO CommitData
read_commit_repo :: Ptr C'git_repository -> Commit -> IO CommitData
read_commit_repo Ptr C'git_repository
repop Commit
commit = Ptr C'git_repository
-> Commit -> (Ptr C'git_commit -> IO CommitData) -> IO CommitData
forall a.
Ptr C'git_repository
-> Commit -> (Ptr C'git_commit -> IO a) -> IO a
with_commit Ptr C'git_repository
repop Commit
commit ((Ptr C'git_commit -> IO CommitData) -> IO CommitData)
-> (Ptr C'git_commit -> IO CommitData) -> IO CommitData
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_commit
commitp -> do
    [Char]
author <- C'git_signature -> IO [Char]
peek_user (C'git_signature -> IO [Char]) -> IO C'git_signature -> IO [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'git_signature -> IO C'git_signature
forall a. Storable a => Ptr a -> IO a
peek (Ptr C'git_signature -> IO C'git_signature)
-> IO (Ptr C'git_signature) -> IO C'git_signature
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'git_commit -> IO (Ptr C'git_signature)
G.c'git_commit_author Ptr C'git_commit
commitp
    OID
tree <- Ptr C'git_oid -> IO OID
peek_oid (Ptr C'git_oid -> IO OID) -> IO (Ptr C'git_oid) -> IO OID
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'git_commit -> IO (Ptr C'git_oid)
G.c'git_commit_tree_id Ptr C'git_commit
commitp
    CUInt
parents_len <- Ptr C'git_commit -> IO CUInt
G.c'git_commit_parentcount Ptr C'git_commit
commitp
    [OID]
parents <- (Ptr C'git_oid -> IO OID) -> [Ptr C'git_oid] -> IO [OID]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ptr C'git_oid -> IO OID
peek_oid
        ([Ptr C'git_oid] -> IO [OID]) -> IO [Ptr C'git_oid] -> IO [OID]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (CUInt -> IO (Ptr C'git_oid)) -> [CUInt] -> IO [Ptr C'git_oid]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr C'git_commit -> CUInt -> IO (Ptr C'git_oid)
G.c'git_commit_parent_id Ptr C'git_commit
commitp)
            (if CUInt
parents_len CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0 then [] else [CUInt
0..CUInt
parents_lenCUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
-CUInt
1])
    [Char]
desc <- CString -> IO [Char]
peekCString (CString -> IO [Char]) -> IO CString -> IO [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'git_commit -> IO CString
G.c'git_commit_message Ptr C'git_commit
commitp
    CommitData -> IO CommitData
forall (m :: * -> *) a. Monad m => a -> m a
return (CommitData -> IO CommitData) -> CommitData -> IO CommitData
forall a b. (a -> b) -> a -> b
$ Tree -> [Commit] -> [Char] -> [Char] -> CommitData
CommitData (OID -> Tree
Tree OID
tree) ((OID -> Commit) -> [OID] -> [Commit]
forall a b. (a -> b) -> [a] -> [b]
map OID -> Commit
to_commit [OID]
parents) [Char]
author [Char]
desc
    where
    peek_user :: C'git_signature -> IO [Char]
peek_user C'git_signature
sig = do
        [Char]
name <- CString -> IO [Char]
peekCString (C'git_signature -> CString
G.c'git_signature'name C'git_signature
sig)
        [Char]
email <- CString -> IO [Char]
peekCString (C'git_signature -> CString
G.c'git_signature'email C'git_signature
sig)
        [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" <" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
email [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">"

with_commit :: RepoP -> Commit -> (Ptr G.C'git_commit -> IO a) -> IO a
with_commit :: forall a.
Ptr C'git_repository
-> Commit -> (Ptr C'git_commit -> IO a) -> IO a
with_commit Ptr C'git_repository
repop Commit
commit Ptr C'git_commit -> IO a
io = OID -> (Ptr C'git_oid -> IO a) -> IO a
forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid (Commit -> OID
from_commit Commit
commit) ((Ptr C'git_oid -> IO a) -> IO a)
-> (Ptr C'git_oid -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
    \Ptr C'git_oid
oidp -> (Ptr (Ptr C'git_commit) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_commit) -> IO a) -> IO a)
-> (Ptr (Ptr C'git_commit) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_commit)
commitpp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"tree_lookup: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Commit -> [Char]
forall a. Show a => a -> [Char]
show Commit
commit) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr (Ptr C'git_commit)
-> Ptr C'git_repository -> Ptr C'git_oid -> IO Error
G.c'git_commit_lookup Ptr (Ptr C'git_commit)
commitpp Ptr C'git_repository
repop Ptr C'git_oid
oidp
        Ptr C'git_commit
commitp <- Ptr (Ptr C'git_commit) -> IO (Ptr C'git_commit)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_commit)
commitpp
        Ptr C'git_commit -> IO a
io Ptr C'git_commit
commitp IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`Exception.finally` Ptr C'git_commit -> IO ()
G.c'git_commit_free Ptr C'git_commit
commitp

-- * diff

diff_commits :: Repo -> Commit -> Commit -> IO [Modification]
diff_commits :: [Char] -> Commit -> Commit -> IO [Modification]
diff_commits [Char]
repo Commit
old Commit
new = [Char]
-> (Ptr C'git_repository -> IO [Modification]) -> IO [Modification]
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO [Modification]) -> IO [Modification])
-> (Ptr C'git_repository -> IO [Modification]) -> IO [Modification]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> do
    CommitData
oldc <- Ptr C'git_repository -> Commit -> IO CommitData
read_commit_repo Ptr C'git_repository
repop Commit
old
    CommitData
newc <- Ptr C'git_repository -> Commit -> IO CommitData
read_commit_repo Ptr C'git_repository
repop Commit
new
    [Char] -> Tree -> Tree -> IO [Modification]
diff_trees [Char]
repo (CommitData -> Tree
commit_tree CommitData
oldc) (CommitData -> Tree
commit_tree CommitData
newc)

-- | Recursively diff two trees.
diff_trees :: Repo -> Tree -> Tree -> IO [Modification]
diff_trees :: [Char] -> Tree -> Tree -> IO [Modification]
diff_trees [Char]
repo Tree
old Tree
new =
    [Char]
-> (Ptr C'git_repository -> IO [Modification]) -> IO [Modification]
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO [Modification]) -> IO [Modification])
-> (Ptr C'git_repository -> IO [Modification]) -> IO [Modification]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> Ptr C'git_repository -> Tree -> Tree -> IO [Modification]
diff_tree_repo Ptr C'git_repository
repop Tree
old Tree
new

diff_tree_repo :: RepoP -> Tree -> Tree -> IO [Modification]
diff_tree_repo :: Ptr C'git_repository -> Tree -> Tree -> IO [Modification]
diff_tree_repo Ptr C'git_repository
repop Tree
old Tree
new =
    Ptr C'git_repository
-> Tree
-> (Ptr C'git_tree -> IO [Modification])
-> IO [Modification]
forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
old ((Ptr C'git_tree -> IO [Modification]) -> IO [Modification])
-> (Ptr C'git_tree -> IO [Modification]) -> IO [Modification]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
oldp -> Ptr C'git_repository
-> Tree
-> (Ptr C'git_tree -> IO [Modification])
-> IO [Modification]
forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
new ((Ptr C'git_tree -> IO [Modification]) -> IO [Modification])
-> (Ptr C'git_tree -> IO [Modification]) -> IO [Modification]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
newp -> do
    [(CUInt, [Char], OID)]
diffs <- (Ptr (Ptr C'git_diff_list) -> IO [(CUInt, [Char], OID)])
-> IO [(CUInt, [Char], OID)]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_diff_list) -> IO [(CUInt, [Char], OID)])
 -> IO [(CUInt, [Char], OID)])
-> (Ptr (Ptr C'git_diff_list) -> IO [(CUInt, [Char], OID)])
-> IO [(CUInt, [Char], OID)]
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_diff_list)
listpp -> do
        [Char] -> IO Error -> IO ()
check [Char]
"diff_tree" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr (Ptr C'git_diff_list)
-> Ptr C'git_repository
-> Ptr C'git_tree
-> Ptr C'git_tree
-> Ptr C'git_diff_options
-> IO Error
G.c'git_diff_tree_to_tree Ptr (Ptr C'git_diff_list)
listpp Ptr C'git_repository
repop Ptr C'git_tree
oldp Ptr C'git_tree
newp Ptr C'git_diff_options
forall a. Ptr a
nullPtr
        Ptr C'git_diff_list
listp <- Ptr (Ptr C'git_diff_list) -> IO (Ptr C'git_diff_list)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_diff_list)
listpp
        IORef [(CUInt, [Char], OID)]
ref <- [(CUInt, [Char], OID)] -> IO (IORef [(CUInt, [Char], OID)])
forall a. a -> IO (IORef a)
IORef.newIORef []
        -- with_fptr (G.mk'git_diff_line_cb (diff_cb ref)) $ \callback ->
        --     check "diff_print" $ G.c'git_diff_print listp
        --         G.c'GIT_DIFF_FORMAT_NAME_STATUS callback nullPtr
        IO
  (FunPtr
     (Ptr C'git_diff_delta
      -> Ptr C'git_diff_range
      -> CChar
      -> CString
      -> CSize
      -> Ptr ()
      -> IO Error))
-> (FunPtr
      (Ptr C'git_diff_delta
       -> Ptr C'git_diff_range
       -> CChar
       -> CString
       -> CSize
       -> Ptr ()
       -> IO Error)
    -> IO ())
-> IO ()
forall a b. IO (FunPtr a) -> (FunPtr a -> IO b) -> IO b
with_fptr ((Ptr C'git_diff_delta
 -> Ptr C'git_diff_range
 -> CChar
 -> CString
 -> CSize
 -> Ptr ()
 -> IO Error)
-> IO
     (FunPtr
        (Ptr C'git_diff_delta
         -> Ptr C'git_diff_range
         -> CChar
         -> CString
         -> CSize
         -> Ptr ()
         -> IO Error))
G.mk'git_diff_data_cb (IORef [(CUInt, [Char], OID)]
-> Ptr C'git_diff_delta
-> Ptr C'git_diff_range
-> CChar
-> CString
-> CSize
-> Ptr ()
-> IO Error
forall {b} {p} {p} {p} {p} {p}.
Num b =>
IORef [(CUInt, [Char], OID)]
-> Ptr C'git_diff_delta -> p -> p -> p -> p -> p -> IO b
diff_cb IORef [(CUInt, [Char], OID)]
ref)) ((FunPtr
    (Ptr C'git_diff_delta
     -> Ptr C'git_diff_range
     -> CChar
     -> CString
     -> CSize
     -> Ptr ()
     -> IO Error)
  -> IO ())
 -> IO ())
-> (FunPtr
      (Ptr C'git_diff_delta
       -> Ptr C'git_diff_range
       -> CChar
       -> CString
       -> CSize
       -> Ptr ()
       -> IO Error)
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr
  (Ptr C'git_diff_delta
   -> Ptr C'git_diff_range
   -> CChar
   -> CString
   -> CSize
   -> Ptr ()
   -> IO Error)
callback ->
            [Char] -> IO Error -> IO ()
check [Char]
"diff_print_compact" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
                Ptr C'git_diff_list
-> FunPtr
     (Ptr C'git_diff_delta
      -> Ptr C'git_diff_range
      -> CChar
      -> CString
      -> CSize
      -> Ptr ()
      -> IO Error)
-> Ptr ()
-> IO Error
G.c'git_diff_print_compact Ptr C'git_diff_list
listp FunPtr
  (Ptr C'git_diff_delta
   -> Ptr C'git_diff_range
   -> CChar
   -> CString
   -> CSize
   -> Ptr ()
   -> IO Error)
callback Ptr ()
forall a. Ptr a
nullPtr
        IORef [(CUInt, [Char], OID)] -> IO [(CUInt, [Char], OID)]
forall a. IORef a -> IO a
IORef.readIORef IORef [(CUInt, [Char], OID)]
ref
    ((CUInt, [Char], OID) -> IO [Modification])
-> [(CUInt, [Char], OID)] -> IO [Modification]
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
concatMapM (CUInt, [Char], OID) -> IO [Modification]
forall {a}.
(Eq a, Num a, Show a) =>
(a, [Char], OID) -> IO [Modification]
to_mod [(CUInt, [Char], OID)]
diffs
    where
    -- I'm only interested in which files were deleted, added, or modified.
    to_mod :: (a, [Char], OID) -> IO [Modification]
to_mod (a
status, [Char]
path, OID
oid)
        | a
status a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Num a => a
G.c'GIT_DELTA_DELETED = [Modification] -> IO [Modification]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> Modification
Remove [Char]
path]
        | a
status a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Num a => a
G.c'GIT_DELTA_ADDED Bool -> Bool -> Bool
|| a
status a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Num a => a
G.c'GIT_DELTA_MODIFIED = do
            ByteString
bytes <- Ptr C'git_repository -> Blob -> IO ByteString
read_blob_repo Ptr C'git_repository
repop (OID -> Blob
Blob OID
oid)
            [Modification] -> IO [Modification]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> ByteString -> Modification
Add [Char]
path ByteString
bytes]
        | Bool
otherwise = [Char] -> IO [Modification]
forall a. [Char] -> IO a
throw ([Char] -> IO [Modification]) -> [Char] -> IO [Modification]
forall a b. (a -> b) -> a -> b
$ [Char]
"diff_trees " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Tree, Tree) -> [Char]
forall a. Show a => a -> [Char]
show (Tree
old, Tree
new)
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": unknown status: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
status
    diff_cb :: IORef [(CUInt, [Char], OID)]
-> Ptr C'git_diff_delta -> p -> p -> p -> p -> p -> IO b
diff_cb IORef [(CUInt, [Char], OID)]
ref Ptr C'git_diff_delta
deltap p
_rangep p
_line_origin p
_contentp p
_content_len p
_data = do
        C'git_diff_delta
delta <- Ptr C'git_diff_delta -> IO C'git_diff_delta
forall a. Storable a => Ptr a -> IO a
peek Ptr C'git_diff_delta
deltap
        let new_file :: C'git_diff_file
new_file = C'git_diff_delta -> C'git_diff_file
G.c'git_diff_delta'new_file C'git_diff_delta
delta
            status :: CUInt
status = C'git_diff_delta -> CUInt
G.c'git_diff_delta'status C'git_diff_delta
delta
        let oid_bytes :: [CUChar]
oid_bytes = C'git_oid -> [CUChar]
G.c'git_oid'id (C'git_diff_file -> C'git_oid
G.c'git_diff_file'oid C'git_diff_file
new_file)
            pathp :: CString
pathp = C'git_diff_file -> CString
G.c'git_diff_file'path C'git_diff_file
new_file
        [Char]
path <- CString -> IO [Char]
peekCString CString
pathp
        OID
oid <- [CUChar] -> IO OID
cuchar_to_oid [CUChar]
oid_bytes
        IORef [(CUInt, [Char], OID)]
-> ([(CUInt, [Char], OID)] -> [(CUInt, [Char], OID)]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
IORef.modifyIORef IORef [(CUInt, [Char], OID)]
ref ((CUInt
status, [Char]
path, OID
oid):)
        b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
0

    -- Used for libgit2 0.20
    -- diff_cb ref deltap _hunkp _linep _payloadp = do
    --     G.C'git_diff_delta status _flags _similarity _nfiles
    --         _old_file new_file <- peek deltap
    --     let G.C'git_diff_file oid pathp _size _flags _mode = new_file
    --     path <- peekCString pathp
    --     IORef.modifyIORef ref ((status, path, oid):)
    --     return 0

-- * refs

write_ref :: Repo -> Commit -> Ref -> IO ()
write_ref :: [Char] -> Commit -> [Char] -> IO ()
write_ref [Char]
repo Commit
commit [Char]
ref = [Char] -> (Ptr C'git_repository -> IO ()) -> IO ()
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO ()) -> IO ())
-> (Ptr C'git_repository -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    OID -> (Ptr C'git_oid -> IO ()) -> IO ()
forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid (Commit -> OID
from_commit Commit
commit) ((Ptr C'git_oid -> IO ()) -> IO ())
-> (Ptr C'git_oid -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
commitp -> [Char] -> (CString -> IO ()) -> IO ()
forall a. [Char] -> (CString -> IO a) -> IO a
with_ref_name [Char]
ref ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
namep ->
    (Ptr (Ptr C'git_reference) -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_reference) -> IO ()) -> IO ())
-> (Ptr (Ptr C'git_reference) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_reference)
refpp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"write_ref " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
ref) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr (Ptr C'git_reference)
-> Ptr C'git_repository
-> CString
-> Ptr C'git_oid
-> Error
-> IO Error
G.c'git_reference_create Ptr (Ptr C'git_reference)
refpp Ptr C'git_repository
repop CString
namep Ptr C'git_oid
commitp Error
1
        Ptr C'git_reference
refp <- Ptr (Ptr C'git_reference) -> IO (Ptr C'git_reference)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_reference)
refpp
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr C'git_reference
refp Ptr C'git_reference -> Ptr C'git_reference -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr C'git_reference
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr C'git_reference -> IO ()
G.c'git_reference_free Ptr C'git_reference
refp

read_ref :: Repo -> Ref -> IO (Maybe Commit)
read_ref :: [Char] -> [Char] -> IO (Maybe Commit)
read_ref [Char]
repo [Char]
ref = [Char]
-> (Ptr C'git_repository -> IO (Maybe Commit)) -> IO (Maybe Commit)
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO (Maybe Commit)) -> IO (Maybe Commit))
-> (Ptr C'git_repository -> IO (Maybe Commit)) -> IO (Maybe Commit)
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> Ptr C'git_repository -> [Char] -> IO (Maybe Commit)
read_ref_repo Ptr C'git_repository
repop [Char]
ref

read_ref_repo :: RepoP -> Ref -> IO (Maybe Commit)
read_ref_repo :: Ptr C'git_repository -> [Char] -> IO (Maybe Commit)
read_ref_repo Ptr C'git_repository
repop [Char]
ref = [Char] -> (CString -> IO (Maybe Commit)) -> IO (Maybe Commit)
forall a. [Char] -> (CString -> IO a) -> IO a
with_ref_name [Char]
ref ((CString -> IO (Maybe Commit)) -> IO (Maybe Commit))
-> (CString -> IO (Maybe Commit)) -> IO (Maybe Commit)
forall a b. (a -> b) -> a -> b
$ \CString
namep ->
    (Ptr C'git_oid -> IO (Maybe Commit)) -> IO (Maybe Commit)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'git_oid -> IO (Maybe Commit)) -> IO (Maybe Commit))
-> (Ptr C'git_oid -> IO (Maybe Commit)) -> IO (Maybe Commit)
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> do
        Error
code <- Ptr C'git_oid -> Ptr C'git_repository -> CString -> IO Error
G.c'git_reference_name_to_id Ptr C'git_oid
oidp Ptr C'git_repository
repop CString
namep
        if Error
code Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
/= Error
forall a. Num a => a
G.c'GIT_OK then Maybe Commit -> IO (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Commit
forall a. Maybe a
Nothing else do
        OID
oid <- Ptr C'git_oid -> IO OID
peek_oid Ptr C'git_oid
oidp
        Maybe Commit -> IO (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Commit -> Maybe Commit
forall a. a -> Maybe a
Just (OID -> Commit
to_commit OID
oid))

with_ref :: RepoP -> Ref -> (Ptr G.C'git_reference -> IO a) -> IO a
with_ref :: forall a.
Ptr C'git_repository
-> [Char] -> (Ptr C'git_reference -> IO a) -> IO a
with_ref Ptr C'git_repository
repop [Char]
ref Ptr C'git_reference -> IO a
io =
    [Char] -> (CString -> IO a) -> IO a
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
ref ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
namep -> (Ptr (Ptr C'git_reference) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_reference) -> IO a) -> IO a)
-> (Ptr (Ptr C'git_reference) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_reference)
refpp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"reference_lookup " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
ref) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr (Ptr C'git_reference)
-> Ptr C'git_repository -> CString -> IO Error
G.c'git_reference_lookup Ptr (Ptr C'git_reference)
refpp Ptr C'git_repository
repop CString
namep
        Ptr C'git_reference
refp <- Ptr (Ptr C'git_reference) -> IO (Ptr C'git_reference)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_reference)
refpp
        Ptr C'git_reference -> IO a
io Ptr C'git_reference
refp IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`Exception.finally` Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr C'git_reference
refp Ptr C'git_reference -> Ptr C'git_reference -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr C'git_reference
forall a. Ptr a
nullPtr)
            (Ptr C'git_reference -> IO ()
G.c'git_reference_free Ptr C'git_reference
refp)

-- | Read all the refs in the repo.
read_refs :: RepoP -> IO [Ref]
read_refs :: Ptr C'git_repository -> IO [[Char]]
read_refs Ptr C'git_repository
repop = (Ptr C'git_strarray -> IO [[Char]]) -> IO [[Char]]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'git_strarray -> IO [[Char]]) -> IO [[Char]])
-> (Ptr C'git_strarray -> IO [[Char]]) -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_strarray
arrayp -> do
    [Char] -> IO Error -> IO ()
check [Char]
"read_refs" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr C'git_strarray -> Ptr C'git_repository -> CUInt -> IO Error
G.c'git_reference_list Ptr C'git_strarray
arrayp Ptr C'git_repository
repop
        CUInt
forall a. Num a => a
G.c'GIT_REF_LISTALL
    G.C'git_strarray Ptr CString
stringsp CSize
count <- Ptr C'git_strarray -> IO C'git_strarray
forall a. Storable a => Ptr a -> IO a
peek Ptr C'git_strarray
arrayp
    [CString]
strps <- Int -> Ptr CString -> IO [CString]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
count) Ptr CString
stringsp
    [[Char]]
refs <- (CString -> IO [Char]) -> [CString] -> IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Char] -> CString -> IO [Char]
peek_ref_name [Char]
"") [CString]
strps
    Ptr C'git_strarray -> IO ()
G.c'git_strarray_free Ptr C'git_strarray
arrayp
    [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
refs

-- | Read all refs along with their commits.
read_ref_map :: Repo -> IO (Map Ref Commit)
read_ref_map :: [Char] -> IO (Map [Char] Commit)
read_ref_map [Char]
repo = [Char]
-> (Ptr C'git_repository -> IO (Map [Char] Commit))
-> IO (Map [Char] Commit)
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO (Map [Char] Commit))
 -> IO (Map [Char] Commit))
-> (Ptr C'git_repository -> IO (Map [Char] Commit))
-> IO (Map [Char] Commit)
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> do
    [[Char]]
refs <- Ptr C'git_repository -> IO [[Char]]
read_refs Ptr C'git_repository
repop
    [Maybe Commit]
commits <- ([Char] -> IO (Maybe Commit)) -> [[Char]] -> IO [Maybe Commit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr C'git_repository -> [Char] -> IO (Maybe Commit)
read_ref_repo Ptr C'git_repository
repop) [[Char]]
refs
    Map [Char] Commit -> IO (Map [Char] Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map [Char] Commit -> IO (Map [Char] Commit))
-> Map [Char] Commit -> IO (Map [Char] Commit)
forall a b. (a -> b) -> a -> b
$ [([Char], Commit)] -> Map [Char] Commit
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [([Char]
ref, Commit
commit) | ([Char]
ref, Just Commit
commit) <- [[Char]] -> [Maybe Commit] -> [([Char], Maybe Commit)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
refs [Maybe Commit]
commits]

with_ref_name :: Ref -> (CString -> IO a) -> IO a
with_ref_name :: forall a. [Char] -> (CString -> IO a) -> IO a
with_ref_name [Char]
ref CString -> IO a
io = [Char] -> (CString -> IO a) -> IO a
forall a. [Char] -> (CString -> IO a) -> IO a
withCString ([Char]
"refs" [Char] -> ShowS
</> [Char]
ref) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
namep -> CString -> IO a
io CString
namep

peek_ref_name :: String -> CString -> IO Ref
peek_ref_name :: [Char] -> CString -> IO [Char]
peek_ref_name [Char]
prefix CString
str = do
    ([Char]
name, Bool
stripped) <- [Char] -> [Char] -> ([Char], Bool)
forall a. Eq a => [a] -> [a] -> ([a], Bool)
Seq.drop_prefix [Char]
"refs/" ([Char] -> ([Char], Bool)) -> IO [Char] -> IO ([Char], Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO [Char]
peekCString CString
str
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
stripped (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> IO a
throw ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
prefix [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"wasn't in refs/: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
name
    [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
name

-- ** symbolic refs

write_symbolic_ref :: Repo -> Ref -> Ref -> IO ()
write_symbolic_ref :: [Char] -> [Char] -> [Char] -> IO ()
write_symbolic_ref [Char]
repo [Char]
sym [Char]
ref
    | Bool -> Bool
not ([Char] -> Bool
valid_symbolic_ref [Char]
sym) = [Char] -> IO ()
forall a. [Char] -> IO a
throw ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"ref should be ALL_CAPS: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
sym
    | Bool
otherwise = [Char] -> (Ptr C'git_repository -> IO ()) -> IO ()
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO ()) -> IO ())
-> (Ptr C'git_repository -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
        [Char] -> (CString -> IO ()) -> IO ()
forall a. [Char] -> (CString -> IO a) -> IO a
with_ref_name [Char]
ref ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
namep -> [Char] -> (CString -> IO ()) -> IO ()
forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
sym ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
symp ->
        (Ptr (Ptr C'git_reference) -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_reference) -> IO ()) -> IO ())
-> (Ptr (Ptr C'git_reference) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_reference)
refpp -> do
            Ptr C'git_reference
refp <- [Char]
-> Ptr (Ptr C'git_reference)
-> IO Error
-> IO (Ptr C'git_reference)
forall a. [Char] -> Ptr (Ptr a) -> IO Error -> IO (Ptr a)
check_lookup [Char]
"reference_symbolic_create" Ptr (Ptr C'git_reference)
refpp (IO Error -> IO (Ptr C'git_reference))
-> IO Error -> IO (Ptr C'git_reference)
forall a b. (a -> b) -> a -> b
$
                Ptr (Ptr C'git_reference)
-> Ptr C'git_repository -> CString -> CString -> Error -> IO Error
G.c'git_reference_symbolic_create Ptr (Ptr C'git_reference)
refpp Ptr C'git_repository
repop CString
symp CString
namep Error
1
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr C'git_reference
refp Ptr C'git_reference -> Ptr C'git_reference -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr C'git_reference
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                Ptr C'git_reference -> IO ()
G.c'git_reference_free Ptr C'git_reference
refp

read_symbolic_ref :: Repo -> Ref -> IO (Maybe Ref)
read_symbolic_ref :: [Char] -> [Char] -> IO (Maybe [Char])
read_symbolic_ref [Char]
repo [Char]
sym = [Char]
-> (Ptr C'git_repository -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO (Maybe [Char])) -> IO (Maybe [Char]))
-> (Ptr C'git_repository -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    Ptr C'git_repository
-> [Char]
-> (Ptr C'git_reference -> IO (Maybe [Char]))
-> IO (Maybe [Char])
forall a.
Ptr C'git_repository
-> [Char] -> (Ptr C'git_reference -> IO a) -> IO a
with_ref Ptr C'git_repository
repop [Char]
sym ((Ptr C'git_reference -> IO (Maybe [Char])) -> IO (Maybe [Char]))
-> (Ptr C'git_reference -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_reference
symp -> (Ptr (Ptr C'git_reference) -> IO (Maybe [Char]))
-> IO (Maybe [Char])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_reference) -> IO (Maybe [Char]))
 -> IO (Maybe [Char]))
-> (Ptr (Ptr C'git_reference) -> IO (Maybe [Char]))
-> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_reference)
refpp -> do
        Ptr C'git_reference
refp <- [Char]
-> Ptr (Ptr C'git_reference)
-> IO Error
-> IO (Ptr C'git_reference)
forall a. [Char] -> Ptr (Ptr a) -> IO Error -> IO (Ptr a)
check_lookup [Char]
"reference_resolve" Ptr (Ptr C'git_reference)
refpp (IO Error -> IO (Ptr C'git_reference))
-> IO Error -> IO (Ptr C'git_reference)
forall a b. (a -> b) -> a -> b
$
            Ptr (Ptr C'git_reference) -> Ptr C'git_reference -> IO Error
G.c'git_reference_resolve Ptr (Ptr C'git_reference)
refpp Ptr C'git_reference
symp
        if Ptr C'git_reference
refp Ptr C'git_reference -> Ptr C'git_reference -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'git_reference
forall a. Ptr a
nullPtr then Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
            else ([Char] -> Maybe [Char]) -> IO [Char] -> IO (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (IO [Char] -> IO (Maybe [Char])) -> IO [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> CString -> IO [Char]
peek_ref_name ([Char]
"ref of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
sym [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" ")
                (CString -> IO [Char]) -> IO CString -> IO [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'git_reference -> IO CString
G.c'git_reference_name Ptr C'git_reference
refp

-- | Rationale documented at: https://github.com/libgit2/libgit2/pull/938
valid_symbolic_ref :: Ref -> Bool
valid_symbolic_ref :: [Char] -> Bool
valid_symbolic_ref [Char]
ref =
    Bool -> Bool
not ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ref) Bool -> Bool -> Bool
&& (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char -> Bool
Char.isAsciiUpper Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') [Char]
ref
        Bool -> Bool -> Bool
&& [Char] -> Char
forall a. [a] -> a
head [Char]
ref Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_' Bool -> Bool -> Bool
&& [Char] -> Char
forall a. [a] -> a
last [Char]
ref Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_'

-- ** HEAD ref

-- | Point HEAD to a commit.
update_head :: Repo -> Commit -> IO ()
update_head :: [Char] -> Commit -> IO ()
update_head [Char]
repo Commit
commit = do
    Maybe [Char]
maybe_ref <- [Char] -> [Char] -> IO (Maybe [Char])
read_symbolic_ref [Char]
repo [Char]
"HEAD"
    IO () -> ([Char] -> IO ()) -> Maybe [Char] -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> IO ()
forall a. [Char] -> IO a
throw [Char]
"HEAD symbolic ref missing") ([Char] -> Commit -> [Char] -> IO ()
write_ref [Char]
repo Commit
commit) Maybe [Char]
maybe_ref

read_head_commit :: Repo -> IO (Maybe Commit)
read_head_commit :: [Char] -> IO (Maybe Commit)
read_head_commit [Char]
repo = [Char] -> [Char] -> IO (Maybe Commit)
read_ref [Char]
repo ([Char] -> IO (Maybe Commit)) -> IO [Char] -> IO (Maybe Commit)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO [Char]
read_head [Char]
repo

write_head :: Repo -> Ref -> IO ()
write_head :: [Char] -> [Char] -> IO ()
write_head [Char]
repo = [Char] -> [Char] -> [Char] -> IO ()
write_symbolic_ref [Char]
repo [Char]
"HEAD"

read_head :: Repo -> IO Ref
read_head :: [Char] -> IO [Char]
read_head [Char]
repo = IO [Char] -> ([Char] -> IO [Char]) -> Maybe [Char] -> IO [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> IO [Char]
forall a. [Char] -> IO a
throw [Char]
"HEAD symbolic ref missing") [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO [Char]) -> IO (Maybe [Char]) -> IO [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    [Char] -> [Char] -> IO (Maybe [Char])
read_symbolic_ref [Char]
repo [Char]
"HEAD"

-- * revwalk

-- | Get commits in reverse chronological order from the given ref.
read_log :: Repo -> Ref -> IO [Commit]
read_log :: [Char] -> [Char] -> IO [Commit]
read_log [Char]
repo [Char]
ref = [Char] -> (Ptr C'git_repository -> IO [Commit]) -> IO [Commit]
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO [Commit]) -> IO [Commit])
-> (Ptr C'git_repository -> IO [Commit]) -> IO [Commit]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> [Char] -> (CString -> IO [Commit]) -> IO [Commit]
forall a. [Char] -> (CString -> IO a) -> IO a
with_ref_name [Char]
ref ((CString -> IO [Commit]) -> IO [Commit])
-> (CString -> IO [Commit]) -> IO [Commit]
forall a b. (a -> b) -> a -> b
$ \CString
refnamep ->
    Ptr C'git_repository
-> (Ptr C'git_revwalk -> IO [Commit]) -> IO [Commit]
forall a.
Ptr C'git_repository -> (Ptr C'git_revwalk -> IO a) -> IO a
with_revwalk Ptr C'git_repository
repop ((Ptr C'git_revwalk -> IO [Commit]) -> IO [Commit])
-> (Ptr C'git_revwalk -> IO [Commit]) -> IO [Commit]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_revwalk
walkp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"revwalk_push_ref: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ref) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr C'git_revwalk -> CString -> IO Error
G.c'git_revwalk_push_ref Ptr C'git_revwalk
walkp CString
refnamep
        Ptr C'git_revwalk -> [SortFlag] -> IO [Commit]
walk Ptr C'git_revwalk
walkp [SortFlag
SortTime]

-- | Read commits starting from the given commit.
read_log_from :: Repo -> Commit -> IO [Commit]
read_log_from :: [Char] -> Commit -> IO [Commit]
read_log_from [Char]
repo Commit
commit = [Char] -> (Ptr C'git_repository -> IO [Commit]) -> IO [Commit]
forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo ((Ptr C'git_repository -> IO [Commit]) -> IO [Commit])
-> (Ptr C'git_repository -> IO [Commit]) -> IO [Commit]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    OID -> (Ptr C'git_oid -> IO [Commit]) -> IO [Commit]
forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid (Commit -> OID
from_commit Commit
commit) ((Ptr C'git_oid -> IO [Commit]) -> IO [Commit])
-> (Ptr C'git_oid -> IO [Commit]) -> IO [Commit]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> Ptr C'git_repository
-> (Ptr C'git_revwalk -> IO [Commit]) -> IO [Commit]
forall a.
Ptr C'git_repository -> (Ptr C'git_revwalk -> IO a) -> IO a
with_revwalk Ptr C'git_repository
repop ((Ptr C'git_revwalk -> IO [Commit]) -> IO [Commit])
-> (Ptr C'git_revwalk -> IO [Commit]) -> IO [Commit]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_revwalk
walkp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"revwalk_push: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Commit -> [Char]
forall a. Show a => a -> [Char]
show Commit
commit) (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr C'git_revwalk -> Ptr C'git_oid -> IO Error
G.c'git_revwalk_push Ptr C'git_revwalk
walkp Ptr C'git_oid
oidp
        Ptr C'git_revwalk -> [SortFlag] -> IO [Commit]
walk Ptr C'git_revwalk
walkp [SortFlag
SortTime]

-- | Get commits in reverse chronological order from the HEAD.
read_log_head :: Repo -> IO [Commit]
read_log_head :: [Char] -> IO [Commit]
read_log_head [Char]
repo = [Char] -> [Char] -> IO [Commit]
read_log [Char]
repo ([Char] -> IO [Commit]) -> IO [Char] -> IO [Commit]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO [Char]
read_head [Char]
repo

data SortFlag = SortTopological | SortTime | SortReverse deriving (Int -> SortFlag -> ShowS
[SortFlag] -> ShowS
SortFlag -> [Char]
(Int -> SortFlag -> ShowS)
-> (SortFlag -> [Char]) -> ([SortFlag] -> ShowS) -> Show SortFlag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SortFlag] -> ShowS
$cshowList :: [SortFlag] -> ShowS
show :: SortFlag -> [Char]
$cshow :: SortFlag -> [Char]
showsPrec :: Int -> SortFlag -> ShowS
$cshowsPrec :: Int -> SortFlag -> ShowS
Show)

walk :: Ptr G.C'git_revwalk -> [SortFlag] -> IO [Commit]
walk :: Ptr C'git_revwalk -> [SortFlag] -> IO [Commit]
walk Ptr C'git_revwalk
walkp [SortFlag]
flags = do
    Ptr C'git_revwalk -> CUInt -> IO ()
G.c'git_revwalk_sorting Ptr C'git_revwalk
walkp
        ((CUInt -> CUInt -> CUInt) -> CUInt -> [CUInt] -> CUInt
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
(Bits..|.) CUInt
git_sort_none ((SortFlag -> CUInt) -> [SortFlag] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map SortFlag -> CUInt
flag [SortFlag]
flags))
    (Ptr C'git_oid -> IO [Commit]) -> IO [Commit]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'git_oid -> IO [Commit]) -> IO [Commit])
-> (Ptr C'git_oid -> IO [Commit]) -> IO [Commit]
forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> IO (Maybe Commit) -> IO [Commit]
forall {m :: * -> *} {a}. Monad m => m (Maybe a) -> m [a]
while_just (Ptr C'git_oid -> IO (Maybe Commit)
next Ptr C'git_oid
oidp)
    where
    next :: Ptr C'git_oid -> IO (Maybe Commit)
next Ptr C'git_oid
oidp = do
        Error
errno <- Ptr C'git_oid -> Ptr C'git_revwalk -> IO Error
G.c'git_revwalk_next Ptr C'git_oid
oidp Ptr C'git_revwalk
walkp
        if Error
errno Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
forall a. Num a => a
G.c'GIT_ITEROVER then Maybe Commit -> IO (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Commit
forall a. Maybe a
Nothing else do
        [Char] -> IO Error -> IO ()
check [Char]
"revwalk_next" (Error -> IO Error
forall (m :: * -> *) a. Monad m => a -> m a
return Error
errno)
        OID
oid <- Ptr C'git_oid -> IO OID
peek_oid Ptr C'git_oid
oidp
        Maybe Commit -> IO (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Commit -> Maybe Commit
forall a. a -> Maybe a
Just (OID -> Commit
to_commit OID
oid))
    while_just :: m (Maybe a) -> m [a]
while_just m (Maybe a)
io = do
        Maybe a
maybe_val <- m (Maybe a)
io
        case Maybe a
maybe_val of
            Maybe a
Nothing -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            Just a
val -> do
                [a]
vals <- m (Maybe a) -> m [a]
while_just m (Maybe a)
io
                [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
val a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
vals)
    flag :: SortFlag -> CUInt
flag SortFlag
f = case SortFlag
f of
        SortFlag
SortTopological -> CUInt
git_sort_topological
        SortFlag
SortTime -> CUInt
git_sort_time
        SortFlag
SortReverse -> CUInt
git_sort_reverse

-- | These aren't declared as a type at the C level, so the binding doesn't
-- have them.
git_sort_none, git_sort_topological, git_sort_time, git_sort_reverse :: CUInt
git_sort_none :: CUInt
git_sort_none = CUInt
0
git_sort_topological :: CUInt
git_sort_topological = CUInt
1
git_sort_time :: CUInt
git_sort_time = CUInt
2
git_sort_reverse :: CUInt
git_sort_reverse = CUInt
4

with_revwalk :: RepoP -> (Ptr G.C'git_revwalk -> IO a) -> IO a
with_revwalk :: forall a.
Ptr C'git_repository -> (Ptr C'git_revwalk -> IO a) -> IO a
with_revwalk Ptr C'git_repository
repop Ptr C'git_revwalk -> IO a
io = (Ptr (Ptr C'git_revwalk) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr C'git_revwalk) -> IO a) -> IO a)
-> (Ptr (Ptr C'git_revwalk) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_revwalk)
walkpp -> do
    [Char] -> IO Error -> IO ()
check [Char]
"revwalk_new" (IO Error -> IO ()) -> IO Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr C'git_revwalk) -> Ptr C'git_repository -> IO Error
G.c'git_revwalk_new Ptr (Ptr C'git_revwalk)
walkpp Ptr C'git_repository
repop
    Ptr C'git_revwalk
walkp <- Ptr (Ptr C'git_revwalk) -> IO (Ptr C'git_revwalk)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_revwalk)
walkpp
    Ptr C'git_revwalk -> IO a
io Ptr C'git_revwalk
walkp IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`Exception.finally` Ptr C'git_revwalk -> IO ()
G.c'git_revwalk_free Ptr C'git_revwalk
walkp

-- * dir

type Dir = Map FileName File
data File = File ByteString | Dir Dir deriving (File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: File -> File -> Bool
Eq, Int -> File -> ShowS
[File] -> ShowS
File -> [Char]
(Int -> File -> ShowS)
-> (File -> [Char]) -> ([File] -> ShowS) -> Show File
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> [Char]
$cshow :: File -> [Char]
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
Show)

make_dir :: [(FilePath, ByteString)] -> Either String Dir
make_dir :: [([Char], ByteString)] -> Either [Char] Dir
make_dir = (Dir -> ([Char], ByteString) -> Either [Char] Dir)
-> Dir -> [([Char], ByteString)] -> Either [Char] Dir
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Dir -> ([Char], ByteString) -> Either [Char] Dir
merge Dir
forall k a. Map k a
Map.empty
    where
    -- System.FilePath is incorrect because git always uses /s.
    merge :: Dir -> ([Char], ByteString) -> Either [Char] Dir
merge Dir
dir ([Char]
path, ByteString
bytes) = Dir -> [[Char]] -> ByteString -> Either [Char] Dir
insert Dir
dir ([Char] -> [Char] -> [[Char]]
forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
Seq.split [Char]
"/" [Char]
path) ByteString
bytes
    insert :: Dir -> [[Char]] -> ByteString -> Either [Char] Dir
insert Dir
_ [] ByteString
bytes = [Char] -> Either [Char] Dir
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Dir) -> [Char] -> Either [Char] Dir
forall a b. (a -> b) -> a -> b
$ [Char]
"can't insert into empty path: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
bytes
    insert Dir
files [[Char]
name] ByteString
bytes = Dir -> Either [Char] Dir
forall (m :: * -> *) a. Monad m => a -> m a
return (Dir -> Either [Char] Dir) -> Dir -> Either [Char] Dir
forall a b. (a -> b) -> a -> b
$ [Char] -> File -> Dir -> Dir
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
name (ByteString -> File
File ByteString
bytes) Dir
files
    insert Dir
files ([Char]
name : [[Char]]
names) ByteString
bytes = do
        Dir
subs <- case [Char] -> Dir -> Maybe File
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
name Dir
files of
            Just (Dir Dir
subs) -> Dir -> Either [Char] Dir
forall (m :: * -> *) a. Monad m => a -> m a
return Dir
subs
            Just (File ByteString
_) ->
                [Char] -> Either [Char] Dir
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Dir) -> [Char] -> Either [Char] Dir
forall a b. (a -> b) -> a -> b
$ [Char]
"can't insert below a file: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
name
            Maybe File
Nothing -> Dir -> Either [Char] Dir
forall (m :: * -> *) a. Monad m => a -> m a
return Dir
forall k a. Map k a
Map.empty
        Dir
subs <- Dir -> [[Char]] -> ByteString -> Either [Char] Dir
insert Dir
subs [[Char]]
names ByteString
bytes
        Dir -> Either [Char] Dir
forall (m :: * -> *) a. Monad m => a -> m a
return (Dir -> Either [Char] Dir) -> Dir -> Either [Char] Dir
forall a b. (a -> b) -> a -> b
$ [Char] -> File -> Dir -> Dir
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert [Char]
name (Dir -> File
Dir Dir
subs) Dir
files

flatten_dir :: Dir -> [(FilePath, ByteString)]
flatten_dir :: Dir -> [([Char], ByteString)]
flatten_dir = (([Char], File) -> [([Char], ByteString)])
-> [([Char], File)] -> [([Char], ByteString)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], File) -> [([Char], ByteString)]
flatten ([([Char], File)] -> [([Char], ByteString)])
-> (Dir -> [([Char], File)]) -> Dir -> [([Char], ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir -> [([Char], File)]
forall k a. Map k a -> [(k, a)]
Map.toList
    where
    flatten :: ([Char], File) -> [([Char], ByteString)]
flatten ([Char]
name, File ByteString
bytes) = [([Char]
name, ByteString
bytes)]
    flatten ([Char]
name, Dir Dir
dir) = (([Char], ByteString) -> ([Char], ByteString))
-> [([Char], ByteString)] -> [([Char], ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> ([Char], ByteString) -> ([Char], ByteString)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Char]
name </>)) (Dir -> [([Char], ByteString)]
flatten_dir Dir
dir)

write_dir :: Repo -> Dir -> IO Tree
write_dir :: [Char] -> Dir -> IO Tree
write_dir [Char]
repo Dir
filemap = do
    let files :: [([Char], File)]
files = Dir -> [([Char], File)]
forall k a. Map k a -> [(k, a)]
Map.toList Dir
filemap
    [Either Blob Tree]
hashes <- (([Char], File) -> IO (Either Blob Tree))
-> [([Char], File)] -> IO [Either Blob Tree]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (File -> IO (Either Blob Tree)
write (File -> IO (Either Blob Tree))
-> (([Char], File) -> File)
-> ([Char], File)
-> IO (Either Blob Tree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], File) -> File
forall a b. (a, b) -> b
snd) [([Char], File)]
files
    [Char]
-> Maybe Tree -> [([Char], Maybe (Either Blob Tree))] -> IO Tree
write_tree [Char]
repo Maybe Tree
forall a. Maybe a
Nothing ([[Char]]
-> [Maybe (Either Blob Tree)]
-> [([Char], Maybe (Either Blob Tree))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((([Char], File) -> [Char]) -> [([Char], File)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], File) -> [Char]
forall a b. (a, b) -> a
fst [([Char], File)]
files) ((Either Blob Tree -> Maybe (Either Blob Tree))
-> [Either Blob Tree] -> [Maybe (Either Blob Tree)]
forall a b. (a -> b) -> [a] -> [b]
map Either Blob Tree -> Maybe (Either Blob Tree)
forall a. a -> Maybe a
Just [Either Blob Tree]
hashes))
    where
    write :: File -> IO (Either Blob Tree)
write (File ByteString
bytes) = Blob -> Either Blob Tree
forall a b. a -> Either a b
Left (Blob -> Either Blob Tree) -> IO Blob -> IO (Either Blob Tree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ByteString -> IO Blob
write_blob [Char]
repo ByteString
bytes
    write (Dir Dir
dir) = Tree -> Either Blob Tree
forall a b. b -> Either a b
Right (Tree -> Either Blob Tree) -> IO Tree -> IO (Either Blob Tree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Dir -> IO Tree
write_dir [Char]
repo Dir
dir

read_dir :: Repo -> Tree -> IO Dir
read_dir :: [Char] -> Tree -> IO Dir
read_dir [Char]
repo Tree
tree = do
    ([[Char]]
names, [Either Blob Tree]
files) <- [([Char], Either Blob Tree)] -> ([[Char]], [Either Blob Tree])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([Char], Either Blob Tree)] -> ([[Char]], [Either Blob Tree]))
-> IO [([Char], Either Blob Tree)]
-> IO ([[Char]], [Either Blob Tree])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Tree -> IO [([Char], Either Blob Tree)]
read_tree [Char]
repo Tree
tree
    [File]
files <- (Either Blob Tree -> IO File) -> [Either Blob Tree] -> IO [File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Either Blob Tree -> IO File
read [Either Blob Tree]
files
    Dir -> IO Dir
forall (m :: * -> *) a. Monad m => a -> m a
return (Dir -> IO Dir) -> Dir -> IO Dir
forall a b. (a -> b) -> a -> b
$ [([Char], File)] -> Dir
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], File)] -> Dir) -> [([Char], File)] -> Dir
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [File] -> [([Char], File)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
names [File]
files
    where
    read :: Either Blob Tree -> IO File
read (Left Blob
blob) = ByteString -> File
File (ByteString -> File) -> IO ByteString -> IO File
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Blob -> IO ByteString
read_blob [Char]
repo Blob
blob
    read (Right Tree
tree) = Dir -> File
Dir (Dir -> File) -> IO Dir -> IO File
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Tree -> IO Dir
read_dir [Char]
repo Tree
tree

-- * misc

-- | GC the repo.  As far as I know, there's no way to do this with libgit2, so
-- it invokes the standalone git command.
gc :: Repo -> IO ()
gc :: [Char] -> IO ()
gc [Char]
repo = [Char] -> [[Char]] -> ByteString -> IO ByteString
git [Char]
repo [[Char]
"gc", [Char]
"--aggressive"] ByteString
"" IO ByteString -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

git :: Repo -> [String] -> ByteString -> IO ByteString
git :: [Char] -> [[Char]] -> ByteString -> IO ByteString
git [Char]
repo = [Char]
-> [([Char], [Char])] -> [[Char]] -> ByteString -> IO ByteString
git_env [Char]
repo []

git_env :: Repo -> [(String, String)] -> [String] -> ByteString
    -> IO ByteString
git_env :: [Char]
-> [([Char], [Char])] -> [[Char]] -> ByteString -> IO ByteString
git_env [Char]
repo [([Char], [Char])]
env [[Char]]
args ByteString
stdin = do
    (ExitCode
ex, ByteString
out, ByteString
err) <- Maybe [([Char], [Char])]
-> [Char]
-> [[Char]]
-> ByteString
-> IO (ExitCode, ByteString, ByteString)
Processes.readProcessWithExitCode
        ([([Char], [Char])] -> Maybe [([Char], [Char])]
forall a. a -> Maybe a
Just (([Char]
"GIT_DIR", [Char]
repo) ([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
forall a. a -> [a] -> [a]
: [([Char], [Char])]
env)) [Char]
"git" [[Char]]
args ByteString
stdin
    -- let sin = " <" ++ show (Char8.length stdin)
    -- let sin = if Char8.null stdin then "" else " <" ++ show stdin
    -- putStrLn $ unwords ("git" : args) ++ sin ++ " ==> "
    --     ++ Seq.strip (Char8.unpack out)
    case ExitCode
ex of
        Exit.ExitFailure Int
code -> [Char] -> IO ByteString
forall a. [Char] -> IO a
throw ([Char] -> IO ByteString) -> [Char] -> IO ByteString
forall a b. (a -> b) -> a -> b
$
            [Char]
repo [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" -- " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords ([Char]
"git" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
args) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
code
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
Seq.strip (ByteString -> [Char]
Char8.unpack ByteString
err)
        ExitCode
_ -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
out

-- * error

type Error = CInt

error_msg :: Error -> Maybe String
error_msg :: Error -> Maybe [Char]
error_msg Error
errno
    | Error
errno Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
forall a. Num a => a
G.c'GIT_OK = Maybe [Char]
forall a. Maybe a
Nothing
    | Bool
otherwise = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Error -> Map Error [Char] -> [Char]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
        ([Char]
"undocumented errno: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Error -> [Char]
forall a. Show a => a -> [Char]
show Error
errno) Error
errno Map Error [Char]
errors
    where
    errors :: Map Error [Char]
errors = [(Error, [Char])] -> Map Error [Char]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Error
forall a. Num a => a
G.c'GIT_ERROR, [Char]
"error")
        , (Error
forall a. Num a => a
G.c'GIT_ENOTFOUND, [Char]
"not found")
        , (Error
forall a. Num a => a
G.c'GIT_EEXISTS, [Char]
"already exists")
        , (Error
forall a. Num a => a
G.c'GIT_EAMBIGUOUS, [Char]
"short oid is ambiguous")
        , (Error
forall a. Num a => a
G.c'GIT_EBUFS, [Char]
"undocumented GIT_EBUFS")
        , (Error
forall a. Num a => a
G.c'GIT_PASSTHROUGH, [Char]
"passthrough")
        , (Error
forall a. Num a => a
G.c'GIT_ITEROVER, [Char]
"iteration over")
        ]

newtype GitException = GitException String deriving (Typeable.Typeable)
instance Exception.Exception GitException
instance Show GitException where
    show :: GitException -> [Char]
show (GitException [Char]
msg) = [Char]
"GitException: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg

throw :: String -> IO a
throw :: forall a. [Char] -> IO a
throw = GitException -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO (GitException -> IO a)
-> ([Char] -> GitException) -> [Char] -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> GitException
GitException

check :: String -> IO Error -> IO ()
check :: [Char] -> IO Error -> IO ()
check [Char]
caller IO Error
action = do
    Error
errno <- IO Error
action
    case Error -> Maybe [Char]
error_msg Error
errno of
        Maybe [Char]
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just [Char]
msg -> [Char] -> IO ()
forall a. [Char] -> IO a
throw ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
caller [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg

check_lookup :: String -> Ptr (Ptr a) -> IO Error -> IO (Ptr a)
check_lookup :: forall a. [Char] -> Ptr (Ptr a) -> IO Error -> IO (Ptr a)
check_lookup [Char]
caller Ptr (Ptr a)
ptrptr IO Error
io = do
    Error
errno <- IO Error
io
    if Error
errno Error -> Error -> Bool
forall a. Eq a => a -> a -> Bool
== Error
forall a. Num a => a
G.c'GIT_ENOTFOUND then Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
forall a. Ptr a
nullPtr else do
    case Error -> Maybe [Char]
error_msg Error
errno of
        Maybe [Char]
Nothing -> Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptrptr
        Just [Char]
msg -> [Char] -> IO (Ptr a)
forall a. [Char] -> IO a
throw ([Char] -> IO (Ptr a)) -> [Char] -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ [Char]
caller [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
msg

-- * util

with_fptr :: IO (FunPtr a) -> (FunPtr a -> IO b) -> IO b
with_fptr :: forall a b. IO (FunPtr a) -> (FunPtr a -> IO b) -> IO b
with_fptr IO (FunPtr a)
make FunPtr a -> IO b
io = do
    FunPtr a
fptr <- IO (FunPtr a)
make
    FunPtr a -> IO b
io FunPtr a
fptr IO b -> IO () -> IO b
forall a b. IO a -> IO b -> IO a
`Exception.finally` FunPtr a -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr a
fptr

withText :: Text -> (CString -> IO a) -> IO a
withText :: forall a. Text -> (CString -> IO a) -> IO a
withText = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.useAsCString (ByteString -> (CString -> IO a) -> IO a)
-> (Text -> ByteString) -> Text -> (CString -> IO a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Encoding.encodeUtf8