{-# OPTIONS_GHC -fno-warn-orphans #-}

module Git.Tree.Builder
       ( TreeT
       , TreeBuilder(..)
       , ModifiedBuilder(..)
       , createTree
       , withNewTree
       , mutateTree
       , mutateTreeOid
       , currentTree
       , currentTreeOid
       , withTree
       , withTreeOid
       , dropEntry
       , getEntry
       , putBlob
       , putBlob'
       , putCommit
       , putEntry
       , putTree
       , treeEntry
       , ModifyTreeResult(..)
       , fromModifyTreeResult
       , toModifyTreeResult
       , emptyTreeId
       ) where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Catch
import           Control.Monad.Fix
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.State
import qualified Data.ByteString as B
import           Data.Char
import qualified Data.HashMap.Strict as HashMap
import           Data.Monoid
import           Data.Text (Text)
import           Data.Word
import           Git.Types

data ModifyTreeResult r = TreeEntryNotFound
                        | TreeEntryDeleted
                        | TreeEntryPersistent (TreeEntry r)
                        | TreeEntryMutated (TreeEntry r)

fromModifyTreeResult :: ModifyTreeResult r -> Maybe (TreeEntry r)
fromModifyTreeResult :: ModifyTreeResult r -> Maybe (TreeEntry r)
fromModifyTreeResult ModifyTreeResult r
TreeEntryNotFound       = Maybe (TreeEntry r)
forall a. Maybe a
Nothing
fromModifyTreeResult ModifyTreeResult r
TreeEntryDeleted        = Maybe (TreeEntry r)
forall a. Maybe a
Nothing
fromModifyTreeResult (TreeEntryPersistent TreeEntry r
x) = TreeEntry r -> Maybe (TreeEntry r)
forall a. a -> Maybe a
Just TreeEntry r
x
fromModifyTreeResult (TreeEntryMutated TreeEntry r
x)    = TreeEntry r -> Maybe (TreeEntry r)
forall a. a -> Maybe a
Just TreeEntry r
x

toModifyTreeResult :: (TreeEntry r -> ModifyTreeResult r)
                   -> Maybe (TreeEntry r)
                   -> ModifyTreeResult r
toModifyTreeResult :: (TreeEntry r -> ModifyTreeResult r)
-> Maybe (TreeEntry r) -> ModifyTreeResult r
toModifyTreeResult TreeEntry r -> ModifyTreeResult r
_ Maybe (TreeEntry r)
Nothing  = ModifyTreeResult r
forall r. ModifyTreeResult r
TreeEntryNotFound
toModifyTreeResult TreeEntry r -> ModifyTreeResult r
f (Just TreeEntry r
x) = TreeEntry r -> ModifyTreeResult r
f TreeEntry r
x

instance Functor m => Functor (TreeT r m) where
    fmap :: (a -> b) -> TreeT r m a -> TreeT r m b
fmap a -> b
f (TreeT StateT (TreeBuilder r m) m a
t) = StateT (TreeBuilder r m) m b -> TreeT r m b
forall r (m :: * -> *) a.
StateT (TreeBuilder r m) m a -> TreeT r m a
TreeT ((a -> b)
-> StateT (TreeBuilder r m) m a -> StateT (TreeBuilder r m) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f StateT (TreeBuilder r m) m a
t)

instance Monad m => Monad (TreeT r m) where
    return :: a -> TreeT r m a
return a
x = StateT (TreeBuilder r m) m a -> TreeT r m a
forall r (m :: * -> *) a.
StateT (TreeBuilder r m) m a -> TreeT r m a
TreeT (a -> StateT (TreeBuilder r m) m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)
    TreeT StateT (TreeBuilder r m) m a
x >>= :: TreeT r m a -> (a -> TreeT r m b) -> TreeT r m b
>>= a -> TreeT r m b
f = StateT (TreeBuilder r m) m b -> TreeT r m b
forall r (m :: * -> *) a.
StateT (TreeBuilder r m) m a -> TreeT r m a
TreeT (StateT (TreeBuilder r m) m a
x StateT (TreeBuilder r m) m a
-> (a -> StateT (TreeBuilder r m) m b)
-> StateT (TreeBuilder r m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TreeT r m b -> StateT (TreeBuilder r m) m b
forall r (m :: * -> *) a.
TreeT r m a -> StateT (TreeBuilder r m) m a
runTreeT (TreeT r m b -> StateT (TreeBuilder r m) m b)
-> (a -> TreeT r m b) -> a -> StateT (TreeBuilder r m) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TreeT r m b
f)

instance (Functor m, Monad m) => Applicative (TreeT r m) where
    pure :: a -> TreeT r m a
pure = a -> TreeT r m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: TreeT r m (a -> b) -> TreeT r m a -> TreeT r m b
(<*>) = TreeT r m (a -> b) -> TreeT r m a -> TreeT r m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance (Functor m, MonadPlus m) => Alternative (TreeT r m) where
    empty :: TreeT r m a
empty = TreeT r m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: TreeT r m a -> TreeT r m a -> TreeT r m a
(<|>) = TreeT r m a -> TreeT r m a -> TreeT r m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance (MonadPlus m) => MonadPlus (TreeT r m) where
    mzero :: TreeT r m a
mzero       = StateT (TreeBuilder r m) m a -> TreeT r m a
forall r (m :: * -> *) a.
StateT (TreeBuilder r m) m a -> TreeT r m a
TreeT StateT (TreeBuilder r m) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    TreeT r m a
m mplus :: TreeT r m a -> TreeT r m a -> TreeT r m a
`mplus` TreeT r m a
n = StateT (TreeBuilder r m) m a -> TreeT r m a
forall r (m :: * -> *) a.
StateT (TreeBuilder r m) m a -> TreeT r m a
TreeT (StateT (TreeBuilder r m) m a -> TreeT r m a)
-> StateT (TreeBuilder r m) m a -> TreeT r m a
forall a b. (a -> b) -> a -> b
$ TreeT r m a -> StateT (TreeBuilder r m) m a
forall r (m :: * -> *) a.
TreeT r m a -> StateT (TreeBuilder r m) m a
runTreeT TreeT r m a
m StateT (TreeBuilder r m) m a
-> StateT (TreeBuilder r m) m a -> StateT (TreeBuilder r m) m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` TreeT r m a -> StateT (TreeBuilder r m) m a
forall r (m :: * -> *) a.
TreeT r m a -> StateT (TreeBuilder r m) m a
runTreeT TreeT r m a
n

instance (MonadFix m) => MonadFix (TreeT r m) where
    mfix :: (a -> TreeT r m a) -> TreeT r m a
mfix a -> TreeT r m a
f = StateT (TreeBuilder r m) m a -> TreeT r m a
forall r (m :: * -> *) a.
StateT (TreeBuilder r m) m a -> TreeT r m a
TreeT (StateT (TreeBuilder r m) m a -> TreeT r m a)
-> StateT (TreeBuilder r m) m a -> TreeT r m a
forall a b. (a -> b) -> a -> b
$ (a -> StateT (TreeBuilder r m) m a) -> StateT (TreeBuilder r m) m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((a -> StateT (TreeBuilder r m) m a)
 -> StateT (TreeBuilder r m) m a)
-> (a -> StateT (TreeBuilder r m) m a)
-> StateT (TreeBuilder r m) m a
forall a b. (a -> b) -> a -> b
$ \ ~a
a -> TreeT r m a -> StateT (TreeBuilder r m) m a
forall r (m :: * -> *) a.
TreeT r m a -> StateT (TreeBuilder r m) m a
runTreeT (a -> TreeT r m a
f a
a)

instance MonadTrans (TreeT r) where
    lift :: m a -> TreeT r m a
lift m a
m = StateT (TreeBuilder r m) m a -> TreeT r m a
forall r (m :: * -> *) a.
StateT (TreeBuilder r m) m a -> TreeT r m a
TreeT (StateT (TreeBuilder r m) m a -> TreeT r m a)
-> StateT (TreeBuilder r m) m a -> TreeT r m a
forall a b. (a -> b) -> a -> b
$ m a -> StateT (TreeBuilder r m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m

instance (MonadIO m) => MonadIO (TreeT r m) where
    liftIO :: IO a -> TreeT r m a
liftIO = m a -> TreeT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TreeT r m a) -> (IO a -> m a) -> IO a -> TreeT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

getBuilder :: Monad m => TreeT r m (TreeBuilder r m)
getBuilder :: TreeT r m (TreeBuilder r m)
getBuilder = StateT (TreeBuilder r m) m (TreeBuilder r m)
-> TreeT r m (TreeBuilder r m)
forall r (m :: * -> *) a.
StateT (TreeBuilder r m) m a -> TreeT r m a
TreeT StateT (TreeBuilder r m) m (TreeBuilder r m)
forall (m :: * -> *) s. Monad m => StateT s m s
get

putBuilder :: Monad m => TreeBuilder r m -> TreeT r m ()
putBuilder :: TreeBuilder r m -> TreeT r m ()
putBuilder = StateT (TreeBuilder r m) m () -> TreeT r m ()
forall r (m :: * -> *) a.
StateT (TreeBuilder r m) m a -> TreeT r m a
TreeT (StateT (TreeBuilder r m) m () -> TreeT r m ())
-> (TreeBuilder r m -> StateT (TreeBuilder r m) m ())
-> TreeBuilder r m
-> TreeT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeBuilder r m -> StateT (TreeBuilder r m) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put

data BuilderAction = GetEntry | PutEntry | DropEntry
    deriving (BuilderAction -> BuilderAction -> Bool
(BuilderAction -> BuilderAction -> Bool)
-> (BuilderAction -> BuilderAction -> Bool) -> Eq BuilderAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuilderAction -> BuilderAction -> Bool
$c/= :: BuilderAction -> BuilderAction -> Bool
== :: BuilderAction -> BuilderAction -> Bool
$c== :: BuilderAction -> BuilderAction -> Bool
Eq, Int -> BuilderAction -> ShowS
[BuilderAction] -> ShowS
BuilderAction -> String
(Int -> BuilderAction -> ShowS)
-> (BuilderAction -> String)
-> ([BuilderAction] -> ShowS)
-> Show BuilderAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuilderAction] -> ShowS
$cshowList :: [BuilderAction] -> ShowS
show :: BuilderAction -> String
$cshow :: BuilderAction -> String
showsPrec :: Int -> BuilderAction -> ShowS
$cshowsPrec :: Int -> BuilderAction -> ShowS
Show)

emptyTreeId :: Text
emptyTreeId :: Text
emptyTreeId = Text
"4b825dc642cb6eb9a060e54bf8d69288fbee4904"

-- | Perform a query action on a TreeBuilder using the supplied action kind
--   and user function.
--
--   This is a complex algorithm which has been rewritten many times, so I
--   will try to guide you through it as best I can.
queryTreeBuilder :: MonadGit r m
                 => TreeBuilder r m
                 -> TreeFilePath
                 -> BuilderAction
                 -> (Maybe (TreeEntry r) -> ModifyTreeResult r)
                 -> m (TreeBuilder r m, Maybe (TreeEntry r))
queryTreeBuilder :: TreeBuilder r m
-> TreeFilePath
-> BuilderAction
-> (Maybe (TreeEntry r) -> ModifyTreeResult r)
-> m (TreeBuilder r m, Maybe (TreeEntry r))
queryTreeBuilder TreeBuilder r m
builder TreeFilePath
path BuilderAction
kind Maybe (TreeEntry r) -> ModifyTreeResult r
f = do
    (ModifiedBuilder r m
mtb, ModifyTreeResult r
mtresult) <- ModifiedBuilder r m
-> [TreeFilePath] -> m (ModifiedBuilder r m, ModifyTreeResult r)
walk (TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
BuilderUnchanged TreeBuilder r m
builder) (TreeFilePath -> [TreeFilePath]
splitDirectories TreeFilePath
path)
    (TreeBuilder r m, Maybe (TreeEntry r))
-> m (TreeBuilder r m, Maybe (TreeEntry r))
forall (m :: * -> *) a. Monad m => a -> m a
return (ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod ModifiedBuilder r m
mtb, ModifyTreeResult r -> Maybe (TreeEntry r)
forall r. ModifyTreeResult r -> Maybe (TreeEntry r)
fromModifyTreeResult ModifyTreeResult r
mtresult)
  where
    walk :: ModifiedBuilder r m
-> [TreeFilePath] -> m (ModifiedBuilder r m, ModifyTreeResult r)
walk ModifiedBuilder r m
_ [] = String -> m (ModifiedBuilder r m, ModifyTreeResult r)
forall a. HasCallStack => String -> a
error String
"queryTreeBuilder called without a path"
    walk ModifiedBuilder r m
bm (TreeFilePath
name:[TreeFilePath]
names) = do
        let tb :: TreeBuilder r m
tb = ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod ModifiedBuilder r m
bm
        Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
y <- case TreeFilePath
-> HashMap TreeFilePath (TreeBuilder r m)
-> Maybe (TreeBuilder r m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TreeFilePath
name (TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates TreeBuilder r m
tb) of
            Just TreeBuilder r m
x  -> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
-> m (Either (ModifiedBuilder r m) (Maybe (TreeEntry r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
 -> m (Either (ModifiedBuilder r m) (Maybe (TreeEntry r))))
-> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
-> m (Either (ModifiedBuilder r m) (Maybe (TreeEntry r)))
forall a b. (a -> b) -> a -> b
$ ModifiedBuilder r m
-> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
forall a b. a -> Either a b
Left (TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
BuilderUnchanged TreeBuilder r m
x)
            Maybe (TreeBuilder r m)
Nothing -> do
                Maybe (TreeEntry r)
mentry <- TreeBuilder r m -> TreeFilePath -> m (Maybe (TreeEntry r))
forall r (m :: * -> *).
TreeBuilder r m -> TreeFilePath -> m (Maybe (TreeEntry r))
mtbLookupEntry TreeBuilder r m
tb TreeFilePath
name
                case Maybe (TreeEntry r)
mentry of
                    Maybe (TreeEntry r)
Nothing
                        | BuilderAction
kind BuilderAction -> BuilderAction -> Bool
forall a. Eq a => a -> a -> Bool
== BuilderAction
PutEntry Bool -> Bool -> Bool
&& Bool -> Bool
not ([TreeFilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TreeFilePath]
names) ->
                            ModifiedBuilder r m
-> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
forall a b. a -> Either a b
Left (ModifiedBuilder r m
 -> Either (ModifiedBuilder r m) (Maybe (TreeEntry r)))
-> (TreeBuilder r m -> ModifiedBuilder r m)
-> TreeBuilder r m
-> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
ModifiedBuilder
                                (TreeBuilder r m
 -> Either (ModifiedBuilder r m) (Maybe (TreeEntry r)))
-> m (TreeBuilder r m)
-> m (Either (ModifiedBuilder r m) (Maybe (TreeEntry r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeBuilder r m -> Maybe (Tree r) -> m (TreeBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m -> Maybe (Tree r) -> m (TreeBuilder r m)
mtbNewBuilder TreeBuilder r m
tb Maybe (Tree r)
forall a. Maybe a
Nothing
                        | Bool
otherwise -> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
-> m (Either (ModifiedBuilder r m) (Maybe (TreeEntry r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
 -> m (Either (ModifiedBuilder r m) (Maybe (TreeEntry r))))
-> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
-> m (Either (ModifiedBuilder r m) (Maybe (TreeEntry r)))
forall a b. (a -> b) -> a -> b
$ Maybe (TreeEntry r)
-> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
forall a b. b -> Either a b
Right Maybe (TreeEntry r)
forall a. Maybe a
Nothing
                    Just TreeEntry r
x -> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
-> m (Either (ModifiedBuilder r m) (Maybe (TreeEntry r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
 -> m (Either (ModifiedBuilder r m) (Maybe (TreeEntry r))))
-> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
-> m (Either (ModifiedBuilder r m) (Maybe (TreeEntry r)))
forall a b. (a -> b) -> a -> b
$ Maybe (TreeEntry r)
-> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
forall a b. b -> Either a b
Right (TreeEntry r -> Maybe (TreeEntry r)
forall a. a -> Maybe a
Just TreeEntry r
x)
        ModifiedBuilder r m
-> TreeFilePath
-> [TreeFilePath]
-> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
-> m (ModifiedBuilder r m, ModifyTreeResult r)
update ModifiedBuilder r m
bm TreeFilePath
name [TreeFilePath]
names Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
y

    doUpdate :: BuilderAction
-> ModifiedBuilder r m
-> TreeFilePath
-> ModifiedBuilder r m
-> m (ModifiedBuilder r m, ModifyTreeResult r)
doUpdate BuilderAction
GetEntry ModifiedBuilder r m
bm TreeFilePath
name ModifiedBuilder r m
sbm = do
        (TreeBuilder r m
_, Tagged (Tree r) (Oid r)
tref) <- TreeBuilder r m -> m (TreeBuilder r m, Tagged (Tree r) (Oid r))
forall r (m :: * -> *).
MonadGit r m =>
TreeBuilder r m -> m (TreeBuilder r m, TreeOid r)
writeTreeBuilder (ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod ModifiedBuilder r m
sbm)
        ModifiedBuilder r m
-> TreeFilePath
-> ModifyTreeResult r
-> m (ModifiedBuilder r m, ModifyTreeResult r)
forall (m :: * -> *) r.
Monad m =>
ModifiedBuilder r m
-> TreeFilePath
-> ModifyTreeResult r
-> m (ModifiedBuilder r m, ModifyTreeResult r)
returnTree ModifiedBuilder r m
bm TreeFilePath
name (ModifyTreeResult r -> m (ModifiedBuilder r m, ModifyTreeResult r))
-> ModifyTreeResult r
-> m (ModifiedBuilder r m, ModifyTreeResult r)
forall a b. (a -> b) -> a -> b
$ Maybe (TreeEntry r) -> ModifyTreeResult r
f (TreeEntry r -> Maybe (TreeEntry r)
forall a. a -> Maybe a
Just (Tagged (Tree r) (Oid r) -> TreeEntry r
forall r. TreeOid r -> TreeEntry r
TreeEntry Tagged (Tree r) (Oid r)
tref))
    doUpdate BuilderAction
_ ModifiedBuilder r m
bm TreeFilePath
name ModifiedBuilder r m
_ = ModifiedBuilder r m
-> TreeFilePath
-> ModifyTreeResult r
-> m (ModifiedBuilder r m, ModifyTreeResult r)
forall (m :: * -> *) r.
Monad m =>
ModifiedBuilder r m
-> TreeFilePath
-> ModifyTreeResult r
-> m (ModifiedBuilder r m, ModifyTreeResult r)
returnTree ModifiedBuilder r m
bm TreeFilePath
name (Maybe (TreeEntry r) -> ModifyTreeResult r
f Maybe (TreeEntry r)
forall a. Maybe a
Nothing)

    update :: ModifiedBuilder r m
-> TreeFilePath
-> [TreeFilePath]
-> Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
-> m (ModifiedBuilder r m, ModifyTreeResult r)
update ModifiedBuilder r m
bm TreeFilePath
name [] (Left ModifiedBuilder r m
sbm) = BuilderAction
-> ModifiedBuilder r m
-> TreeFilePath
-> ModifiedBuilder r m
-> m (ModifiedBuilder r m, ModifyTreeResult r)
doUpdate BuilderAction
kind ModifiedBuilder r m
bm TreeFilePath
name ModifiedBuilder r m
sbm
    update ModifiedBuilder r m
bm TreeFilePath
name [] (Right Maybe (TreeEntry r)
y)  = ModifiedBuilder r m
-> TreeFilePath
-> ModifyTreeResult r
-> m (ModifiedBuilder r m, ModifyTreeResult r)
forall (m :: * -> *) r.
Monad m =>
ModifiedBuilder r m
-> TreeFilePath
-> ModifyTreeResult r
-> m (ModifiedBuilder r m, ModifyTreeResult r)
returnTree ModifiedBuilder r m
bm TreeFilePath
name (Maybe (TreeEntry r) -> ModifyTreeResult r
f Maybe (TreeEntry r)
y)

    update ModifiedBuilder r m
bm TreeFilePath
_ [TreeFilePath]
_ (Right Maybe (TreeEntry r)
Nothing) = (ModifiedBuilder r m, ModifyTreeResult r)
-> m (ModifiedBuilder r m, ModifyTreeResult r)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModifiedBuilder r m
bm, ModifyTreeResult r
forall r. ModifyTreeResult r
TreeEntryNotFound)
    update ModifiedBuilder r m
_ TreeFilePath
_ [TreeFilePath]
_ (Right (Just BlobEntry {})) =
        GitException -> m (ModifiedBuilder r m, ModifyTreeResult r)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM GitException
TreeCannotTraverseBlob
    update ModifiedBuilder r m
_ TreeFilePath
_ [TreeFilePath]
_ (Right (Just CommitEntry {})) =
        GitException -> m (ModifiedBuilder r m, ModifyTreeResult r)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM GitException
TreeCannotTraverseCommit

    update ModifiedBuilder r m
bm TreeFilePath
name [TreeFilePath]
names Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
arg = do
        ModifiedBuilder r m
sbm <- case Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
arg of
            Left ModifiedBuilder r m
sbm' -> ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall (m :: * -> *) a. Monad m => a -> m a
return ModifiedBuilder r m
sbm'
            Right (Just (TreeEntry Tagged (Tree r) (Oid r)
st')) -> do
                Tree r
tree <- Tagged (Tree r) (Oid r) -> m (Tree r)
forall r (m :: * -> *). MonadGit r m => TreeOid r -> m (Tree r)
lookupTree Tagged (Tree r) (Oid r)
st'
                TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
ModifiedBuilder
                    (TreeBuilder r m -> ModifiedBuilder r m)
-> m (TreeBuilder r m) -> m (ModifiedBuilder r m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeBuilder r m -> Maybe (Tree r) -> m (TreeBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m -> Maybe (Tree r) -> m (TreeBuilder r m)
mtbNewBuilder (ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod ModifiedBuilder r m
bm) (Tree r -> Maybe (Tree r)
forall a. a -> Maybe a
Just Tree r
tree)
            Either (ModifiedBuilder r m) (Maybe (TreeEntry r))
_ -> String -> m (ModifiedBuilder r m)
forall a. HasCallStack => String -> a
error String
"queryTreeBuilder encountered the impossible"

        (ModifiedBuilder r m
sbm', ModifyTreeResult r
z) <- ModifiedBuilder r m
-> [TreeFilePath] -> m (ModifiedBuilder r m, ModifyTreeResult r)
walk ModifiedBuilder r m
sbm [TreeFilePath]
names
        let bm' :: ModifiedBuilder r m
bm' = ModifiedBuilder r m
bm ModifiedBuilder r m -> ModifiedBuilder r m -> ModifiedBuilder r m
forall a. Semigroup a => a -> a -> a
<> ModifiedBuilder r m
-> ModifiedBuilder r m -> TreeFilePath -> ModifiedBuilder r m
forall r (m :: * -> *).
ModifiedBuilder r m
-> ModifiedBuilder r m -> TreeFilePath -> ModifiedBuilder r m
postUpdate ModifiedBuilder r m
bm ModifiedBuilder r m
sbm' TreeFilePath
name
        (ModifiedBuilder r m, ModifyTreeResult r)
-> m (ModifiedBuilder r m, ModifyTreeResult r)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModifiedBuilder r m, ModifyTreeResult r)
 -> m (ModifiedBuilder r m, ModifyTreeResult r))
-> (ModifiedBuilder r m, ModifyTreeResult r)
-> m (ModifiedBuilder r m, ModifyTreeResult r)
forall a b. (a -> b) -> a -> b
$ ModifiedBuilder r m
bm' ModifiedBuilder r m
-> (ModifiedBuilder r m, ModifyTreeResult r)
-> (ModifiedBuilder r m, ModifyTreeResult r)
`seq` (ModifiedBuilder r m
bm', ModifyTreeResult r
z)

    returnTree :: ModifiedBuilder r m
-> TreeFilePath
-> ModifyTreeResult r
-> m (ModifiedBuilder r m, ModifyTreeResult r)
returnTree bm :: ModifiedBuilder r m
bm@(ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod -> TreeBuilder r m
tb) TreeFilePath
n ModifyTreeResult r
z = do
        ModifiedBuilder r m
bm' <- case ModifyTreeResult r
z of
            ModifyTreeResult r
TreeEntryNotFound     -> ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall (m :: * -> *) a. Monad m => a -> m a
return ModifiedBuilder r m
bm
            TreeEntryPersistent TreeEntry r
_ -> ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall (m :: * -> *) a. Monad m => a -> m a
return ModifiedBuilder r m
bm
            ModifyTreeResult r
TreeEntryDeleted      -> do
                ModifiedBuilder r m
bm' <- TreeBuilder r m
-> TreeBuilder r m -> TreeFilePath -> m (ModifiedBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m
-> TreeBuilder r m -> TreeFilePath -> m (ModifiedBuilder r m)
mtbDropEntry TreeBuilder r m
tb TreeBuilder r m
tb TreeFilePath
n
                let tb' :: TreeBuilder r m
tb'   = ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod ModifiedBuilder r m
bm'
                    upds' :: HashMap TreeFilePath (TreeBuilder r m)
upds' = TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates TreeBuilder r m
tb'
                ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModifiedBuilder r m -> m (ModifiedBuilder r m))
-> ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall a b. (a -> b) -> a -> b
$ case ModifiedBuilder r m
bm' of
                    ModifiedBuilder TreeBuilder r m
_ ->
                        TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
ModifiedBuilder TreeBuilder r m
tb'
                            { mtbPendingUpdates :: HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates = TreeFilePath
-> HashMap TreeFilePath (TreeBuilder r m)
-> HashMap TreeFilePath (TreeBuilder r m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete TreeFilePath
n HashMap TreeFilePath (TreeBuilder r m)
upds' }
                    BuilderUnchanged TreeBuilder r m
_ ->
                        if TreeFilePath -> HashMap TreeFilePath (TreeBuilder r m) -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member TreeFilePath
n HashMap TreeFilePath (TreeBuilder r m)
upds'
                        then TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
ModifiedBuilder TreeBuilder r m
tb'
                            { mtbPendingUpdates :: HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates = TreeFilePath
-> HashMap TreeFilePath (TreeBuilder r m)
-> HashMap TreeFilePath (TreeBuilder r m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete TreeFilePath
n HashMap TreeFilePath (TreeBuilder r m)
upds' }
                        else ModifiedBuilder r m
bm'
            TreeEntryMutated TreeEntry r
z'   -> TreeBuilder r m
-> TreeBuilder r m
-> TreeFilePath
-> TreeEntry r
-> m (ModifiedBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m
-> TreeBuilder r m
-> TreeFilePath
-> TreeEntry r
-> m (ModifiedBuilder r m)
mtbPutEntry TreeBuilder r m
tb TreeBuilder r m
tb TreeFilePath
n TreeEntry r
z'
        let bm'' :: ModifiedBuilder r m
bm'' = ModifiedBuilder r m
bm ModifiedBuilder r m -> ModifiedBuilder r m -> ModifiedBuilder r m
forall a. Semigroup a => a -> a -> a
<> ModifiedBuilder r m
bm'
        (ModifiedBuilder r m, ModifyTreeResult r)
-> m (ModifiedBuilder r m, ModifyTreeResult r)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModifiedBuilder r m, ModifyTreeResult r)
 -> m (ModifiedBuilder r m, ModifyTreeResult r))
-> (ModifiedBuilder r m, ModifyTreeResult r)
-> m (ModifiedBuilder r m, ModifyTreeResult r)
forall a b. (a -> b) -> a -> b
$ ModifiedBuilder r m
bm'' ModifiedBuilder r m
-> (ModifiedBuilder r m, ModifyTreeResult r)
-> (ModifiedBuilder r m, ModifyTreeResult r)
`seq` (ModifiedBuilder r m
bm'', ModifyTreeResult r
z)

    postUpdate :: ModifiedBuilder r m
-> ModifiedBuilder r m -> TreeFilePath -> ModifiedBuilder r m
postUpdate ModifiedBuilder r m
bm (BuilderUnchanged TreeBuilder r m
_) TreeFilePath
_ = ModifiedBuilder r m
bm
    postUpdate (ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod -> TreeBuilder r m
tb) (ModifiedBuilder TreeBuilder r m
sbm) TreeFilePath
name =
        TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
ModifiedBuilder (TreeBuilder r m -> ModifiedBuilder r m)
-> TreeBuilder r m -> ModifiedBuilder r m
forall a b. (a -> b) -> a -> b
$ TreeBuilder r m
tb
            { mtbPendingUpdates :: HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates =
                   TreeFilePath
-> TreeBuilder r m
-> HashMap TreeFilePath (TreeBuilder r m)
-> HashMap TreeFilePath (TreeBuilder r m)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert TreeFilePath
name TreeBuilder r m
sbm (TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates TreeBuilder r m
tb) }

    pathSeparator :: Word8
    pathSeparator :: Word8
pathSeparator = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'/'

    isPathSeparator :: Word8 -> Bool
    isPathSeparator :: Word8 -> Bool
isPathSeparator = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
pathSeparator)

    splitDirectories :: RawFilePath -> [RawFilePath]
    splitDirectories :: TreeFilePath -> [TreeFilePath]
splitDirectories TreeFilePath
x
        | TreeFilePath -> Bool
B.null TreeFilePath
x = []
        | Word8 -> Bool
isPathSeparator (TreeFilePath -> Word8
B.head TreeFilePath
x) = let (TreeFilePath
root,TreeFilePath
rest) = Int -> TreeFilePath -> (TreeFilePath, TreeFilePath)
B.splitAt Int
1 TreeFilePath
x
                                        in TreeFilePath
root TreeFilePath -> [TreeFilePath] -> [TreeFilePath]
forall a. a -> [a] -> [a]
: TreeFilePath -> [TreeFilePath]
splitter TreeFilePath
rest
        | Bool
otherwise = TreeFilePath -> [TreeFilePath]
splitter TreeFilePath
x
      where
        splitter :: TreeFilePath -> [TreeFilePath]
splitter = (TreeFilePath -> Bool) -> [TreeFilePath] -> [TreeFilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TreeFilePath -> Bool) -> TreeFilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeFilePath -> Bool
B.null) ([TreeFilePath] -> [TreeFilePath])
-> (TreeFilePath -> [TreeFilePath])
-> TreeFilePath
-> [TreeFilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> TreeFilePath -> [TreeFilePath]
B.split Word8
pathSeparator

-- | Write out a tree to its repository.  If it has already been written,
--   nothing will happen.
writeTreeBuilder :: MonadGit r m
                 => TreeBuilder r m -> m (TreeBuilder r m, TreeOid r)
writeTreeBuilder :: TreeBuilder r m -> m (TreeBuilder r m, TreeOid r)
writeTreeBuilder TreeBuilder r m
builder = do
    (ModifiedBuilder r m
bm, Maybe (TreeOid r)
mtref) <- ModifiedBuilder r m -> m (ModifiedBuilder r m, Maybe (TreeOid r))
forall (m :: * -> *) r.
Monad m =>
ModifiedBuilder r m
-> m (ModifiedBuilder r m, Maybe (Tagged (Tree r) (Oid r)))
go (TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
BuilderUnchanged TreeBuilder r m
builder)
    TreeOid r
tref <- case Maybe (TreeOid r)
mtref of
        Maybe (TreeOid r)
Nothing   -> Text -> m (TreeOid r)
forall r (m :: * -> *) o.
MonadGit r m =>
Text -> m (Tagged o (Oid r))
parseObjOid Text
emptyTreeId
        Just TreeOid r
tref -> TreeOid r -> m (TreeOid r)
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOid r
tref
    (TreeBuilder r m, TreeOid r) -> m (TreeBuilder r m, TreeOid r)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod ModifiedBuilder r m
bm, TreeOid r
tref)
  where
    go :: ModifiedBuilder r m
-> m (ModifiedBuilder r m, Maybe (Tagged (Tree r) (Oid r)))
go ModifiedBuilder r m
bm = do
        let upds :: HashMap TreeFilePath (TreeBuilder r m)
upds = TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates (ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod ModifiedBuilder r m
bm)
        ModifiedBuilder r m
bm' <- if HashMap TreeFilePath (TreeBuilder r m) -> Int
forall k v. HashMap k v -> Int
HashMap.size HashMap TreeFilePath (TreeBuilder r m)
upds Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
               then ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall (m :: * -> *) a. Monad m => a -> m a
return ModifiedBuilder r m
bm
               else do
                   ModifiedBuilder r m
bm' <- (ModifiedBuilder r m
 -> (TreeFilePath, TreeBuilder r m) -> m (ModifiedBuilder r m))
-> ModifiedBuilder r m
-> [(TreeFilePath, TreeBuilder r m)]
-> m (ModifiedBuilder r m)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ModifiedBuilder r m
-> (TreeFilePath, TreeBuilder r m) -> m (ModifiedBuilder r m)
update ModifiedBuilder r m
bm ([(TreeFilePath, TreeBuilder r m)] -> m (ModifiedBuilder r m))
-> [(TreeFilePath, TreeBuilder r m)] -> m (ModifiedBuilder r m)
forall a b. (a -> b) -> a -> b
$ HashMap TreeFilePath (TreeBuilder r m)
-> [(TreeFilePath, TreeBuilder r m)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap TreeFilePath (TreeBuilder r m)
upds
                   ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModifiedBuilder r m -> m (ModifiedBuilder r m))
-> ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall a b. (a -> b) -> a -> b
$ TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
ModifiedBuilder (ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod ModifiedBuilder r m
bm')
                       { mtbPendingUpdates :: HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates = HashMap TreeFilePath (TreeBuilder r m)
forall k v. HashMap k v
HashMap.empty }
        let tb' :: TreeBuilder r m
tb' = ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod ModifiedBuilder r m
bm'
        Int
cnt <- TreeBuilder r m -> m Int
forall r (m :: * -> *). TreeBuilder r m -> m Int
mtbEntryCount TreeBuilder r m
tb'
        if Int
cnt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then (ModifiedBuilder r m, Maybe (Tagged (Tree r) (Oid r)))
-> m (ModifiedBuilder r m, Maybe (Tagged (Tree r) (Oid r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ModifiedBuilder r m
bm', Maybe (Tagged (Tree r) (Oid r))
forall a. Maybe a
Nothing)
            else do
                 (ModifiedBuilder r m
bm'', Tagged (Tree r) (Oid r)
tref) <- TreeBuilder r m
-> TreeBuilder r m
-> m (ModifiedBuilder r m, Tagged (Tree r) (Oid r))
forall r (m :: * -> *).
TreeBuilder r m
-> TreeBuilder r m -> m (ModifiedBuilder r m, TreeOid r)
mtbWriteContents TreeBuilder r m
tb' TreeBuilder r m
tb'
                 (ModifiedBuilder r m, Maybe (Tagged (Tree r) (Oid r)))
-> m (ModifiedBuilder r m, Maybe (Tagged (Tree r) (Oid r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (ModifiedBuilder r m
bm' ModifiedBuilder r m -> ModifiedBuilder r m -> ModifiedBuilder r m
forall a. Semigroup a => a -> a -> a
<> ModifiedBuilder r m
bm'', Tagged (Tree r) (Oid r) -> Maybe (Tagged (Tree r) (Oid r))
forall a. a -> Maybe a
Just Tagged (Tree r) (Oid r)
tref)

    update :: ModifiedBuilder r m
-> (TreeFilePath, TreeBuilder r m) -> m (ModifiedBuilder r m)
update ModifiedBuilder r m
bm (TreeFilePath
k,TreeBuilder r m
v) = do
        let tb :: TreeBuilder r m
tb = ModifiedBuilder r m -> TreeBuilder r m
forall r (m :: * -> *). ModifiedBuilder r m -> TreeBuilder r m
fromBuilderMod ModifiedBuilder r m
bm
        -- The intermediate TreeBuilder will be dropped after this fold is
        -- completed, by setting mtbPendingUpdates to HashMap.empty, above.
        (ModifiedBuilder r m
_,Maybe (Tagged (Tree r) (Oid r))
mtref) <- ModifiedBuilder r m
-> m (ModifiedBuilder r m, Maybe (Tagged (Tree r) (Oid r)))
go (TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
BuilderUnchanged TreeBuilder r m
v)
        ModifiedBuilder r m
bm' <- case Maybe (Tagged (Tree r) (Oid r))
mtref of
            Maybe (Tagged (Tree r) (Oid r))
Nothing   -> TreeBuilder r m
-> TreeBuilder r m -> TreeFilePath -> m (ModifiedBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m
-> TreeBuilder r m -> TreeFilePath -> m (ModifiedBuilder r m)
mtbDropEntry TreeBuilder r m
tb TreeBuilder r m
tb TreeFilePath
k
            Just Tagged (Tree r) (Oid r)
tref -> TreeBuilder r m
-> TreeBuilder r m
-> TreeFilePath
-> TreeEntry r
-> m (ModifiedBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m
-> TreeBuilder r m
-> TreeFilePath
-> TreeEntry r
-> m (ModifiedBuilder r m)
mtbPutEntry TreeBuilder r m
tb TreeBuilder r m
tb TreeFilePath
k (Tagged (Tree r) (Oid r) -> TreeEntry r
forall r. TreeOid r -> TreeEntry r
TreeEntry Tagged (Tree r) (Oid r)
tref)
        ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModifiedBuilder r m -> m (ModifiedBuilder r m))
-> ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall a b. (a -> b) -> a -> b
$ ModifiedBuilder r m
bm ModifiedBuilder r m -> ModifiedBuilder r m -> ModifiedBuilder r m
forall a. Semigroup a => a -> a -> a
<> ModifiedBuilder r m
bm'

getEntry :: MonadGit r m => TreeFilePath -> TreeT r m (Maybe (TreeEntry r))
getEntry :: TreeFilePath -> TreeT r m (Maybe (TreeEntry r))
getEntry TreeFilePath
path = do
    TreeBuilder r m
tb <- TreeT r m (TreeBuilder r m)
forall (m :: * -> *) r. Monad m => TreeT r m (TreeBuilder r m)
getBuilder
    (TreeBuilder r m, Maybe (TreeEntry r)) -> Maybe (TreeEntry r)
forall a b. (a, b) -> b
snd ((TreeBuilder r m, Maybe (TreeEntry r)) -> Maybe (TreeEntry r))
-> TreeT r m (TreeBuilder r m, Maybe (TreeEntry r))
-> TreeT r m (Maybe (TreeEntry r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (TreeBuilder r m, Maybe (TreeEntry r))
-> TreeT r m (TreeBuilder r m, Maybe (TreeEntry r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TreeBuilder r m
-> TreeFilePath
-> BuilderAction
-> (Maybe (TreeEntry r) -> ModifyTreeResult r)
-> m (TreeBuilder r m, Maybe (TreeEntry r))
forall r (m :: * -> *).
MonadGit r m =>
TreeBuilder r m
-> TreeFilePath
-> BuilderAction
-> (Maybe (TreeEntry r) -> ModifyTreeResult r)
-> m (TreeBuilder r m, Maybe (TreeEntry r))
queryTreeBuilder TreeBuilder r m
tb TreeFilePath
path BuilderAction
GetEntry
                  ((TreeEntry r -> ModifyTreeResult r)
-> Maybe (TreeEntry r) -> ModifyTreeResult r
forall r.
(TreeEntry r -> ModifyTreeResult r)
-> Maybe (TreeEntry r) -> ModifyTreeResult r
toModifyTreeResult TreeEntry r -> ModifyTreeResult r
forall r. TreeEntry r -> ModifyTreeResult r
TreeEntryPersistent))

putEntry :: MonadGit r m => TreeFilePath -> TreeEntry r -> TreeT r m ()
putEntry :: TreeFilePath -> TreeEntry r -> TreeT r m ()
putEntry TreeFilePath
path TreeEntry r
ent = do
    TreeBuilder r m
tb  <- TreeT r m (TreeBuilder r m)
forall (m :: * -> *) r. Monad m => TreeT r m (TreeBuilder r m)
getBuilder
    TreeBuilder r m
tb' <- (TreeBuilder r m, Maybe (TreeEntry r)) -> TreeBuilder r m
forall a b. (a, b) -> a
fst ((TreeBuilder r m, Maybe (TreeEntry r)) -> TreeBuilder r m)
-> TreeT r m (TreeBuilder r m, Maybe (TreeEntry r))
-> TreeT r m (TreeBuilder r m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (TreeBuilder r m, Maybe (TreeEntry r))
-> TreeT r m (TreeBuilder r m, Maybe (TreeEntry r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TreeBuilder r m
-> TreeFilePath
-> BuilderAction
-> (Maybe (TreeEntry r) -> ModifyTreeResult r)
-> m (TreeBuilder r m, Maybe (TreeEntry r))
forall r (m :: * -> *).
MonadGit r m =>
TreeBuilder r m
-> TreeFilePath
-> BuilderAction
-> (Maybe (TreeEntry r) -> ModifyTreeResult r)
-> m (TreeBuilder r m, Maybe (TreeEntry r))
queryTreeBuilder TreeBuilder r m
tb TreeFilePath
path BuilderAction
PutEntry
                         (ModifyTreeResult r -> Maybe (TreeEntry r) -> ModifyTreeResult r
forall a b. a -> b -> a
const (TreeEntry r -> ModifyTreeResult r
forall r. TreeEntry r -> ModifyTreeResult r
TreeEntryMutated TreeEntry r
ent)))
    TreeBuilder r m -> TreeT r m ()
forall (m :: * -> *) r. Monad m => TreeBuilder r m -> TreeT r m ()
putBuilder TreeBuilder r m
tb'

dropEntry :: MonadGit r m => TreeFilePath -> TreeT r m ()
dropEntry :: TreeFilePath -> TreeT r m ()
dropEntry TreeFilePath
path = do
    TreeBuilder r m
tb  <- TreeT r m (TreeBuilder r m)
forall (m :: * -> *) r. Monad m => TreeT r m (TreeBuilder r m)
getBuilder
    TreeBuilder r m
tb' <- (TreeBuilder r m, Maybe (TreeEntry r)) -> TreeBuilder r m
forall a b. (a, b) -> a
fst ((TreeBuilder r m, Maybe (TreeEntry r)) -> TreeBuilder r m)
-> TreeT r m (TreeBuilder r m, Maybe (TreeEntry r))
-> TreeT r m (TreeBuilder r m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (TreeBuilder r m, Maybe (TreeEntry r))
-> TreeT r m (TreeBuilder r m, Maybe (TreeEntry r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TreeBuilder r m
-> TreeFilePath
-> BuilderAction
-> (Maybe (TreeEntry r) -> ModifyTreeResult r)
-> m (TreeBuilder r m, Maybe (TreeEntry r))
forall r (m :: * -> *).
MonadGit r m =>
TreeBuilder r m
-> TreeFilePath
-> BuilderAction
-> (Maybe (TreeEntry r) -> ModifyTreeResult r)
-> m (TreeBuilder r m, Maybe (TreeEntry r))
queryTreeBuilder TreeBuilder r m
tb TreeFilePath
path BuilderAction
DropEntry
                         (ModifyTreeResult r -> Maybe (TreeEntry r) -> ModifyTreeResult r
forall a b. a -> b -> a
const ModifyTreeResult r
forall r. ModifyTreeResult r
TreeEntryDeleted))
    TreeBuilder r m -> TreeT r m ()
forall (m :: * -> *) r. Monad m => TreeBuilder r m -> TreeT r m ()
putBuilder TreeBuilder r m
tb'

putBlob' :: MonadGit r m
         => TreeFilePath -> BlobOid r -> BlobKind -> TreeT r m ()
putBlob' :: TreeFilePath -> BlobOid r -> BlobKind -> TreeT r m ()
putBlob' TreeFilePath
path BlobOid r
b BlobKind
kind = TreeFilePath -> TreeEntry r -> TreeT r m ()
forall r (m :: * -> *).
MonadGit r m =>
TreeFilePath -> TreeEntry r -> TreeT r m ()
putEntry TreeFilePath
path (BlobOid r -> BlobKind -> TreeEntry r
forall r. BlobOid r -> BlobKind -> TreeEntry r
BlobEntry BlobOid r
b BlobKind
kind)

putBlob :: MonadGit r m => TreeFilePath -> BlobOid r -> TreeT r m ()
putBlob :: TreeFilePath -> BlobOid r -> TreeT r m ()
putBlob TreeFilePath
path BlobOid r
b = TreeFilePath -> BlobOid r -> BlobKind -> TreeT r m ()
forall r (m :: * -> *).
MonadGit r m =>
TreeFilePath -> BlobOid r -> BlobKind -> TreeT r m ()
putBlob' TreeFilePath
path BlobOid r
b BlobKind
PlainBlob

putTree :: MonadGit r m => TreeFilePath -> TreeOid r -> TreeT r m ()
putTree :: TreeFilePath -> TreeOid r -> TreeT r m ()
putTree TreeFilePath
path TreeOid r
t = TreeFilePath -> TreeEntry r -> TreeT r m ()
forall r (m :: * -> *).
MonadGit r m =>
TreeFilePath -> TreeEntry r -> TreeT r m ()
putEntry TreeFilePath
path (TreeOid r -> TreeEntry r
forall r. TreeOid r -> TreeEntry r
TreeEntry TreeOid r
t)

putCommit :: MonadGit r m => TreeFilePath -> CommitOid r -> TreeT r m ()
putCommit :: TreeFilePath -> CommitOid r -> TreeT r m ()
putCommit TreeFilePath
path CommitOid r
c = TreeFilePath -> TreeEntry r -> TreeT r m ()
forall r (m :: * -> *).
MonadGit r m =>
TreeFilePath -> TreeEntry r -> TreeT r m ()
putEntry TreeFilePath
path (CommitOid r -> TreeEntry r
forall r. CommitOid r -> TreeEntry r
CommitEntry CommitOid r
c)

doWithTree :: MonadGit r m => Maybe (Tree r) -> TreeT r m a -> m (a, TreeOid r)
doWithTree :: Maybe (Tree r) -> TreeT r m a -> m (a, TreeOid r)
doWithTree Maybe (Tree r)
rtr TreeT r m a
act =
    ((a, TreeOid r), TreeBuilder r m) -> (a, TreeOid r)
forall a b. (a, b) -> a
fst (((a, TreeOid r), TreeBuilder r m) -> (a, TreeOid r))
-> m ((a, TreeOid r), TreeBuilder r m) -> m (a, TreeOid r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT (TreeBuilder r m) m (a, TreeOid r)
-> TreeBuilder r m -> m ((a, TreeOid r), TreeBuilder r m)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (TreeT r m (a, TreeOid r)
-> StateT (TreeBuilder r m) m (a, TreeOid r)
forall r (m :: * -> *) a.
TreeT r m a -> StateT (TreeBuilder r m) m a
runTreeT TreeT r m (a, TreeOid r)
go) (TreeBuilder r m -> m ((a, TreeOid r), TreeBuilder r m))
-> m (TreeBuilder r m) -> m ((a, TreeOid r), TreeBuilder r m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Tree r) -> m (TreeBuilder r m)
forall r (m :: * -> *).
MonadGit r m =>
Maybe (Tree r) -> m (TreeBuilder r m)
newTreeBuilder Maybe (Tree r)
rtr)
  where
    go :: TreeT r m (a, TreeOid r)
go = (a -> TreeOid r -> (a, TreeOid r))
-> TreeT r m a -> TreeT r m (TreeOid r) -> TreeT r m (a, TreeOid r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) TreeT r m a
act TreeT r m (TreeOid r)
forall r (m :: * -> *). MonadGit r m => TreeT r m (TreeOid r)
currentTreeOid

withTree :: MonadGit r m => Tree r -> TreeT r m a -> m (a, TreeOid r)
withTree :: Tree r -> TreeT r m a -> m (a, TreeOid r)
withTree Tree r
tr = Maybe (Tree r) -> TreeT r m a -> m (a, TreeOid r)
forall r (m :: * -> *) a.
MonadGit r m =>
Maybe (Tree r) -> TreeT r m a -> m (a, TreeOid r)
doWithTree (Tree r -> Maybe (Tree r)
forall a. a -> Maybe a
Just Tree r
tr)

withTreeOid :: MonadGit r m => TreeOid r -> TreeT r m a -> m (a, TreeOid r)
withTreeOid :: TreeOid r -> TreeT r m a -> m (a, TreeOid r)
withTreeOid TreeOid r
oid TreeT r m a
action = do
    Tree r
tree <- TreeOid r -> m (Tree r)
forall r (m :: * -> *). MonadGit r m => TreeOid r -> m (Tree r)
lookupTree TreeOid r
oid
    Maybe (Tree r) -> TreeT r m a -> m (a, TreeOid r)
forall r (m :: * -> *) a.
MonadGit r m =>
Maybe (Tree r) -> TreeT r m a -> m (a, TreeOid r)
doWithTree (Tree r -> Maybe (Tree r)
forall a. a -> Maybe a
Just Tree r
tree) TreeT r m a
action

mutateTree :: MonadGit r m => Tree r -> TreeT r m a -> m (TreeOid r)
mutateTree :: Tree r -> TreeT r m a -> m (TreeOid r)
mutateTree Tree r
tr TreeT r m a
action = (a, TreeOid r) -> TreeOid r
forall a b. (a, b) -> b
snd ((a, TreeOid r) -> TreeOid r) -> m (a, TreeOid r) -> m (TreeOid r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree r -> TreeT r m a -> m (a, TreeOid r)
forall r (m :: * -> *) a.
MonadGit r m =>
Tree r -> TreeT r m a -> m (a, TreeOid r)
withTree Tree r
tr TreeT r m a
action

mutateTreeOid :: MonadGit r m => TreeOid r -> TreeT r m a -> m (TreeOid r)
mutateTreeOid :: TreeOid r -> TreeT r m a -> m (TreeOid r)
mutateTreeOid TreeOid r
tr TreeT r m a
action = (a, TreeOid r) -> TreeOid r
forall a b. (a, b) -> b
snd ((a, TreeOid r) -> TreeOid r) -> m (a, TreeOid r) -> m (TreeOid r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeOid r -> TreeT r m a -> m (a, TreeOid r)
forall r (m :: * -> *) a.
MonadGit r m =>
TreeOid r -> TreeT r m a -> m (a, TreeOid r)
withTreeOid TreeOid r
tr TreeT r m a
action

currentTreeOid :: MonadGit r m => TreeT r m (TreeOid r)
currentTreeOid :: TreeT r m (TreeOid r)
currentTreeOid = do
    TreeBuilder r m
tb <- TreeT r m (TreeBuilder r m)
forall (m :: * -> *) r. Monad m => TreeT r m (TreeBuilder r m)
getBuilder
    (TreeBuilder r m
tb', TreeOid r
toid) <- m (TreeBuilder r m, TreeOid r)
-> TreeT r m (TreeBuilder r m, TreeOid r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TreeBuilder r m, TreeOid r)
 -> TreeT r m (TreeBuilder r m, TreeOid r))
-> m (TreeBuilder r m, TreeOid r)
-> TreeT r m (TreeBuilder r m, TreeOid r)
forall a b. (a -> b) -> a -> b
$ TreeBuilder r m -> m (TreeBuilder r m, TreeOid r)
forall r (m :: * -> *).
MonadGit r m =>
TreeBuilder r m -> m (TreeBuilder r m, TreeOid r)
writeTreeBuilder TreeBuilder r m
tb
    TreeBuilder r m -> TreeT r m ()
forall (m :: * -> *) r. Monad m => TreeBuilder r m -> TreeT r m ()
putBuilder TreeBuilder r m
tb'
    TreeOid r -> TreeT r m (TreeOid r)
forall (m :: * -> *) a. Monad m => a -> m a
return TreeOid r
toid

currentTree :: MonadGit r m => TreeT r m (Tree r)
currentTree :: TreeT r m (Tree r)
currentTree = m (Tree r) -> TreeT r m (Tree r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Tree r) -> TreeT r m (Tree r))
-> (Tagged (Tree r) (Oid r) -> m (Tree r))
-> Tagged (Tree r) (Oid r)
-> TreeT r m (Tree r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged (Tree r) (Oid r) -> m (Tree r)
forall r (m :: * -> *). MonadGit r m => TreeOid r -> m (Tree r)
lookupTree (Tagged (Tree r) (Oid r) -> TreeT r m (Tree r))
-> TreeT r m (Tagged (Tree r) (Oid r)) -> TreeT r m (Tree r)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TreeT r m (Tagged (Tree r) (Oid r))
forall r (m :: * -> *). MonadGit r m => TreeT r m (TreeOid r)
currentTreeOid

withNewTree :: MonadGit r m => TreeT r m a -> m (a, TreeOid r)
withNewTree :: TreeT r m a -> m (a, TreeOid r)
withNewTree = Maybe (Tree r) -> TreeT r m a -> m (a, TreeOid r)
forall r (m :: * -> *) a.
MonadGit r m =>
Maybe (Tree r) -> TreeT r m a -> m (a, TreeOid r)
doWithTree Maybe (Tree r)
forall a. Maybe a
Nothing

createTree :: MonadGit r m => TreeT r m a -> m (TreeOid r)
createTree :: TreeT r m a -> m (TreeOid r)
createTree TreeT r m a
action = (a, TreeOid r) -> TreeOid r
forall a b. (a, b) -> b
snd ((a, TreeOid r) -> TreeOid r) -> m (a, TreeOid r) -> m (TreeOid r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TreeT r m a -> m (a, TreeOid r)
forall r (m :: * -> *) a.
MonadGit r m =>
TreeT r m a -> m (a, TreeOid r)
withNewTree TreeT r m a
action