{-# 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"
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
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
(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