{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ > 707
{-# LANGUAGE AllowAmbiguousTypes #-}
#endif

module Git.Types where

import           Conduit
import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.Fail (MonadFail)
import           Control.Monad.Trans.State
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as BL
import           Data.HashMap.Strict (HashMap)
import           Data.Hashable
import           Data.Map (Map)
import           Data.Semigroup
import           Data.Tagged
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import           Data.Time
import           Data.Typeable

type RawFilePath = ByteString

data RepositoryFacts = RepositoryFacts
    { RepositoryFacts -> Bool
hasSymbolicReferences :: !Bool
    } deriving Int -> RepositoryFacts -> ShowS
[RepositoryFacts] -> ShowS
RepositoryFacts -> String
(Int -> RepositoryFacts -> ShowS)
-> (RepositoryFacts -> String)
-> ([RepositoryFacts] -> ShowS)
-> Show RepositoryFacts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepositoryFacts] -> ShowS
$cshowList :: [RepositoryFacts] -> ShowS
show :: RepositoryFacts -> String
$cshow :: RepositoryFacts -> String
showsPrec :: Int -> RepositoryFacts -> ShowS
$cshowsPrec :: Int -> RepositoryFacts -> ShowS
Show

type RefName       = Text
type CommitAuthor  = Text
type CommitEmail   = Text
type CommitMessage = Text
type TreeFilePath  = RawFilePath

-- | 'Repository' is the central point of contact between user code and Git
--   data objects.  Every object must belong to some repository.
class (Applicative m, Monad m, MonadThrow m,
       IsOid (Oid r), Show (Oid r), Eq (Oid r), Ord (Oid r))
      => MonadGit r m | m -> r where
    type Oid r :: *
    data Tree r :: *
    data Options r :: *

    facts :: m RepositoryFacts
    parseOid :: Text -> m (Oid r)

    getRepository :: m r
    closeRepository :: m ()
    deleteRepository :: m ()

    -- References
    createReference :: RefName -> RefTarget r -> m ()
    lookupReference :: RefName -> m (Maybe (RefTarget r))
    updateReference :: RefName -> RefTarget r -> m ()
    deleteReference :: RefName -> m ()
    sourceReferences :: ConduitT i RefName m ()

    -- Object lookup
    lookupObject  :: Oid r -> m (Object r m)
    existsObject  :: Oid r -> m Bool
    sourceObjects :: Maybe (CommitOid r)    -- ^ A commit we may already have
                  -> CommitOid r            -- ^ The commit we need
                  -> Bool                   -- ^ Include commit trees also?
                  -> ConduitT i (ObjectOid r) m () -- ^ All the objects in between

    lookupCommit  :: CommitOid r -> m (Commit r)
    lookupTree    :: TreeOid r -> m (Tree r)
    lookupBlob    :: BlobOid r -> m (Blob r m)
    lookupTag     :: TagOid r -> m (Tag r)

    readIndex :: TreeT r m ()
    writeIndex :: TreeT r m ()

    -- Working with trees
    newTreeBuilder :: Maybe (Tree r) -> m (TreeBuilder r m)

    treeOid   :: Tree r -> m (TreeOid r)
    treeEntry :: Tree r -> TreeFilePath -> m (Maybe (TreeEntry r))
    sourceTreeEntries :: Tree r -> ConduitT i (TreeFilePath, TreeEntry r) m ()

    diffContentsWithTree :: ConduitT () (Either TreeFilePath ByteString) m ()
                         -> Tree r -> ConduitT i ByteString m ()

    -- Creating other objects
    hashContents :: BlobContents m -> m (BlobOid r)
    createBlob   :: BlobContents m -> m (BlobOid r)
    createCommit :: [CommitOid r] -> TreeOid r
                 -> Signature -> Signature -> CommitMessage -> Maybe RefName
                 -> m (Commit r)
    createTag :: CommitOid r -> Signature -> CommitMessage -> Text -> m (Tag r)

data RepositoryOptions = RepositoryOptions
    { RepositoryOptions -> String
repoPath       :: !FilePath
    , RepositoryOptions -> Maybe String
repoWorkingDir :: !(Maybe FilePath)
    , RepositoryOptions -> Bool
repoIsBare     :: !Bool
    , RepositoryOptions -> Bool
repoAutoCreate :: !Bool
    }

defaultRepositoryOptions :: RepositoryOptions
defaultRepositoryOptions :: RepositoryOptions
defaultRepositoryOptions = String -> Maybe String -> Bool -> Bool -> RepositoryOptions
RepositoryOptions String
"" Maybe String
forall a. Maybe a
Nothing Bool
False Bool
False

data RepositoryFactory n m r = RepositoryFactory
    { RepositoryFactory n m r -> RepositoryOptions -> m r
openRepository :: RepositoryOptions -> m r
    , RepositoryFactory n m r -> forall a. r -> n a -> m a
runRepository  :: forall a. r -> n a -> m a
    }

{- $oids -}
class IsOid o where
    renderOid :: o -> Text
    renderOid = Tagged Any o -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid (Tagged Any o -> Text) -> (o -> Tagged Any o) -> o -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> Tagged Any o
forall k (s :: k) b. b -> Tagged s b
Tagged

    renderObjOid :: Tagged a o -> Text
    renderObjOid = o -> Text
forall o. IsOid o => o -> Text
renderOid (o -> Text) -> (Tagged a o -> o) -> Tagged a o -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged a o -> o
forall k (s :: k) b. Tagged s b -> b
untag

type BlobOid r   = Tagged r (Oid r)
type TreeOid r   = Tagged (Tree r) (Oid r)
type CommitOid r = Tagged (Commit r) (Oid r)
type TagOid r    = Tagged (Tag r) (Oid r)

data ObjectOid r = BlobObjOid   !(BlobOid r)
                 | TreeObjOid   !(TreeOid r)
                 | CommitObjOid !(CommitOid r)
                 | TagObjOid    !(TagOid r)

parseObjOid :: MonadGit r m => forall o. Text -> m (Tagged o (Oid r))
parseObjOid :: forall o. Text -> m (Tagged o (Oid r))
parseObjOid Text
sha = Oid r -> Tagged o (Oid r)
forall k (s :: k) b. b -> Tagged s b
Tagged (Oid r -> Tagged o (Oid r)) -> m (Oid r) -> m (Tagged o (Oid r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (Oid r)
forall r (m :: * -> *). MonadGit r m => Text -> m (Oid r)
parseOid Text
sha

copyOid :: (MonadGit r m, MonadGit s n) => Oid r -> n (Oid s)
copyOid :: Oid r -> n (Oid s)
copyOid = Text -> n (Oid s)
forall r (m :: * -> *). MonadGit r m => Text -> m (Oid r)
parseOid (Text -> n (Oid s)) -> (Oid r -> Text) -> Oid r -> n (Oid s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Oid r -> Text
forall o. IsOid o => o -> Text
renderOid

newtype SHA = SHA { SHA -> ByteString
getSHA :: ByteString } deriving (SHA -> SHA -> Bool
(SHA -> SHA -> Bool) -> (SHA -> SHA -> Bool) -> Eq SHA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SHA -> SHA -> Bool
$c/= :: SHA -> SHA -> Bool
== :: SHA -> SHA -> Bool
$c== :: SHA -> SHA -> Bool
Eq, Eq SHA
Eq SHA
-> (SHA -> SHA -> Ordering)
-> (SHA -> SHA -> Bool)
-> (SHA -> SHA -> Bool)
-> (SHA -> SHA -> Bool)
-> (SHA -> SHA -> Bool)
-> (SHA -> SHA -> SHA)
-> (SHA -> SHA -> SHA)
-> Ord SHA
SHA -> SHA -> Bool
SHA -> SHA -> Ordering
SHA -> SHA -> SHA
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 :: SHA -> SHA -> SHA
$cmin :: SHA -> SHA -> SHA
max :: SHA -> SHA -> SHA
$cmax :: SHA -> SHA -> SHA
>= :: SHA -> SHA -> Bool
$c>= :: SHA -> SHA -> Bool
> :: SHA -> SHA -> Bool
$c> :: SHA -> SHA -> Bool
<= :: SHA -> SHA -> Bool
$c<= :: SHA -> SHA -> Bool
< :: SHA -> SHA -> Bool
$c< :: SHA -> SHA -> Bool
compare :: SHA -> SHA -> Ordering
$ccompare :: SHA -> SHA -> Ordering
$cp1Ord :: Eq SHA
Ord, ReadPrec [SHA]
ReadPrec SHA
Int -> ReadS SHA
ReadS [SHA]
(Int -> ReadS SHA)
-> ReadS [SHA] -> ReadPrec SHA -> ReadPrec [SHA] -> Read SHA
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SHA]
$creadListPrec :: ReadPrec [SHA]
readPrec :: ReadPrec SHA
$creadPrec :: ReadPrec SHA
readList :: ReadS [SHA]
$creadList :: ReadS [SHA]
readsPrec :: Int -> ReadS SHA
$creadsPrec :: Int -> ReadS SHA
Read)

shaToText :: SHA -> Text
shaToText :: SHA -> Text
shaToText (SHA ByteString
bs) = ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
B16.encode ByteString
bs)

textToSha :: MonadFail m => Text -> m SHA
textToSha :: Text -> m SHA
textToSha Text
t =
    case ByteString -> Either String ByteString
B16.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
t of
        Right ByteString
bs -> SHA -> m SHA
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> SHA
SHA ByteString
bs)
        Left String
err -> String -> m SHA
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m SHA) -> String -> m SHA
forall a b. (a -> b) -> a -> b
$ String
"Invalid base16 encoding: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err

instance IsOid SHA where
    renderOid :: SHA -> Text
renderOid = SHA -> Text
shaToText

instance Show SHA where
    show :: SHA -> String
show = Text -> String
T.unpack (Text -> String) -> (SHA -> Text) -> SHA -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA -> Text
shaToText

instance Hashable SHA where
    hashWithSalt :: Int -> SHA -> Int
hashWithSalt Int
salt (SHA ByteString
bs) = Int -> ByteString -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt ByteString
bs

{- $blobs -}
data Blob r m = Blob
    { Blob r m -> BlobOid r
blobOid      :: !(BlobOid r)
    , Blob r m -> BlobContents m
blobContents :: !(BlobContents m)
    }

type ByteSource m = ConduitT () ByteString m ()

data BlobContents m = BlobString !ByteString
                    | BlobStringLazy !BL.ByteString
                    | BlobStream !(ByteSource m)
                    | BlobSizedStream !(ByteSource m) !Int

data BlobKind = PlainBlob | ExecutableBlob | SymlinkBlob
              deriving (Int -> BlobKind -> ShowS
[BlobKind] -> ShowS
BlobKind -> String
(Int -> BlobKind -> ShowS)
-> (BlobKind -> String) -> ([BlobKind] -> ShowS) -> Show BlobKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlobKind] -> ShowS
$cshowList :: [BlobKind] -> ShowS
show :: BlobKind -> String
$cshow :: BlobKind -> String
showsPrec :: Int -> BlobKind -> ShowS
$cshowsPrec :: Int -> BlobKind -> ShowS
Show, BlobKind -> BlobKind -> Bool
(BlobKind -> BlobKind -> Bool)
-> (BlobKind -> BlobKind -> Bool) -> Eq BlobKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlobKind -> BlobKind -> Bool
$c/= :: BlobKind -> BlobKind -> Bool
== :: BlobKind -> BlobKind -> Bool
$c== :: BlobKind -> BlobKind -> Bool
Eq, Int -> BlobKind
BlobKind -> Int
BlobKind -> [BlobKind]
BlobKind -> BlobKind
BlobKind -> BlobKind -> [BlobKind]
BlobKind -> BlobKind -> BlobKind -> [BlobKind]
(BlobKind -> BlobKind)
-> (BlobKind -> BlobKind)
-> (Int -> BlobKind)
-> (BlobKind -> Int)
-> (BlobKind -> [BlobKind])
-> (BlobKind -> BlobKind -> [BlobKind])
-> (BlobKind -> BlobKind -> [BlobKind])
-> (BlobKind -> BlobKind -> BlobKind -> [BlobKind])
-> Enum BlobKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BlobKind -> BlobKind -> BlobKind -> [BlobKind]
$cenumFromThenTo :: BlobKind -> BlobKind -> BlobKind -> [BlobKind]
enumFromTo :: BlobKind -> BlobKind -> [BlobKind]
$cenumFromTo :: BlobKind -> BlobKind -> [BlobKind]
enumFromThen :: BlobKind -> BlobKind -> [BlobKind]
$cenumFromThen :: BlobKind -> BlobKind -> [BlobKind]
enumFrom :: BlobKind -> [BlobKind]
$cenumFrom :: BlobKind -> [BlobKind]
fromEnum :: BlobKind -> Int
$cfromEnum :: BlobKind -> Int
toEnum :: Int -> BlobKind
$ctoEnum :: Int -> BlobKind
pred :: BlobKind -> BlobKind
$cpred :: BlobKind -> BlobKind
succ :: BlobKind -> BlobKind
$csucc :: BlobKind -> BlobKind
Enum)

instance Eq (BlobContents m) where
  BlobString ByteString
str1 == :: BlobContents m -> BlobContents m -> Bool
== BlobString ByteString
str2 = ByteString
str1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
str2
  BlobContents m
_ == BlobContents m
_ = Bool
False

{- $trees -}
newtype TreeT r m a = TreeT { TreeT r m a -> StateT (TreeBuilder r m) m a
runTreeT :: StateT (TreeBuilder r m) m a }

data TreeEntry r = BlobEntry   { TreeEntry r -> BlobOid r
blobEntryOid   :: !(BlobOid r)
                               , TreeEntry r -> BlobKind
blobEntryKind  :: !BlobKind }
                 | TreeEntry   { TreeEntry r -> TreeOid r
treeEntryOid   :: !(TreeOid r) }
                 | CommitEntry { TreeEntry r -> CommitOid r
commitEntryOid :: !(CommitOid r) }

-- instance Show (TreeEntry r) where
--     show (BlobEntry oid _) = "<BlobEntry " ++ show oid ++ ">"
--     show (TreeEntry oid)   = "<TreeEntry " ++ show oid ++ ">"
--     show (CommitEntry oid) = "<CommitEntry " ++ show oid ++ ">"

treeEntryToOid :: TreeEntry r -> Oid r
treeEntryToOid :: TreeEntry r -> Oid r
treeEntryToOid (BlobEntry BlobOid r
boid BlobKind
_) = BlobOid r -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag BlobOid r
boid
treeEntryToOid (TreeEntry TreeOid r
toid)   = TreeOid r -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag TreeOid r
toid
treeEntryToOid (CommitEntry CommitOid r
coid) = CommitOid r -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag CommitOid r
coid

data TreeBuilder r m = TreeBuilder
    { TreeBuilder r m -> Maybe (TreeOid r)
mtbBaseTreeOid    :: Maybe (TreeOid r)
    , TreeBuilder r m -> HashMap ByteString (TreeBuilder r m)
mtbPendingUpdates :: HashMap TreeFilePath (TreeBuilder r m)
    , TreeBuilder r m -> Maybe (Tree r) -> m (TreeBuilder r m)
mtbNewBuilder     :: Maybe (Tree r) -> m (TreeBuilder r m)
    , TreeBuilder r m
-> TreeBuilder r m -> m (ModifiedBuilder r m, TreeOid r)
mtbWriteContents  :: TreeBuilder r m -> m (ModifiedBuilder r m, TreeOid r)
    , TreeBuilder r m -> ByteString -> m (Maybe (TreeEntry r))
mtbLookupEntry    :: TreeFilePath -> m (Maybe (TreeEntry r))
    , TreeBuilder r m -> m Int
mtbEntryCount     :: m Int
    , TreeBuilder r m
-> TreeBuilder r m
-> ByteString
-> TreeEntry r
-> m (ModifiedBuilder r m)
mtbPutEntry       :: TreeBuilder r m -> TreeFilePath -> TreeEntry r
                        -> m (ModifiedBuilder r m)
    , TreeBuilder r m
-> TreeBuilder r m -> ByteString -> m (ModifiedBuilder r m)
mtbDropEntry      :: TreeBuilder r m -> TreeFilePath
                        -> m (ModifiedBuilder r m)
    }

data ModifiedBuilder r m = ModifiedBuilder (TreeBuilder r m)
                         | BuilderUnchanged (TreeBuilder r m)

instance Semigroup (ModifiedBuilder r m) where
    BuilderUnchanged TreeBuilder r m
_  <> :: ModifiedBuilder r m -> ModifiedBuilder r m -> ModifiedBuilder r m
<> BuilderUnchanged TreeBuilder r m
b2 = TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
BuilderUnchanged TreeBuilder r m
b2
    ModifiedBuilder TreeBuilder r m
b1  <> BuilderUnchanged TreeBuilder r m
_  = TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
ModifiedBuilder TreeBuilder r m
b1
    BuilderUnchanged TreeBuilder r m
_  <> ModifiedBuilder TreeBuilder r m
b2  = TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
ModifiedBuilder TreeBuilder r m
b2
    ModifiedBuilder TreeBuilder r m
_   <> ModifiedBuilder TreeBuilder r m
b2  = TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
ModifiedBuilder TreeBuilder r m
b2

instance Monoid (ModifiedBuilder r m) where
    mempty :: ModifiedBuilder r m
mempty = TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
BuilderUnchanged (String -> TreeBuilder r m
forall a. HasCallStack => String -> a
error String
"ModifiedBuilder is a semigroup")
    ModifiedBuilder r m
x mappend :: ModifiedBuilder r m -> ModifiedBuilder r m -> ModifiedBuilder r m
`mappend` ModifiedBuilder r m
y = ModifiedBuilder r m
x ModifiedBuilder r m -> ModifiedBuilder r m -> ModifiedBuilder r m
forall a. Semigroup a => a -> a -> a
<> ModifiedBuilder r m
y

fromBuilderMod :: ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod :: ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod (BuilderUnchanged TreeBuilder r m
tb) = TreeBuilder r m
tb
fromBuilderMod (ModifiedBuilder TreeBuilder r m
tb)  = TreeBuilder r m
tb

{- $commits -}
data Commit r = Commit
    { Commit r -> CommitOid r
commitOid       :: !(CommitOid r)
    , Commit r -> [CommitOid r]
commitParents   :: ![CommitOid r]
    , Commit r -> TreeOid r
commitTree      :: !(TreeOid r)
    , Commit r -> Signature
commitAuthor    :: !Signature
    , Commit r -> Signature
commitCommitter :: !Signature
    , Commit r -> Text
commitLog       :: !CommitMessage
    , Commit r -> Text
commitEncoding  :: !Text
    }

sourceCommitParents :: MonadGit r m => Commit r -> ConduitT i (Commit r) m ()
sourceCommitParents :: Commit r -> ConduitT i (Commit r) m ()
sourceCommitParents Commit r
commit =
    [Tagged (Commit r) (Oid r)]
-> (Tagged (Commit r) (Oid r) -> ConduitT i (Commit r) m ())
-> ConduitT i (Commit r) m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Commit r -> [Tagged (Commit r) (Oid r)]
forall r. Commit r -> [CommitOid r]
commitParents Commit r
commit) ((Tagged (Commit r) (Oid r) -> ConduitT i (Commit r) m ())
 -> ConduitT i (Commit r) m ())
-> (Tagged (Commit r) (Oid r) -> ConduitT i (Commit r) m ())
-> ConduitT i (Commit r) m ()
forall a b. (a -> b) -> a -> b
$ Commit r -> ConduitT i (Commit r) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Commit r -> ConduitT i (Commit r) m ())
-> (Tagged (Commit r) (Oid r)
    -> ConduitT i (Commit r) m (Commit r))
-> Tagged (Commit r) (Oid r)
-> ConduitT i (Commit r) m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< m (Commit r) -> ConduitT i (Commit r) m (Commit r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Commit r) -> ConduitT i (Commit r) m (Commit r))
-> (Tagged (Commit r) (Oid r) -> m (Commit r))
-> Tagged (Commit r) (Oid r)
-> ConduitT i (Commit r) m (Commit r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged (Commit r) (Oid r) -> m (Commit r)
forall r (m :: * -> *). MonadGit r m => CommitOid r -> m (Commit r)
lookupCommit

lookupCommitParents :: MonadGit r m => Commit r -> m [Commit r]
lookupCommitParents :: Commit r -> m [Commit r]
lookupCommitParents Commit r
commit = ConduitT () Void m [Commit r] -> m [Commit r]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m [Commit r] -> m [Commit r])
-> ConduitT () Void m [Commit r] -> m [Commit r]
forall a b. (a -> b) -> a -> b
$ Commit r -> ConduitT () (Commit r) m ()
forall r (m :: * -> *) i.
MonadGit r m =>
Commit r -> ConduitT i (Commit r) m ()
sourceCommitParents Commit r
commit ConduitT () (Commit r) m ()
-> ConduitM (Commit r) Void m [Commit r]
-> ConduitT () Void m [Commit r]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Commit r) Void m [Commit r]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList

data Signature = Signature
    { Signature -> Text
signatureName  :: !CommitAuthor
    , Signature -> Text
signatureEmail :: !CommitEmail
    , Signature -> ZonedTime
signatureWhen  :: !ZonedTime
    } deriving Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show

defaultSignature :: Signature
defaultSignature :: Signature
defaultSignature = Signature :: Text -> Text -> ZonedTime -> Signature
Signature
    { signatureName :: Text
signatureName  = Text
T.empty
    , signatureEmail :: Text
signatureEmail = Text
T.empty
    , signatureWhen :: ZonedTime
signatureWhen  = ZonedTime :: LocalTime -> TimeZone -> ZonedTime
ZonedTime
        { zonedTimeToLocalTime :: LocalTime
zonedTimeToLocalTime = LocalTime :: Day -> TimeOfDay -> LocalTime
LocalTime
            { localDay :: Day
localDay = Integer -> Day
ModifiedJulianDay Integer
0
            , localTimeOfDay :: TimeOfDay
localTimeOfDay = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0
            }
        , zonedTimeZone :: TimeZone
zonedTimeZone = TimeZone
utc
        }
    }

{- $tags -}
data Tag r = Tag
    { Tag r -> TagOid r
tagOid    :: !(TagOid r)
    , Tag r -> CommitOid r
tagCommit :: !(CommitOid r)
    }

{- $objects -}
data Object r m = BlobObj   !(Blob r m)
                | TreeObj   !(Tree r)
                | CommitObj !(Commit r)
                | TagObj    !(Tag r)

objectOid :: MonadGit r m => Object r m -> m (Oid r)
objectOid :: Object r m -> m (Oid r)
objectOid (BlobObj Blob r m
obj)   = Oid r -> m (Oid r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid r -> m (Oid r)) -> Oid r -> m (Oid r)
forall a b. (a -> b) -> a -> b
$ Tagged r (Oid r) -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag (Blob r m -> Tagged r (Oid r)
forall r (m :: * -> *). Blob r m -> BlobOid r
blobOid Blob r m
obj)
objectOid (TreeObj Tree r
obj)   = Tagged (Tree r) (Oid r) -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag (Tagged (Tree r) (Oid r) -> Oid r)
-> m (Tagged (Tree r) (Oid r)) -> m (Oid r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree r -> m (Tagged (Tree r) (Oid r))
forall r (m :: * -> *). MonadGit r m => Tree r -> m (TreeOid r)
treeOid Tree r
obj
objectOid (CommitObj Commit r
obj) = Oid r -> m (Oid r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid r -> m (Oid r)) -> Oid r -> m (Oid r)
forall a b. (a -> b) -> a -> b
$ Tagged (Commit r) (Oid r) -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag (Commit r -> Tagged (Commit r) (Oid r)
forall r. Commit r -> CommitOid r
commitOid Commit r
obj)
objectOid (TagObj Tag r
obj)    = Oid r -> m (Oid r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid r -> m (Oid r)) -> Oid r -> m (Oid r)
forall a b. (a -> b) -> a -> b
$ Tagged (Tag r) (Oid r) -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag (Tag r -> Tagged (Tag r) (Oid r)
forall r. Tag r -> TagOid r
tagOid Tag r
obj)

loadObject :: MonadGit r m => ObjectOid r -> m (Object r m)
loadObject :: ObjectOid r -> m (Object r m)
loadObject (BlobObjOid BlobOid r
oid)   = Blob r m -> Object r m
forall r (m :: * -> *). Blob r m -> Object r m
BlobObj   (Blob r m -> Object r m) -> m (Blob r m) -> m (Object r m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlobOid r -> m (Blob r m)
forall r (m :: * -> *). MonadGit r m => BlobOid r -> m (Blob r m)
lookupBlob BlobOid r
oid
loadObject (TreeObjOid TreeOid r
oid)   = Tree r -> Object r m
forall r (m :: * -> *). Tree r -> Object r m
TreeObj   (Tree r -> Object r m) -> m (Tree r) -> m (Object r m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeOid r -> m (Tree r)
forall r (m :: * -> *). MonadGit r m => TreeOid r -> m (Tree r)
lookupTree TreeOid r
oid
loadObject (CommitObjOid CommitOid r
oid) = Commit r -> Object r m
forall r (m :: * -> *). Commit r -> Object r m
CommitObj (Commit r -> Object r m) -> m (Commit r) -> m (Object r m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CommitOid r -> m (Commit r)
forall r (m :: * -> *). MonadGit r m => CommitOid r -> m (Commit r)
lookupCommit CommitOid r
oid
loadObject (TagObjOid TagOid r
oid)    = Tag r -> Object r m
forall r (m :: * -> *). Tag r -> Object r m
TagObj    (Tag r -> Object r m) -> m (Tag r) -> m (Object r m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TagOid r -> m (Tag r)
forall r (m :: * -> *). MonadGit r m => TagOid r -> m (Tag r)
lookupTag TagOid r
oid

objectToObjOid :: MonadGit r m => Object r m -> m (ObjectOid r)
objectToObjOid :: Object r m -> m (ObjectOid r)
objectToObjOid (BlobObj Blob r m
obj)   = ObjectOid r -> m (ObjectOid r)
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjectOid r -> m (ObjectOid r)) -> ObjectOid r -> m (ObjectOid r)
forall a b. (a -> b) -> a -> b
$ BlobOid r -> ObjectOid r
forall r. BlobOid r -> ObjectOid r
BlobObjOid (Blob r m -> BlobOid r
forall r (m :: * -> *). Blob r m -> BlobOid r
blobOid Blob r m
obj)
objectToObjOid (TreeObj Tree r
obj)   = Tagged (Tree r) (Oid r) -> ObjectOid r
forall r. TreeOid r -> ObjectOid r
TreeObjOid (Tagged (Tree r) (Oid r) -> ObjectOid r)
-> m (Tagged (Tree r) (Oid r)) -> m (ObjectOid r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree r -> m (Tagged (Tree r) (Oid r))
forall r (m :: * -> *). MonadGit r m => Tree r -> m (TreeOid r)
treeOid Tree r
obj
objectToObjOid (CommitObj Commit r
obj) = ObjectOid r -> m (ObjectOid r)
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjectOid r -> m (ObjectOid r)) -> ObjectOid r -> m (ObjectOid r)
forall a b. (a -> b) -> a -> b
$ CommitOid r -> ObjectOid r
forall r. CommitOid r -> ObjectOid r
CommitObjOid (Commit r -> CommitOid r
forall r. Commit r -> CommitOid r
commitOid Commit r
obj)
objectToObjOid (TagObj Tag r
obj)    = ObjectOid r -> m (ObjectOid r)
forall (m :: * -> *) a. Monad m => a -> m a
return (ObjectOid r -> m (ObjectOid r)) -> ObjectOid r -> m (ObjectOid r)
forall a b. (a -> b) -> a -> b
$ TagOid r -> ObjectOid r
forall r. TagOid r -> ObjectOid r
TagObjOid (Tag r -> TagOid r
forall r. Tag r -> TagOid r
tagOid Tag r
obj)

untagObjOid :: ObjectOid r -> Oid r
untagObjOid :: ObjectOid r -> Oid r
untagObjOid (BlobObjOid BlobOid r
oid)   = BlobOid r -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag BlobOid r
oid
untagObjOid (TreeObjOid TreeOid r
oid)   = TreeOid r -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag TreeOid r
oid
untagObjOid (CommitObjOid CommitOid r
oid) = CommitOid r -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag CommitOid r
oid
untagObjOid (TagObjOid TagOid r
oid)    = TagOid r -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag TagOid r
oid

{- $references -}
data RefTarget (r :: *) = RefObj !(Oid r) | RefSymbolic !RefName

-- instance Show (RefTarget r) where
--     show (RefObj oid) = "RefObj#" ++ T.unpack (renderOid oid)
--     show (RefSymbolic name) = "RefSymbolic#" ++ T.unpack name

commitRefTarget :: Commit r -> RefTarget r
commitRefTarget :: Commit r -> RefTarget r
commitRefTarget = Oid r -> RefTarget r
forall r. Oid r -> RefTarget r
RefObj (Oid r -> RefTarget r)
-> (Commit r -> Oid r) -> Commit r -> RefTarget r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged (Commit r) (Oid r) -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag (Tagged (Commit r) (Oid r) -> Oid r)
-> (Commit r -> Tagged (Commit r) (Oid r)) -> Commit r -> Oid r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commit r -> Tagged (Commit r) (Oid r)
forall r. Commit r -> CommitOid r
commitOid

{- $merges -}
data ModificationKind = Unchanged | Modified | Added | Deleted | TypeChanged
                      deriving (ModificationKind -> ModificationKind -> Bool
(ModificationKind -> ModificationKind -> Bool)
-> (ModificationKind -> ModificationKind -> Bool)
-> Eq ModificationKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModificationKind -> ModificationKind -> Bool
$c/= :: ModificationKind -> ModificationKind -> Bool
== :: ModificationKind -> ModificationKind -> Bool
$c== :: ModificationKind -> ModificationKind -> Bool
Eq, Eq ModificationKind
Eq ModificationKind
-> (ModificationKind -> ModificationKind -> Ordering)
-> (ModificationKind -> ModificationKind -> Bool)
-> (ModificationKind -> ModificationKind -> Bool)
-> (ModificationKind -> ModificationKind -> Bool)
-> (ModificationKind -> ModificationKind -> Bool)
-> (ModificationKind -> ModificationKind -> ModificationKind)
-> (ModificationKind -> ModificationKind -> ModificationKind)
-> Ord ModificationKind
ModificationKind -> ModificationKind -> Bool
ModificationKind -> ModificationKind -> Ordering
ModificationKind -> ModificationKind -> ModificationKind
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 :: ModificationKind -> ModificationKind -> ModificationKind
$cmin :: ModificationKind -> ModificationKind -> ModificationKind
max :: ModificationKind -> ModificationKind -> ModificationKind
$cmax :: ModificationKind -> ModificationKind -> ModificationKind
>= :: ModificationKind -> ModificationKind -> Bool
$c>= :: ModificationKind -> ModificationKind -> Bool
> :: ModificationKind -> ModificationKind -> Bool
$c> :: ModificationKind -> ModificationKind -> Bool
<= :: ModificationKind -> ModificationKind -> Bool
$c<= :: ModificationKind -> ModificationKind -> Bool
< :: ModificationKind -> ModificationKind -> Bool
$c< :: ModificationKind -> ModificationKind -> Bool
compare :: ModificationKind -> ModificationKind -> Ordering
$ccompare :: ModificationKind -> ModificationKind -> Ordering
$cp1Ord :: Eq ModificationKind
Ord, Int -> ModificationKind
ModificationKind -> Int
ModificationKind -> [ModificationKind]
ModificationKind -> ModificationKind
ModificationKind -> ModificationKind -> [ModificationKind]
ModificationKind
-> ModificationKind -> ModificationKind -> [ModificationKind]
(ModificationKind -> ModificationKind)
-> (ModificationKind -> ModificationKind)
-> (Int -> ModificationKind)
-> (ModificationKind -> Int)
-> (ModificationKind -> [ModificationKind])
-> (ModificationKind -> ModificationKind -> [ModificationKind])
-> (ModificationKind -> ModificationKind -> [ModificationKind])
-> (ModificationKind
    -> ModificationKind -> ModificationKind -> [ModificationKind])
-> Enum ModificationKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModificationKind
-> ModificationKind -> ModificationKind -> [ModificationKind]
$cenumFromThenTo :: ModificationKind
-> ModificationKind -> ModificationKind -> [ModificationKind]
enumFromTo :: ModificationKind -> ModificationKind -> [ModificationKind]
$cenumFromTo :: ModificationKind -> ModificationKind -> [ModificationKind]
enumFromThen :: ModificationKind -> ModificationKind -> [ModificationKind]
$cenumFromThen :: ModificationKind -> ModificationKind -> [ModificationKind]
enumFrom :: ModificationKind -> [ModificationKind]
$cenumFrom :: ModificationKind -> [ModificationKind]
fromEnum :: ModificationKind -> Int
$cfromEnum :: ModificationKind -> Int
toEnum :: Int -> ModificationKind
$ctoEnum :: Int -> ModificationKind
pred :: ModificationKind -> ModificationKind
$cpred :: ModificationKind -> ModificationKind
succ :: ModificationKind -> ModificationKind
$csucc :: ModificationKind -> ModificationKind
Enum, Int -> ModificationKind -> ShowS
[ModificationKind] -> ShowS
ModificationKind -> String
(Int -> ModificationKind -> ShowS)
-> (ModificationKind -> String)
-> ([ModificationKind] -> ShowS)
-> Show ModificationKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModificationKind] -> ShowS
$cshowList :: [ModificationKind] -> ShowS
show :: ModificationKind -> String
$cshow :: ModificationKind -> String
showsPrec :: Int -> ModificationKind -> ShowS
$cshowsPrec :: Int -> ModificationKind -> ShowS
Show, ReadPrec [ModificationKind]
ReadPrec ModificationKind
Int -> ReadS ModificationKind
ReadS [ModificationKind]
(Int -> ReadS ModificationKind)
-> ReadS [ModificationKind]
-> ReadPrec ModificationKind
-> ReadPrec [ModificationKind]
-> Read ModificationKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModificationKind]
$creadListPrec :: ReadPrec [ModificationKind]
readPrec :: ReadPrec ModificationKind
$creadPrec :: ReadPrec ModificationKind
readList :: ReadS [ModificationKind]
$creadList :: ReadS [ModificationKind]
readsPrec :: Int -> ReadS ModificationKind
$creadsPrec :: Int -> ReadS ModificationKind
Read)

data MergeStatus
    = NoConflict
    | BothModified
    | LeftModifiedRightDeleted
    | LeftDeletedRightModified
    | BothAdded
    | LeftModifiedRightTypeChanged
    | LeftTypeChangedRightModified
    | LeftDeletedRightTypeChanged
    | LeftTypeChangedRightDeleted
    | BothTypeChanged
    deriving (MergeStatus -> MergeStatus -> Bool
(MergeStatus -> MergeStatus -> Bool)
-> (MergeStatus -> MergeStatus -> Bool) -> Eq MergeStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergeStatus -> MergeStatus -> Bool
$c/= :: MergeStatus -> MergeStatus -> Bool
== :: MergeStatus -> MergeStatus -> Bool
$c== :: MergeStatus -> MergeStatus -> Bool
Eq, Eq MergeStatus
Eq MergeStatus
-> (MergeStatus -> MergeStatus -> Ordering)
-> (MergeStatus -> MergeStatus -> Bool)
-> (MergeStatus -> MergeStatus -> Bool)
-> (MergeStatus -> MergeStatus -> Bool)
-> (MergeStatus -> MergeStatus -> Bool)
-> (MergeStatus -> MergeStatus -> MergeStatus)
-> (MergeStatus -> MergeStatus -> MergeStatus)
-> Ord MergeStatus
MergeStatus -> MergeStatus -> Bool
MergeStatus -> MergeStatus -> Ordering
MergeStatus -> MergeStatus -> MergeStatus
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 :: MergeStatus -> MergeStatus -> MergeStatus
$cmin :: MergeStatus -> MergeStatus -> MergeStatus
max :: MergeStatus -> MergeStatus -> MergeStatus
$cmax :: MergeStatus -> MergeStatus -> MergeStatus
>= :: MergeStatus -> MergeStatus -> Bool
$c>= :: MergeStatus -> MergeStatus -> Bool
> :: MergeStatus -> MergeStatus -> Bool
$c> :: MergeStatus -> MergeStatus -> Bool
<= :: MergeStatus -> MergeStatus -> Bool
$c<= :: MergeStatus -> MergeStatus -> Bool
< :: MergeStatus -> MergeStatus -> Bool
$c< :: MergeStatus -> MergeStatus -> Bool
compare :: MergeStatus -> MergeStatus -> Ordering
$ccompare :: MergeStatus -> MergeStatus -> Ordering
$cp1Ord :: Eq MergeStatus
Ord, Int -> MergeStatus
MergeStatus -> Int
MergeStatus -> [MergeStatus]
MergeStatus -> MergeStatus
MergeStatus -> MergeStatus -> [MergeStatus]
MergeStatus -> MergeStatus -> MergeStatus -> [MergeStatus]
(MergeStatus -> MergeStatus)
-> (MergeStatus -> MergeStatus)
-> (Int -> MergeStatus)
-> (MergeStatus -> Int)
-> (MergeStatus -> [MergeStatus])
-> (MergeStatus -> MergeStatus -> [MergeStatus])
-> (MergeStatus -> MergeStatus -> [MergeStatus])
-> (MergeStatus -> MergeStatus -> MergeStatus -> [MergeStatus])
-> Enum MergeStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MergeStatus -> MergeStatus -> MergeStatus -> [MergeStatus]
$cenumFromThenTo :: MergeStatus -> MergeStatus -> MergeStatus -> [MergeStatus]
enumFromTo :: MergeStatus -> MergeStatus -> [MergeStatus]
$cenumFromTo :: MergeStatus -> MergeStatus -> [MergeStatus]
enumFromThen :: MergeStatus -> MergeStatus -> [MergeStatus]
$cenumFromThen :: MergeStatus -> MergeStatus -> [MergeStatus]
enumFrom :: MergeStatus -> [MergeStatus]
$cenumFrom :: MergeStatus -> [MergeStatus]
fromEnum :: MergeStatus -> Int
$cfromEnum :: MergeStatus -> Int
toEnum :: Int -> MergeStatus
$ctoEnum :: Int -> MergeStatus
pred :: MergeStatus -> MergeStatus
$cpred :: MergeStatus -> MergeStatus
succ :: MergeStatus -> MergeStatus
$csucc :: MergeStatus -> MergeStatus
Enum, Int -> MergeStatus -> ShowS
[MergeStatus] -> ShowS
MergeStatus -> String
(Int -> MergeStatus -> ShowS)
-> (MergeStatus -> String)
-> ([MergeStatus] -> ShowS)
-> Show MergeStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergeStatus] -> ShowS
$cshowList :: [MergeStatus] -> ShowS
show :: MergeStatus -> String
$cshow :: MergeStatus -> String
showsPrec :: Int -> MergeStatus -> ShowS
$cshowsPrec :: Int -> MergeStatus -> ShowS
Show, ReadPrec [MergeStatus]
ReadPrec MergeStatus
Int -> ReadS MergeStatus
ReadS [MergeStatus]
(Int -> ReadS MergeStatus)
-> ReadS [MergeStatus]
-> ReadPrec MergeStatus
-> ReadPrec [MergeStatus]
-> Read MergeStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MergeStatus]
$creadListPrec :: ReadPrec [MergeStatus]
readPrec :: ReadPrec MergeStatus
$creadPrec :: ReadPrec MergeStatus
readList :: ReadS [MergeStatus]
$creadList :: ReadS [MergeStatus]
readsPrec :: Int -> ReadS MergeStatus
$creadsPrec :: Int -> ReadS MergeStatus
Read)

mergeStatus :: ModificationKind -> ModificationKind -> MergeStatus
mergeStatus :: ModificationKind -> ModificationKind -> MergeStatus
mergeStatus ModificationKind
Unchanged ModificationKind
Unchanged     = MergeStatus
NoConflict
mergeStatus ModificationKind
Unchanged ModificationKind
Modified      = MergeStatus
NoConflict
mergeStatus ModificationKind
Unchanged ModificationKind
Added         = MergeStatus
forall a. HasCallStack => a
undefined
mergeStatus ModificationKind
Unchanged ModificationKind
Deleted       = MergeStatus
NoConflict
mergeStatus ModificationKind
Unchanged ModificationKind
TypeChanged   = MergeStatus
NoConflict

mergeStatus ModificationKind
Modified ModificationKind
Unchanged      = MergeStatus
NoConflict
mergeStatus ModificationKind
Modified ModificationKind
Modified       = MergeStatus
BothModified
mergeStatus ModificationKind
Modified ModificationKind
Added          = MergeStatus
forall a. HasCallStack => a
undefined
mergeStatus ModificationKind
Modified ModificationKind
Deleted        = MergeStatus
LeftModifiedRightDeleted
mergeStatus ModificationKind
Modified ModificationKind
TypeChanged    = MergeStatus
LeftModifiedRightTypeChanged

mergeStatus ModificationKind
Added ModificationKind
Unchanged         = MergeStatus
forall a. HasCallStack => a
undefined
mergeStatus ModificationKind
Added ModificationKind
Modified          = MergeStatus
forall a. HasCallStack => a
undefined
mergeStatus ModificationKind
Added ModificationKind
Added             = MergeStatus
BothAdded
mergeStatus ModificationKind
Added ModificationKind
Deleted           = MergeStatus
forall a. HasCallStack => a
undefined
mergeStatus ModificationKind
Added ModificationKind
TypeChanged       = MergeStatus
forall a. HasCallStack => a
undefined

mergeStatus ModificationKind
Deleted ModificationKind
Unchanged       = MergeStatus
NoConflict
mergeStatus ModificationKind
Deleted ModificationKind
Modified        = MergeStatus
LeftDeletedRightModified
mergeStatus ModificationKind
Deleted ModificationKind
Added           = MergeStatus
forall a. HasCallStack => a
undefined
mergeStatus ModificationKind
Deleted ModificationKind
Deleted         = MergeStatus
NoConflict
mergeStatus ModificationKind
Deleted ModificationKind
TypeChanged     = MergeStatus
LeftDeletedRightTypeChanged

mergeStatus ModificationKind
TypeChanged ModificationKind
Unchanged   = MergeStatus
NoConflict
mergeStatus ModificationKind
TypeChanged ModificationKind
Modified    = MergeStatus
LeftTypeChangedRightModified
mergeStatus ModificationKind
TypeChanged ModificationKind
Added       = MergeStatus
forall a. HasCallStack => a
undefined
mergeStatus ModificationKind
TypeChanged ModificationKind
Deleted     = MergeStatus
LeftTypeChangedRightDeleted
mergeStatus ModificationKind
TypeChanged ModificationKind
TypeChanged = MergeStatus
BothTypeChanged

data MergeResult r
    = MergeSuccess
        { MergeResult r -> CommitOid r
mergeCommit    :: CommitOid r
        }
    | MergeConflicted
        { mergeCommit    :: CommitOid r
        , MergeResult r -> CommitOid r
mergeHeadLeft  :: CommitOid r
        , MergeResult r -> CommitOid r
mergeHeadRight :: CommitOid r
        , MergeResult r
-> Map ByteString (ModificationKind, ModificationKind)
mergeConflicts ::
            Map TreeFilePath (ModificationKind, ModificationKind)
        }

copyMergeResult :: (MonadGit r m, IsOid (Oid s))
                => MergeResult s -> m (MergeResult r)
copyMergeResult :: MergeResult s -> m (MergeResult r)
copyMergeResult (MergeSuccess CommitOid s
mc) =
    Tagged (Commit r) (Oid r) -> MergeResult r
forall r. CommitOid r -> MergeResult r
MergeSuccess (Tagged (Commit r) (Oid r) -> MergeResult r)
-> m (Tagged (Commit r) (Oid r)) -> m (MergeResult r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (Tagged (Commit r) (Oid r))
forall r (m :: * -> *) o.
MonadGit r m =>
Text -> m (Tagged o (Oid r))
parseObjOid (CommitOid s -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid CommitOid s
mc)
copyMergeResult (MergeConflicted CommitOid s
hl CommitOid s
hr CommitOid s
mc Map ByteString (ModificationKind, ModificationKind)
cs) =
    Tagged (Commit r) (Oid r)
-> Tagged (Commit r) (Oid r)
-> Tagged (Commit r) (Oid r)
-> Map ByteString (ModificationKind, ModificationKind)
-> MergeResult r
forall r.
CommitOid r
-> CommitOid r
-> CommitOid r
-> Map ByteString (ModificationKind, ModificationKind)
-> MergeResult r
MergeConflicted (Tagged (Commit r) (Oid r)
 -> Tagged (Commit r) (Oid r)
 -> Tagged (Commit r) (Oid r)
 -> Map ByteString (ModificationKind, ModificationKind)
 -> MergeResult r)
-> m (Tagged (Commit r) (Oid r))
-> m (Tagged (Commit r) (Oid r)
      -> Tagged (Commit r) (Oid r)
      -> Map ByteString (ModificationKind, ModificationKind)
      -> MergeResult r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (Tagged (Commit r) (Oid r))
forall r (m :: * -> *) o.
MonadGit r m =>
Text -> m (Tagged o (Oid r))
parseObjOid (CommitOid s -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid CommitOid s
hl)
                    m (Tagged (Commit r) (Oid r)
   -> Tagged (Commit r) (Oid r)
   -> Map ByteString (ModificationKind, ModificationKind)
   -> MergeResult r)
-> m (Tagged (Commit r) (Oid r))
-> m (Tagged (Commit r) (Oid r)
      -> Map ByteString (ModificationKind, ModificationKind)
      -> MergeResult r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> m (Tagged (Commit r) (Oid r))
forall r (m :: * -> *) o.
MonadGit r m =>
Text -> m (Tagged o (Oid r))
parseObjOid (CommitOid s -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid CommitOid s
hr)
                    m (Tagged (Commit r) (Oid r)
   -> Map ByteString (ModificationKind, ModificationKind)
   -> MergeResult r)
-> m (Tagged (Commit r) (Oid r))
-> m (Map ByteString (ModificationKind, ModificationKind)
      -> MergeResult r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> m (Tagged (Commit r) (Oid r))
forall r (m :: * -> *) o.
MonadGit r m =>
Text -> m (Tagged o (Oid r))
parseObjOid (CommitOid s -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid CommitOid s
mc)
                    m (Map ByteString (ModificationKind, ModificationKind)
   -> MergeResult r)
-> m (Map ByteString (ModificationKind, ModificationKind))
-> m (MergeResult r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map ByteString (ModificationKind, ModificationKind)
-> m (Map ByteString (ModificationKind, ModificationKind))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map ByteString (ModificationKind, ModificationKind)
cs

-- instance Show (MergeResult r) where
--     show (MergeSuccess mc) =
--         "MergeSuccess (" ++ T.unpack (renderObjOid mc) ++ ")"
--     show (MergeConflicted mc hl hr cs) =
--         "MergeResult"
--      ++ "\n    { mergeCommit    = " ++ T.unpack (renderObjOid mc)
--      ++ "\n    , mergeHeadLeft  = " ++ T.unpack (renderObjOid hl)
--      ++ "\n    , mergeHeadRight = " ++ T.unpack (renderObjOid hr)
--      ++ "\n    , mergeConflicts = " ++ show cs
--      ++ "\n    }"

{- $exceptions -}
-- | There is a separate 'GitException' for each possible failure when
--   interacting with the Git repository.
data GitException
    = BackendError Text
    | GitError Text
    | RepositoryNotExist
    | RepositoryInvalid
    | RepositoryCannotAccess Text
    | BlobCreateFailed Text
    | BlobEmptyCreateFailed
    | BlobEncodingUnknown Text
    | BlobLookupFailed
    | DiffBlobFailed Text
    | DiffPrintToPatchFailed Text
    | DiffTreeToIndexFailed Text
    | IndexAddFailed TreeFilePath Text
    | IndexCreateFailed Text
    | PathEncodingError Text
    | PushNotFastForward Text
    | TagLookupFailed Text
    | TranslationException Text
    | TreeCreateFailed Text
    | TreeBuilderCreateFailed
    | TreeBuilderInsertFailed TreeFilePath
    | TreeBuilderRemoveFailed TreeFilePath
    | TreeBuilderWriteFailed Text
    | TreeLookupFailed
    | TreeCannotTraverseBlob
    | TreeCannotTraverseCommit
    | TreeEntryLookupFailed TreeFilePath
    | TreeUpdateFailed
    | TreeWalkFailed Text
    | TreeEmptyCreateFailed
    | CommitCreateFailed
    | CommitLookupFailed Text
    | ReferenceCreateFailed RefName
    | ReferenceDeleteFailed RefName
    | RefCannotCreateFromPartialOid
    | ReferenceListingFailed Text
    | ReferenceLookupFailed RefName
    | ObjectLookupFailed Text Int
    | ObjectRefRequiresFullOid
    | OidCopyFailed
    | OidParseFailed Text
    | QuotaHardLimitExceeded Int Int
    deriving (GitException -> GitException -> Bool
(GitException -> GitException -> Bool)
-> (GitException -> GitException -> Bool) -> Eq GitException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitException -> GitException -> Bool
$c/= :: GitException -> GitException -> Bool
== :: GitException -> GitException -> Bool
$c== :: GitException -> GitException -> Bool
Eq, Int -> GitException -> ShowS
[GitException] -> ShowS
GitException -> String
(Int -> GitException -> ShowS)
-> (GitException -> String)
-> ([GitException] -> ShowS)
-> Show GitException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitException] -> ShowS
$cshowList :: [GitException] -> ShowS
show :: GitException -> String
$cshow :: GitException -> String
showsPrec :: Int -> GitException -> ShowS
$cshowsPrec :: Int -> GitException -> ShowS
Show, Typeable)

-- jww (2013-02-11): Create a BackendException data constructor of forall
-- e. Exception e => BackendException e, so that each can throw a derived
-- exception.
instance Exception GitException