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)

-- | Create a new, empty tree.
--
--   Since empty trees cannot exist in Git, attempting to write out an empty
--   tree is a no-op.
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
    }