-- 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.Lists as Lists
import qualified Util.Processes as Processes
import qualified Util.Strings as Strings

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 =
    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
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
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]
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 =
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.Unsafe.unsafeUseAsCStringLen ByteString
bytes forall a b. (a -> b) -> a -> b
$ \(CString
bytesp, Int
len) ->
        forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> do
            [Char] -> IO Error -> IO ()
check ([Char]
"OID poke " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ByteString
bytes) 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 (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 = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 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 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 = forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> do
    let bs :: ByteString
bs = [Word8] -> ByteString
ByteString.pack (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [CUChar]
bytes)
    forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.Unsafe.unsafeUseAsCString ByteString
bs 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 (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
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
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]
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
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
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]
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 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 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 = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM IO Bool
is_git (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall a b. (a -> b) -> a -> b
$ do
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_repository)
repopp -> forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
repo forall a b. (a -> b) -> a -> b
$ \CString
pathp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"init " forall a. [a] -> [a] -> [a]
++ [Char]
repo) 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 <- 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
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    where
    is_git :: IO Bool
is_git = 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 = forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
path forall a b. (a -> b) -> a -> b
$ \CString
pathp -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_repository)
repopp -> do
    [Char] -> IO Error -> IO ()
check ([Char]
"open " forall a. [a] -> [a] -> [a]
++ [Char]
path) 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 <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_repository)
repopp
    Either GitException a
result <- forall e a. Exception e => IO a -> IO (Either e a)
Exception.try 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return a
ok
        Left (GitException [Char]
err) ->
            forall a. [Char] -> IO a
throw forall a b. (a -> b) -> a -> b
$ [Char]
"repo " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
": " 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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo 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 = forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp ->
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.Unsafe.unsafeUseAsCStringLen ByteString
bytes forall a b. (a -> b) -> a -> b
$ \(CString
bytesp, Int
len) -> do
        [Char] -> IO Error -> IO ()
check [Char]
"write_blob" 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 (forall a b. Ptr a -> Ptr b
castPtr CString
bytesp)
                (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
        OID -> Blob
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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo 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) =
    forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid OID
blob forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_blob)
blobpp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"blob_lookup: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show OID
blob) 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 <- 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 (forall a b. Ptr a -> Ptr b
castPtr Ptr ()
bufp, 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
        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
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]
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 " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
txt [Char]
fn
    pretty (Add [Char]
fn ByteString
bytes) = Text
"add" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
txt [Char]
fn
        forall a. Semigroup a => a -> a -> a
<> Text
" {" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (ByteString -> Int
Char8.length ByteString
bytes) forall a. Semigroup a => a -> a -> a
<> Text
"}"

type ModifyDir = [(FileName, ModifyFile)]
data ModifyFile = ModifyFile (Maybe ByteString) | ModifyDir ModifyDir
    deriving (ModifyFile -> ModifyFile -> Bool
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]
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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], [([Char], Maybe ByteString)]) -> ModifyDir
make (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 forall a. [a] -> [a] -> [a]
++ ModifyDir
files
        where
        dirs :: ModifyDir
dirs = if 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 forall a. [a] -> Maybe a
Lists.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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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, forall a b. (a -> b) -> [a] -> [b]
map (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) <- forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
Lists.keyedGroupSort (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [([Char], c)]
entries]
    drop_dir :: ShowS
drop_dir = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'/')
    -- Strip out redundent modifications.
    strip :: [Modification] -> [([Char], Maybe ByteString)]
strip = forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Modification -> ([Char], Maybe ByteString)
extract
    extract :: Modification -> ([Char], Maybe ByteString)
extract (Remove [Char]
fn) = ([Char]
fn, forall a. Maybe a
Nothing)
    extract (Add [Char]
fn ByteString
bytes) = ([Char]
fn, 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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    forall {a}.
Ptr C'git_repository -> (Ptr C'git_tree -> IO a) -> IO a
maybe_with Ptr C'git_repository
repop forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
fromp -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_treebuilder)
builderpp -> do
        [Char] -> IO Error -> IO ()
check [Char]
"treebuilder_create" 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 <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_treebuilder)
builderpp
        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 <- forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> do
            [Char] -> IO Error -> IO ()
check [Char]
"treebuilder_write" 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
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> 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 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) = forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
name 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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo 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 (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 =
        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 forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
treep -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_treebuilder)
builderpp -> do
            [Char] -> IO Error -> IO ()
check [Char]
"treebuilder_create" 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 <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_treebuilder)
builderpp
            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 <- forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> do
                [Char] -> IO Error -> IO ()
check [Char]
"treebuilder_write" 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
            forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Ptr a
nullPtr
    with_maybe_tree Ptr C'git_repository
repop (Just Tree
tree) Ptr C'git_tree -> IO a
io = 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) =
        forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
name 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) =
        forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
name 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 forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                else forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. OID -> Tree
Tree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr C'git_oid -> IO OID
peek_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.
            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: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
name) 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: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
name) forall a b. (a -> b) -> a -> b
$ forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid OID
oid 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 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: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ([Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
"/")) forall a b. (a -> b) -> a -> b
$
    forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid OID
oid 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 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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
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 <- 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)
            (forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range' CSize
0 CSize
count CSize
1)
        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 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 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 forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
G.c'GIT_OBJ_TREE then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (OID -> Tree
Tree OID
oid)) else
            if Error
typ forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
G.c'GIT_OBJ_BLOB then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (OID -> Blob
Blob OID
oid)) else
            forall a. [Char] -> IO a
throw forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show OID
oid forall a. [a] -> [a] -> [a]
++ [Char]
" expected tree or blob: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Error
typ
        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 = forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CSize
count 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 = forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid OID
oid forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_tree)
treepp -> do
    [Char] -> IO Error -> IO ()
check ([Char]
"tree_lookup: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show OID
oid) 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 <- 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 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
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
str forall a. Eq a => a -> a -> Bool
== Int
40 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Commit
Commit forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
Char8.pack [Char]
str
    | Bool
otherwise = 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 =
    forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> forall {a}. (Ptr C'git_signature -> IO a) -> IO a
with_sig forall a b. (a -> b) -> a -> b
$ \Ptr C'git_signature
sigp ->
    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 forall a b. (a -> b) -> a -> b
$ \Int
parents_len Ptr (Ptr C'git_commit)
parentsp ->
    forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
tree forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
treep -> forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
description forall a b. (a -> b) -> a -> b
$ \CString
descp ->
    forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
"HEAD" forall a b. (a -> b) -> a -> b
$ \CString
headp -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
commitp -> do
        [Char] -> IO Error -> IO ()
check [Char]
"write_commit" 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 forall a. Ptr a
nullPtr CString
descp Ptr C'git_tree
treep (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
parents_len) Ptr (Ptr C'git_commit)
parentsp
        OID -> Commit
to_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 = forall a. Text -> (CString -> IO a) -> IO a
withText Text
user forall a b. (a -> b) -> a -> b
$ \CString
userp -> forall a. Text -> (CString -> IO a) -> IO a
withText Text
email forall a b. (a -> b) -> a -> b
$ \CString
emailp ->
        forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_signature)
sigpp -> do
            [Char] -> IO Error -> IO ()
check [Char]
"signature_now" 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 <- 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 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 = forall {a}.
[Ptr C'git_commit]
-> [Commit] -> ([Ptr C'git_commit] -> IO a) -> IO a
go [] [Commit]
commits forall a b. (a -> b) -> a -> b
$ \[Ptr C'git_commit]
ps -> 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 (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 = forall a.
Ptr C'git_repository
-> Commit -> (Ptr C'git_commit -> IO a) -> IO a
with_commit Ptr C'git_repository
repop Commit
c 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
pforall 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
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]
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 =
    forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo 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 = forall a.
Ptr C'git_repository
-> Commit -> (Ptr C'git_commit -> IO a) -> IO a
with_commit Ptr C'git_repository
repop Commit
commit forall a b. (a -> b) -> a -> b
$ \Ptr C'git_commit
commitp -> do
    [Char]
author <- C'git_signature -> IO [Char]
peek_user forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek 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 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 <- 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
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 forall a. Eq a => a -> a -> Bool
== CUInt
0 then [] else [CUInt
0..CUInt
parents_lenforall a. Num a => a -> a -> a
-CUInt
1])
    [Char]
desc <- CString -> IO [Char]
peekCString 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tree -> [Commit] -> [Char] -> [Char] -> CommitData
CommitData (OID -> Tree
Tree OID
tree) (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)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
" <" forall a. [a] -> [a] -> [a]
++ [Char]
email 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 = forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid (Commit -> OID
from_commit Commit
commit) forall a b. (a -> b) -> a -> b
$
    \Ptr C'git_oid
oidp -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_commit)
commitpp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"tree_lookup: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Commit
commit) 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 <- 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 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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo 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 =
    forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo 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 =
    forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
old forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
oldp -> forall a.
Ptr C'git_repository -> Tree -> (Ptr C'git_tree -> IO a) -> IO a
with_tree Ptr C'git_repository
repop Tree
new forall a b. (a -> b) -> a -> b
$ \Ptr C'git_tree
newp -> do
    [(CUInt, [Char], OID)]
diffs <- forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_diff_list)
listpp -> do
        [Char] -> IO Error -> IO ()
check [Char]
"diff_tree" 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 forall a. Ptr a
nullPtr
        Ptr C'git_diff_list
listp <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_diff_list)
listpp
        IORef [(CUInt, [Char], OID)]
ref <- 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
        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 C'git_diff_data_cb
G.mk'git_diff_data_cb (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)) forall a b. (a -> b) -> a -> b
$ \C'git_diff_data_cb
callback ->
            [Char] -> IO Error -> IO ()
check [Char]
"diff_print_compact" forall a b. (a -> b) -> a -> b
$
                Ptr C'git_diff_list -> C'git_diff_data_cb -> Ptr () -> IO Error
G.c'git_diff_print_compact Ptr C'git_diff_list
listp C'git_diff_data_cb
callback forall a. Ptr a
nullPtr
        forall a. IORef a -> IO a
IORef.readIORef IORef [(CUInt, [Char], OID)]
ref
    forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
concatMapM 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 forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
G.c'GIT_DELTA_DELETED = forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> Modification
Remove [Char]
path]
        | a
status forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
G.c'GIT_DELTA_ADDED Bool -> Bool -> Bool
|| a
status forall a. Eq a => a -> a -> Bool
== 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)
            forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> ByteString -> Modification
Add [Char]
path ByteString
bytes]
        | Bool
otherwise = forall a. [Char] -> IO a
throw forall a b. (a -> b) -> a -> b
$ [Char]
"diff_trees " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Tree
old, Tree
new)
            forall a. [a] -> [a] -> [a]
++ [Char]
": unknown status: " forall a. [a] -> [a] -> [a]
++ 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 <- 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
        forall a. IORef a -> (a -> a) -> IO ()
IORef.modifyIORef IORef [(CUInt, [Char], OID)]
ref ((CUInt
status, [Char]
path, OID
oid):)
        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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid (Commit -> OID
from_commit Commit
commit) forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
commitp -> forall a. [Char] -> (CString -> IO a) -> IO a
with_ref_name [Char]
ref forall a b. (a -> b) -> a -> b
$ \CString
namep ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_reference)
refpp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"write_ref " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
ref) 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 <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr C'git_reference)
refpp
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr C'git_reference
refp forall a. Eq a => a -> a -> Bool
/= forall a. Ptr a
nullPtr) 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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo 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 = forall a. [Char] -> (CString -> IO a) -> IO a
with_ref_name [Char]
ref forall a b. (a -> b) -> a -> b
$ \CString
namep ->
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca 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 forall a. Eq a => a -> a -> Bool
/= forall a. Num a => a
G.c'GIT_OK then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else do
        OID
oid <- Ptr C'git_oid -> IO OID
peek_oid Ptr C'git_oid
oidp
        forall (m :: * -> *) a. Monad m => a -> m a
return (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 =
    forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
ref forall a b. (a -> b) -> a -> b
$ \CString
namep -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_reference)
refpp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"reference_lookup " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
ref) 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 <- 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 forall a b. IO a -> IO b -> IO a
`Exception.finally` forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr C'git_reference
refp forall a. Eq a => a -> a -> Bool
/= 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 = forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr C'git_strarray
arrayp -> do
    [Char] -> IO Error -> IO ()
check [Char]
"read_refs" 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
        forall a. Num a => a
G.c'GIT_REF_LISTALL
    G.C'git_strarray Ptr CString
stringsp CSize
count <- forall a. Storable a => Ptr a -> IO a
peek Ptr C'git_strarray
arrayp
    [CString]
strps <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
count) Ptr CString
stringsp
    [[Char]]
refs <- 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
    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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo 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 <- 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [([Char]
ref, Commit
commit) | ([Char]
ref, Just Commit
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 = forall a. [Char] -> (CString -> IO a) -> IO a
withCString ([Char]
"refs" [Char] -> ShowS
</> [Char]
ref) 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) <- forall a. Eq a => [a] -> [a] -> ([a], Bool)
Lists.dropPrefix [Char]
"refs/" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO [Char]
peekCString CString
str
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
stripped forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> IO a
throw forall a b. (a -> b) -> a -> b
$ [Char]
prefix forall a. [a] -> [a] -> [a]
++ [Char]
"wasn't in refs/: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
name
    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) = forall a. [Char] -> IO a
throw forall a b. (a -> b) -> a -> b
$ [Char]
"ref should be ALL_CAPS: " forall a. [a] -> [a] -> [a]
++ [Char]
sym
    | Bool
otherwise = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
        forall a. [Char] -> (CString -> IO a) -> IO a
with_ref_name [Char]
ref forall a b. (a -> b) -> a -> b
$ \CString
namep -> forall a. [Char] -> (CString -> IO a) -> IO a
withCString [Char]
sym forall a b. (a -> b) -> a -> b
$ \CString
symp ->
        forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_reference)
refpp -> do
            Ptr C'git_reference
refp <- forall a. [Char] -> Ptr (Ptr a) -> IO Error -> IO (Ptr a)
check_lookup [Char]
"reference_symbolic_create" Ptr (Ptr C'git_reference)
refpp 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
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr C'git_reference
refp forall a. Eq a => a -> a -> Bool
/= forall a. Ptr a
nullPtr) 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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    forall a.
Ptr C'git_repository
-> [Char] -> (Ptr C'git_reference -> IO a) -> IO a
with_ref Ptr C'git_repository
repop [Char]
sym forall a b. (a -> b) -> a -> b
$ \Ptr C'git_reference
symp -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_reference)
refpp -> do
        Ptr C'git_reference
refp <- forall a. [Char] -> Ptr (Ptr a) -> IO Error -> IO (Ptr a)
check_lookup [Char]
"reference_resolve" Ptr (Ptr C'git_reference)
refpp 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 forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char] -> CString -> IO [Char]
peek_ref_name ([Char]
"ref of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
sym forall a. [a] -> [a] -> [a]
++ [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 (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ref) Bool -> Bool -> 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 forall a. Eq a => a -> a -> Bool
== Char
'_') [Char]
ref
        Bool -> Bool -> Bool
&& forall a. [a] -> a
head [Char]
ref forall a. Eq a => a -> a -> Bool
/= Char
'_' Bool -> Bool -> Bool
&& forall a. [a] -> a
last [Char]
ref 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"
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. [Char] -> IO a
throw [Char]
"HEAD symbolic ref missing") forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop -> forall a. [Char] -> (CString -> IO a) -> IO a
with_ref_name [Char]
ref forall a b. (a -> b) -> a -> b
$ \CString
refnamep ->
    forall a.
Ptr C'git_repository -> (Ptr C'git_revwalk -> IO a) -> IO a
with_revwalk Ptr C'git_repository
repop forall a b. (a -> b) -> a -> b
$ \Ptr C'git_revwalk
walkp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"revwalk_push_ref: " forall a. [a] -> [a] -> [a]
++ [Char]
ref) 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 = forall a. [Char] -> (Ptr C'git_repository -> IO a) -> IO a
with_repo [Char]
repo forall a b. (a -> b) -> a -> b
$ \Ptr C'git_repository
repop ->
    forall a. OID -> (Ptr C'git_oid -> IO a) -> IO a
with_oid (Commit -> OID
from_commit Commit
commit) forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> forall a.
Ptr C'git_repository -> (Ptr C'git_revwalk -> IO a) -> IO a
with_revwalk Ptr C'git_repository
repop forall a b. (a -> b) -> a -> b
$ \Ptr C'git_revwalk
walkp -> do
        [Char] -> IO Error -> IO ()
check ([Char]
"revwalk_push: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Commit
commit) 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 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]
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
        (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Bits a => a -> a -> a
(Bits..|.) CUInt
git_sort_none (forall a b. (a -> b) -> [a] -> [b]
map SortFlag -> CUInt
flag [SortFlag]
flags))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr C'git_oid
oidp -> 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 forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
G.c'GIT_ITEROVER then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else do
        [Char] -> IO Error -> IO ()
check [Char]
"revwalk_next" (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
        forall (m :: * -> *) a. Monad m => a -> m a
return (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 -> 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
                forall (m :: * -> *) a. Monad m => a -> m a
return (a
val 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 = forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr C'git_revwalk)
walkpp -> do
    [Char] -> IO Error -> IO ()
check [Char]
"revwalk_new" 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 <- 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 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
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]
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 = 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 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 (forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
Lists.split [Char]
"/" [Char]
path) ByteString
bytes
    insert :: Dir -> [[Char]] -> ByteString -> Either [Char] Dir
insert Dir
_ [] ByteString
bytes = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"can't insert into empty path: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ByteString
bytes
    insert Dir
files [[Char]
name] ByteString
bytes = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
name Dir
files of
            Just (Dir Dir
subs) -> forall (m :: * -> *) a. Monad m => a -> m a
return Dir
subs
            Just (File ByteString
_) ->
                forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"can't insert below a file: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
name
            Maybe File
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
Map.empty
        Dir
subs <- Dir -> [[Char]] -> ByteString -> Either [Char] Dir
insert Dir
subs [[Char]]
names ByteString
bytes
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char], File) -> [([Char], ByteString)]
flatten forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall a b. (a -> b) -> [a] -> [b]
map (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 = forall k a. Map k a -> [(k, a)]
Map.toList Dir
filemap
    [Either Blob Tree]
hashes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (File -> IO (Either Blob Tree)
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [([Char], File)]
files
    [Char]
-> Maybe Tree -> [([Char], Maybe (Either Blob Tree))] -> IO Tree
write_tree [Char]
repo forall a. Maybe a
Nothing (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [([Char], File)]
files) (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [Either Blob Tree]
hashes))
    where
    write :: File -> IO (Either Blob Tree)
write (File ByteString
bytes) = forall a b. a -> Either a b
Left 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) = forall a b. b -> Either a b
Right 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) <- forall a b. [(a, b)] -> ([a], [b])
unzip 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 <- 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ 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 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 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
"" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
        (forall a. a -> Maybe a
Just (([Char]
"GIT_DIR", [Char]
repo) 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 ++ " ==> "
    --     ++ Strings.strip (Char8.unpack out)
    case ExitCode
ex of
        Exit.ExitFailure Int
code -> forall a. [Char] -> IO a
throw forall a b. (a -> b) -> a -> b
$
            [Char]
repo forall a. [a] -> [a] -> [a]
++ [Char]
" -- " forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords ([Char]
"git" forall a. a -> [a] -> [a]
: [[Char]]
args) forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
code
            forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ ShowS
Strings.strip (ByteString -> [Char]
Char8.unpack ByteString
err)
        ExitCode
_ -> 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 forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
G.c'GIT_OK = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault
        ([Char]
"undocumented errno: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Error
errno) Error
errno Map Error [Char]
errors
    where
    errors :: Map Error [Char]
errors = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (forall a. Num a => a
G.c'GIT_ERROR, [Char]
"error")
        , (forall a. Num a => a
G.c'GIT_ENOTFOUND, [Char]
"not found")
        , (forall a. Num a => a
G.c'GIT_EEXISTS, [Char]
"already exists")
        , (forall a. Num a => a
G.c'GIT_EAMBIGUOUS, [Char]
"short oid is ambiguous")
        , (forall a. Num a => a
G.c'GIT_EBUFS, [Char]
"undocumented GIT_EBUFS")
        , (forall a. Num a => a
G.c'GIT_PASSTHROUGH, [Char]
"passthrough")
        , (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: " forall a. [a] -> [a] -> [a]
++ [Char]
msg

throw :: String -> IO a
throw :: forall a. [Char] -> IO a
throw = forall e a. Exception e => e -> IO a
Exception.throwIO 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just [Char]
msg -> forall a. [Char] -> IO a
throw forall a b. (a -> b) -> a -> b
$ [Char]
caller forall a. [a] -> [a] -> [a]
++ [Char]
": " 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 forall a. Eq a => a -> a -> Bool
== forall a. Num a => a
G.c'GIT_ENOTFOUND then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr else do
    case Error -> Maybe [Char]
error_msg Error
errno of
        Maybe [Char]
Nothing -> forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptrptr
        Just [Char]
msg -> forall a. [Char] -> IO a
throw forall a b. (a -> b) -> a -> b
$ [Char]
caller forall a. [a] -> [a] -> [a]
++ [Char]
": " 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 forall a b. IO a -> IO b -> IO a
`Exception.finally` 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 = forall a. ByteString -> (CString -> IO a) -> IO a
ByteString.useAsCString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Encoding.encodeUtf8