module Git.Tree.Builder.Pure
( EntryHashMap
, newPureTreeBuilder
) where
import Control.Applicative
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Monoid
import Data.Traversable
import Git
import Prelude hiding (mapM)
type EntryHashMap r = HashMap TreeFilePath (TreeEntry r)
newPureTreeBuilder :: MonadGit r m
=> (Tree r -> m (EntryHashMap r))
-> (EntryHashMap r -> m (TreeOid r))
-> Maybe (Tree r)
-> m (TreeBuilder r m)
newPureTreeBuilder :: (Tree r -> m (EntryHashMap r))
-> (EntryHashMap r -> m (TreeOid r))
-> Maybe (Tree r)
-> m (TreeBuilder r m)
newPureTreeBuilder Tree r -> m (EntryHashMap r)
reader EntryHashMap r -> m (TreeOid r)
writer Maybe (Tree r)
mtree = do
EntryHashMap r
entMap <- case Maybe (Tree r)
mtree of
Maybe (Tree r)
Nothing -> EntryHashMap r -> m (EntryHashMap r)
forall (m :: * -> *) a. Monad m => a -> m a
return EntryHashMap r
forall k v. HashMap k v
HashMap.empty
Just Tree r
tree -> Tree r -> m (EntryHashMap r)
reader Tree r
tree
Maybe (TreeOid r)
toid <- (Tree r -> m (TreeOid r))
-> Maybe (Tree r) -> m (Maybe (TreeOid r))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Tree r -> m (TreeOid r)
forall r (m :: * -> *). MonadGit r m => Tree r -> m (TreeOid r)
treeOid Maybe (Tree r)
mtree
TreeBuilder r m -> m (TreeBuilder r m)
forall (m :: * -> *) a. Monad m => a -> m a
return (TreeBuilder r m -> m (TreeBuilder r m))
-> TreeBuilder r m -> m (TreeBuilder r m)
forall a b. (a -> b) -> a -> b
$ Maybe (TreeOid r)
-> HashMap TreeFilePath (TreeBuilder r m)
-> (Maybe (Tree r) -> m (TreeBuilder r m))
-> EntryHashMap r
-> (EntryHashMap r -> m (TreeOid r))
-> TreeBuilder r m
forall r (m :: * -> *).
MonadGit r m =>
Maybe (TreeOid r)
-> HashMap TreeFilePath (TreeBuilder r m)
-> (Maybe (Tree r) -> m (TreeBuilder r m))
-> EntryHashMap r
-> (EntryHashMap r -> m (TreeOid r))
-> TreeBuilder r m
makePureBuilder
Maybe (TreeOid r)
toid
HashMap TreeFilePath (TreeBuilder r m)
forall a. Monoid a => a
mempty
((Tree r -> m (EntryHashMap r))
-> (EntryHashMap r -> m (TreeOid r))
-> Maybe (Tree r)
-> m (TreeBuilder r m)
forall r (m :: * -> *).
MonadGit r m =>
(Tree r -> m (EntryHashMap r))
-> (EntryHashMap r -> m (TreeOid r))
-> Maybe (Tree r)
-> m (TreeBuilder r m)
newPureTreeBuilder Tree r -> m (EntryHashMap r)
reader EntryHashMap r -> m (TreeOid r)
writer)
EntryHashMap r
entMap
EntryHashMap r -> m (TreeOid r)
writer
makePureBuilder :: MonadGit r m
=> Maybe (TreeOid r)
-> HashMap TreeFilePath (TreeBuilder r m)
-> (Maybe (Tree r) -> m (TreeBuilder r m))
-> EntryHashMap r
-> (EntryHashMap r -> m (TreeOid r))
-> TreeBuilder r m
makePureBuilder :: Maybe (TreeOid r)
-> HashMap TreeFilePath (TreeBuilder r m)
-> (Maybe (Tree r) -> m (TreeBuilder r m))
-> EntryHashMap r
-> (EntryHashMap r -> m (TreeOid r))
-> TreeBuilder r m
makePureBuilder Maybe (TreeOid r)
baseTree HashMap TreeFilePath (TreeBuilder r m)
upds Maybe (Tree r) -> m (TreeBuilder r m)
newBuilder EntryHashMap r
entMap EntryHashMap r -> m (TreeOid r)
writer = TreeBuilder :: forall r (m :: * -> *).
Maybe (TreeOid r)
-> HashMap TreeFilePath (TreeBuilder r m)
-> (Maybe (Tree r) -> m (TreeBuilder r m))
-> (TreeBuilder r m -> m (ModifiedBuilder r m, TreeOid r))
-> (TreeFilePath -> m (Maybe (TreeEntry r)))
-> m Int
-> (TreeBuilder r m
-> TreeFilePath -> TreeEntry r -> m (ModifiedBuilder r m))
-> (TreeBuilder r m -> TreeFilePath -> m (ModifiedBuilder r m))
-> TreeBuilder r m
TreeBuilder
{ mtbBaseTreeOid :: Maybe (TreeOid r)
mtbBaseTreeOid = Maybe (TreeOid r)
baseTree
, mtbPendingUpdates :: HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates = HashMap TreeFilePath (TreeBuilder r m)
upds
, mtbNewBuilder :: Maybe (Tree r) -> m (TreeBuilder r m)
mtbNewBuilder = Maybe (Tree r) -> m (TreeBuilder r m)
newBuilder
, mtbWriteContents :: TreeBuilder r m -> m (ModifiedBuilder r m, TreeOid r)
mtbWriteContents = \TreeBuilder r m
tb -> (,) (ModifiedBuilder r m
-> TreeOid r -> (ModifiedBuilder r m, TreeOid r))
-> m (ModifiedBuilder r m)
-> m (TreeOid r -> (ModifiedBuilder r m, TreeOid r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TreeBuilder r m -> ModifiedBuilder r m
forall r (m :: * -> *). TreeBuilder r m -> ModifiedBuilder r m
BuilderUnchanged TreeBuilder r m
tb)
m (TreeOid r -> (ModifiedBuilder r m, TreeOid r))
-> m (TreeOid r) -> m (ModifiedBuilder r m, TreeOid r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EntryHashMap r -> m (TreeOid r)
writer EntryHashMap r
entMap
, mtbLookupEntry :: TreeFilePath -> m (Maybe (TreeEntry r))
mtbLookupEntry = \TreeFilePath
key -> Maybe (TreeEntry r) -> m (Maybe (TreeEntry r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TreeEntry r) -> m (Maybe (TreeEntry r)))
-> Maybe (TreeEntry r) -> m (Maybe (TreeEntry r))
forall a b. (a -> b) -> a -> b
$ TreeFilePath -> EntryHashMap r -> Maybe (TreeEntry r)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TreeFilePath
key EntryHashMap r
entMap
, mtbEntryCount :: m Int
mtbEntryCount = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ EntryHashMap r -> Int
forall k v. HashMap k v -> Int
HashMap.size EntryHashMap r
entMap
, mtbPutEntry :: TreeBuilder r m
-> TreeFilePath -> TreeEntry r -> m (ModifiedBuilder r m)
mtbPutEntry = \TreeBuilder r m
tb TreeFilePath
key TreeEntry r
ent ->
ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModifiedBuilder r m -> m (ModifiedBuilder r m))
-> (TreeBuilder r m -> ModifiedBuilder r m)
-> TreeBuilder r m
-> m (ModifiedBuilder r m)
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 -> m (ModifiedBuilder r m))
-> TreeBuilder r m -> m (ModifiedBuilder r m)
forall a b. (a -> b) -> a -> b
$
Maybe (TreeOid r)
-> HashMap TreeFilePath (TreeBuilder r m)
-> (Maybe (Tree r) -> m (TreeBuilder r m))
-> EntryHashMap r
-> (EntryHashMap r -> m (TreeOid r))
-> TreeBuilder r m
forall r (m :: * -> *).
MonadGit r m =>
Maybe (TreeOid r)
-> HashMap TreeFilePath (TreeBuilder r m)
-> (Maybe (Tree r) -> m (TreeBuilder r m))
-> EntryHashMap r
-> (EntryHashMap r -> m (TreeOid r))
-> TreeBuilder r m
makePureBuilder
Maybe (TreeOid r)
baseTree
(TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates TreeBuilder r m
tb)
Maybe (Tree r) -> m (TreeBuilder r m)
newBuilder
(TreeFilePath -> TreeEntry r -> EntryHashMap r -> EntryHashMap r
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert TreeFilePath
key TreeEntry r
ent EntryHashMap r
entMap)
EntryHashMap r -> m (TreeOid r)
writer
, mtbDropEntry :: TreeBuilder r m -> TreeFilePath -> m (ModifiedBuilder r m)
mtbDropEntry = \TreeBuilder r m
tb TreeFilePath
key ->
ModifiedBuilder r m -> m (ModifiedBuilder r m)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModifiedBuilder r m -> m (ModifiedBuilder r m))
-> (TreeBuilder r m -> ModifiedBuilder r m)
-> TreeBuilder r m
-> m (ModifiedBuilder r m)
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 -> m (ModifiedBuilder r m))
-> TreeBuilder r m -> m (ModifiedBuilder r m)
forall a b. (a -> b) -> a -> b
$
Maybe (TreeOid r)
-> HashMap TreeFilePath (TreeBuilder r m)
-> (Maybe (Tree r) -> m (TreeBuilder r m))
-> EntryHashMap r
-> (EntryHashMap r -> m (TreeOid r))
-> TreeBuilder r m
forall r (m :: * -> *).
MonadGit r m =>
Maybe (TreeOid r)
-> HashMap TreeFilePath (TreeBuilder r m)
-> (Maybe (Tree r) -> m (TreeBuilder r m))
-> EntryHashMap r
-> (EntryHashMap r -> m (TreeOid r))
-> TreeBuilder r m
makePureBuilder
Maybe (TreeOid r)
baseTree
(TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
forall r (m :: * -> *).
TreeBuilder r m -> HashMap TreeFilePath (TreeBuilder r m)
mtbPendingUpdates TreeBuilder r m
tb)
Maybe (Tree r) -> m (TreeBuilder r m)
newBuilder
(TreeFilePath -> EntryHashMap r -> EntryHashMap r
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete TreeFilePath
key EntryHashMap r
entMap)
EntryHashMap r -> m (TreeOid r)
writer
}