{-# LANGUAGE RecordWildCards #-}

module U.Codebase.Sqlite.Branch.Full where

import Control.Lens
import Data.Bitraversable
import Data.Map.Strict qualified as Map
import U.Codebase.HashTags
import U.Codebase.Reference (Reference', TermReference', TypeReference')
import U.Codebase.Reference qualified as Reference
import U.Codebase.Referent (Referent')
import U.Codebase.Sqlite.DbId (BranchObjectId, CausalHashId, ObjectId, PatchObjectId, TextId)
import U.Codebase.Sqlite.LocalIds (LocalBranchChildId, LocalDefnId, LocalPatchObjectId, LocalTextId)
import Unison.Prelude
import Unison.Util.Map qualified as Map
import Unison.Util.Set qualified as Set

-- |
-- @
-- Branch
--   { terms :: Map LocalTextId (Map LocalReferent LocalMetadataSet),
--     types :: Map LocalTextId (Map LocalReference LocalMetadataSet),
--     patches :: Map LocalTextId LocalPatchObjectId,
--     children :: Map LocalTextId LocalBranchChildId
--   }
-- @
type LocalBranch = Branch' LocalTextId LocalDefnId LocalPatchObjectId LocalBranchChildId

-- |
-- @
-- Branch
--   { terms :: Map TextId (Map Referent DbMetadataSet),
--     types :: Map TextId (Map Reference DbMetadataSet),
--     patches :: Map TextId PatchObjectId,
--     children :: Map TextId (BranchObjectId, CausalHashId)
--   }
-- @
type DbBranch = Branch' TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)

type DbBranchV3 = GBranchV3 TextId ObjectId (BranchObjectId, CausalHashId)

type HashBranch = Branch' Text ComponentHash PatchHash (BranchHash, CausalHash)

type Referent'' t h = Referent' (TermReference' t h) (TypeReference' t h)

data Branch' t h p c = Branch
  { forall t h p c.
Branch' t h p c
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms :: !(Map t (Map (Referent'' t h) (MetadataSetFormat' t h))),
    forall t h p c.
Branch' t h p c
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types :: !(Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))),
    forall t h p c. Branch' t h p c -> Map t p
patches :: !(Map t p),
    forall t h p c. Branch' t h p c -> Map t c
children :: !(Map t c)
  }
  deriving stock (Int -> Branch' t h p c -> ShowS
[Branch' t h p c] -> ShowS
Branch' t h p c -> String
(Int -> Branch' t h p c -> ShowS)
-> (Branch' t h p c -> String)
-> ([Branch' t h p c] -> ShowS)
-> Show (Branch' t h p c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t h p c.
(Show t, Show h, Show p, Show c) =>
Int -> Branch' t h p c -> ShowS
forall t h p c.
(Show t, Show h, Show p, Show c) =>
[Branch' t h p c] -> ShowS
forall t h p c.
(Show t, Show h, Show p, Show c) =>
Branch' t h p c -> String
$cshowsPrec :: forall t h p c.
(Show t, Show h, Show p, Show c) =>
Int -> Branch' t h p c -> ShowS
showsPrec :: Int -> Branch' t h p c -> ShowS
$cshow :: forall t h p c.
(Show t, Show h, Show p, Show c) =>
Branch' t h p c -> String
show :: Branch' t h p c -> String
$cshowList :: forall t h p c.
(Show t, Show h, Show p, Show c) =>
[Branch' t h p c] -> ShowS
showList :: [Branch' t h p c] -> ShowS
Show, (forall x. Branch' t h p c -> Rep (Branch' t h p c) x)
-> (forall x. Rep (Branch' t h p c) x -> Branch' t h p c)
-> Generic (Branch' t h p c)
forall x. Rep (Branch' t h p c) x -> Branch' t h p c
forall x. Branch' t h p c -> Rep (Branch' t h p c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t h p c x. Rep (Branch' t h p c) x -> Branch' t h p c
forall t h p c x. Branch' t h p c -> Rep (Branch' t h p c) x
$cfrom :: forall t h p c x. Branch' t h p c -> Rep (Branch' t h p c) x
from :: forall x. Branch' t h p c -> Rep (Branch' t h p c) x
$cto :: forall t h p c x. Rep (Branch' t h p c) x -> Branch' t h p c
to :: forall x. Rep (Branch' t h p c) x -> Branch' t h p c
Generic)

-- | A V3 branch; see U.Codebase.BranchV3
data GBranchV3 t h c = BranchV3
  { forall t h c. GBranchV3 t h c -> Map t c
children :: !(Map t c),
    forall t h c. GBranchV3 t h c -> Map t (Referent'' t h)
terms :: !(Map t (Referent'' t h)),
    forall t h c. GBranchV3 t h c -> Map t (TypeReference' t h)
types :: !(Map t (TypeReference' t h))
  }
  deriving stock ((forall x. GBranchV3 t h c -> Rep (GBranchV3 t h c) x)
-> (forall x. Rep (GBranchV3 t h c) x -> GBranchV3 t h c)
-> Generic (GBranchV3 t h c)
forall x. Rep (GBranchV3 t h c) x -> GBranchV3 t h c
forall x. GBranchV3 t h c -> Rep (GBranchV3 t h c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t h c x. Rep (GBranchV3 t h c) x -> GBranchV3 t h c
forall t h c x. GBranchV3 t h c -> Rep (GBranchV3 t h c) x
$cfrom :: forall t h c x. GBranchV3 t h c -> Rep (GBranchV3 t h c) x
from :: forall x. GBranchV3 t h c -> Rep (GBranchV3 t h c) x
$cto :: forall t h c x. Rep (GBranchV3 t h c) x -> GBranchV3 t h c
to :: forall x. Rep (GBranchV3 t h c) x -> GBranchV3 t h c
Generic, Int -> GBranchV3 t h c -> ShowS
[GBranchV3 t h c] -> ShowS
GBranchV3 t h c -> String
(Int -> GBranchV3 t h c -> ShowS)
-> (GBranchV3 t h c -> String)
-> ([GBranchV3 t h c] -> ShowS)
-> Show (GBranchV3 t h c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t h c.
(Show t, Show c, Show h) =>
Int -> GBranchV3 t h c -> ShowS
forall t h c.
(Show t, Show c, Show h) =>
[GBranchV3 t h c] -> ShowS
forall t h c. (Show t, Show c, Show h) => GBranchV3 t h c -> String
$cshowsPrec :: forall t h c.
(Show t, Show c, Show h) =>
Int -> GBranchV3 t h c -> ShowS
showsPrec :: Int -> GBranchV3 t h c -> ShowS
$cshow :: forall t h c. (Show t, Show c, Show h) => GBranchV3 t h c -> String
show :: GBranchV3 t h c -> String
$cshowList :: forall t h c.
(Show t, Show c, Show h) =>
[GBranchV3 t h c] -> ShowS
showList :: [GBranchV3 t h c] -> ShowS
Show)

emptyBranch :: Branch' t h p c
emptyBranch :: forall t h p c. Branch' t h p c
emptyBranch = Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c
-> Branch' t h p c
forall t h p c.
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c
-> Branch' t h p c
Branch Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
forall k a. Map k a
Map.empty Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
forall k a. Map k a
Map.empty Map t p
forall k a. Map k a
Map.empty Map t c
forall k a. Map k a
Map.empty

branchHashes_ :: (Ord h', Ord t, Ord h) => Traversal (Branch' t h p c) (Branch' t h' p c) h h'
branchHashes_ :: forall h' t h p c.
(Ord h', Ord t, Ord h) =>
Traversal (Branch' t h p c) (Branch' t h' p c) h h'
branchHashes_ h -> f h'
f Branch {Map t p
Map t c
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
$sel:terms:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
$sel:types:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
$sel:patches:Branch :: forall t h p c. Branch' t h p c -> Map t p
$sel:children:Branch :: forall t h p c. Branch' t h p c -> Map t c
terms :: Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
types :: Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
patches :: Map t p
children :: Map t c
..} = do
  Map t (Map (Referent'' t h') (MetadataSetFormat' t h'))
newTerms <- Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> (Map (Referent'' t h) (MetadataSetFormat' t h)
    -> f (Map (Referent'' t h') (MetadataSetFormat' t h')))
-> f (Map t (Map (Referent'' t h') (MetadataSetFormat' t h')))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms (Traversal
  (Referent'' t h)
  (Referent'' t h')
  (TypeReference' t h)
  (Reference' t h')
-> Traversal
     (MetadataSetFormat' t h)
     (MetadataSetFormat' t h')
     (TypeReference' t h)
     (Reference' t h')
-> Traversal
     (Map (Referent'' t h) (MetadataSetFormat' t h))
     (Map (Referent'' t h') (MetadataSetFormat' t h'))
     (TypeReference' t h)
     (Reference' t h')
forall a' k' k a v v'.
(Ord a', Ord k') =>
Traversal k k' a a'
-> Traversal v v' a a' -> Traversal (Map k v) (Map k' v') a a'
Map.bitraversed (TypeReference' t h -> f (Reference' t h'))
-> Referent'' t h -> f (Referent'' t h')
Traversal
  (Referent'' t h)
  (Referent'' t h')
  (TypeReference' t h)
  (Reference' t h')
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (TypeReference' t h -> f (Reference' t h'))
-> MetadataSetFormat' t h -> f (MetadataSetFormat' t h')
forall t h h'.
(Ord t, Ord h, Ord h') =>
Traversal
  (MetadataSetFormat' t h)
  (MetadataSetFormat' t h')
  (Reference' t h)
  (Reference' t h')
Traversal
  (MetadataSetFormat' t h)
  (MetadataSetFormat' t h')
  (TypeReference' t h)
  (Reference' t h')
metadataSetFormatReferences_ ((TypeReference' t h -> f (Reference' t h'))
 -> Map (Referent'' t h) (MetadataSetFormat' t h)
 -> f (Map (Referent'' t h') (MetadataSetFormat' t h')))
-> ((h -> f h') -> TypeReference' t h -> f (Reference' t h'))
-> (h -> f h')
-> Map (Referent'' t h) (MetadataSetFormat' t h)
-> f (Map (Referent'' t h') (MetadataSetFormat' t h'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (h -> f h') -> TypeReference' t h -> f (Reference' t h')
forall t h h' (f :: * -> *).
Applicative f =>
(h -> f h') -> Reference' t h -> f (Reference' t h')
Reference.h_ ((h -> f h')
 -> Map (Referent'' t h) (MetadataSetFormat' t h)
 -> f (Map (Referent'' t h') (MetadataSetFormat' t h')))
-> (h -> f h')
-> Map (Referent'' t h) (MetadataSetFormat' t h)
-> f (Map (Referent'' t h') (MetadataSetFormat' t h'))
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ h -> f h'
f)
  Map t (Map (Reference' t h') (MetadataSetFormat' t h'))
newTypes <- Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> (Map (TypeReference' t h) (MetadataSetFormat' t h)
    -> f (Map (Reference' t h') (MetadataSetFormat' t h')))
-> f (Map t (Map (Reference' t h') (MetadataSetFormat' t h')))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types (Traversal
  (TypeReference' t h)
  (Reference' t h')
  (TypeReference' t h)
  (Reference' t h')
-> Traversal
     (MetadataSetFormat' t h)
     (MetadataSetFormat' t h')
     (TypeReference' t h)
     (Reference' t h')
-> Traversal
     (Map (TypeReference' t h) (MetadataSetFormat' t h))
     (Map (Reference' t h') (MetadataSetFormat' t h'))
     (TypeReference' t h)
     (Reference' t h')
forall a' k' k a v v'.
(Ord a', Ord k') =>
Traversal k k' a a'
-> Traversal v v' a a' -> Traversal (Map k v) (Map k' v') a a'
Map.bitraversed (TypeReference' t h -> f (Reference' t h'))
-> TypeReference' t h -> f (Reference' t h')
forall a. a -> a
Traversal
  (TypeReference' t h)
  (Reference' t h')
  (TypeReference' t h)
  (Reference' t h')
id (TypeReference' t h -> f (Reference' t h'))
-> MetadataSetFormat' t h -> f (MetadataSetFormat' t h')
forall t h h'.
(Ord t, Ord h, Ord h') =>
Traversal
  (MetadataSetFormat' t h)
  (MetadataSetFormat' t h')
  (Reference' t h)
  (Reference' t h')
Traversal
  (MetadataSetFormat' t h)
  (MetadataSetFormat' t h')
  (TypeReference' t h)
  (Reference' t h')
metadataSetFormatReferences_ ((TypeReference' t h -> f (Reference' t h'))
 -> Map (TypeReference' t h) (MetadataSetFormat' t h)
 -> f (Map (Reference' t h') (MetadataSetFormat' t h')))
-> ((h -> f h') -> TypeReference' t h -> f (Reference' t h'))
-> (h -> f h')
-> Map (TypeReference' t h) (MetadataSetFormat' t h)
-> f (Map (Reference' t h') (MetadataSetFormat' t h'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (h -> f h') -> TypeReference' t h -> f (Reference' t h')
forall t h h' (f :: * -> *).
Applicative f =>
(h -> f h') -> Reference' t h -> f (Reference' t h')
Reference.h_ ((h -> f h')
 -> Map (TypeReference' t h) (MetadataSetFormat' t h)
 -> f (Map (Reference' t h') (MetadataSetFormat' t h')))
-> (h -> f h')
-> Map (TypeReference' t h) (MetadataSetFormat' t h)
-> f (Map (Reference' t h') (MetadataSetFormat' t h'))
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ h -> f h'
f)
  pure Branch {$sel:terms:Branch :: Map t (Map (Referent'' t h') (MetadataSetFormat' t h'))
terms = Map t (Map (Referent'' t h') (MetadataSetFormat' t h'))
newTerms, $sel:types:Branch :: Map t (Map (Reference' t h') (MetadataSetFormat' t h'))
types = Map t (Map (Reference' t h') (MetadataSetFormat' t h'))
newTypes, Map t p
$sel:patches:Branch :: Map t p
patches :: Map t p
patches, Map t c
$sel:children:Branch :: Map t c
children :: Map t c
children}

patches_ :: Traversal (Branch' t h p c) (Branch' t h p' c) p p'
patches_ :: forall t h p c p' (f :: * -> *).
Applicative f =>
(p -> f p') -> Branch' t h p c -> f (Branch' t h p' c)
patches_ p -> f p'
f Branch {Map t p
Map t c
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
$sel:terms:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
$sel:types:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
$sel:patches:Branch :: forall t h p c. Branch' t h p c -> Map t p
$sel:children:Branch :: forall t h p c. Branch' t h p c -> Map t c
terms :: Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
types :: Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
patches :: Map t p
children :: Map t c
..} = (\Map t p'
newPatches -> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p'
-> Map t c
-> Branch' t h p' c
forall t h p c.
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c
-> Branch' t h p c
Branch Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types Map t p'
newPatches Map t c
children) (Map t p' -> Branch' t h p' c)
-> f (Map t p') -> f (Branch' t h p' c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (p -> f p') -> Map t p -> f (Map t p')
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map t a -> f (Map t b)
traverse p -> f p'
f Map t p
patches

childrenHashes_ :: Traversal (Branch' t h p c) (Branch' t h p c') c c'
childrenHashes_ :: forall t h p c c' (f :: * -> *).
Applicative f =>
(c -> f c') -> Branch' t h p c -> f (Branch' t h p c')
childrenHashes_ c -> f c'
f Branch {Map t p
Map t c
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
$sel:terms:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
$sel:types:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
$sel:patches:Branch :: forall t h p c. Branch' t h p c -> Map t p
$sel:children:Branch :: forall t h p c. Branch' t h p c -> Map t c
terms :: Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
types :: Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
patches :: Map t p
children :: Map t c
..} = Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c'
-> Branch' t h p c'
forall t h p c.
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c
-> Branch' t h p c
Branch Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types Map t p
patches (Map t c' -> Branch' t h p c')
-> f (Map t c') -> f (Branch' t h p c')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> f c') -> Map t c -> f (Map t c')
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map t a -> f (Map t b)
traverse c -> f c'
f Map t c
children

branchCausalHashes_ :: Traversal (Branch' t h p c) (Branch' t h p c') c c'
branchCausalHashes_ :: forall t h p c c' (f :: * -> *).
Applicative f =>
(c -> f c') -> Branch' t h p c -> f (Branch' t h p c')
branchCausalHashes_ c -> f c'
f Branch {Map t p
Map t c
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
$sel:terms:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
$sel:types:Branch :: forall t h p c.
Branch' t h p c
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
$sel:patches:Branch :: forall t h p c. Branch' t h p c -> Map t p
$sel:children:Branch :: forall t h p c. Branch' t h p c -> Map t c
terms :: Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
types :: Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
patches :: Map t p
children :: Map t c
..} =
  Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c'
-> Branch' t h p c'
forall t h p c.
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c
-> Branch' t h p c
Branch Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types Map t p
patches (Map t c' -> Branch' t h p c')
-> f (Map t c') -> f (Branch' t h p c')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> f c') -> Map t c -> f (Map t c')
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map t a -> f (Map t b)
traverse c -> f c'
f Map t c
children

type LocalMetadataSet = MetadataSetFormat' LocalTextId LocalDefnId

type DbMetadataSet = MetadataSetFormat' TextId ObjectId

data MetadataSetFormat' t h = Inline (Set (Reference' t h))
  deriving (Int -> MetadataSetFormat' t h -> ShowS
[MetadataSetFormat' t h] -> ShowS
MetadataSetFormat' t h -> String
(Int -> MetadataSetFormat' t h -> ShowS)
-> (MetadataSetFormat' t h -> String)
-> ([MetadataSetFormat' t h] -> ShowS)
-> Show (MetadataSetFormat' t h)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t h.
(Show t, Show h) =>
Int -> MetadataSetFormat' t h -> ShowS
forall t h. (Show t, Show h) => [MetadataSetFormat' t h] -> ShowS
forall t h. (Show t, Show h) => MetadataSetFormat' t h -> String
$cshowsPrec :: forall t h.
(Show t, Show h) =>
Int -> MetadataSetFormat' t h -> ShowS
showsPrec :: Int -> MetadataSetFormat' t h -> ShowS
$cshow :: forall t h. (Show t, Show h) => MetadataSetFormat' t h -> String
show :: MetadataSetFormat' t h -> String
$cshowList :: forall t h. (Show t, Show h) => [MetadataSetFormat' t h] -> ShowS
showList :: [MetadataSetFormat' t h] -> ShowS
Show)

metadataSetFormatReferences_ ::
  (Ord t, Ord h, Ord h') =>
  Traversal (MetadataSetFormat' t h) (MetadataSetFormat' t h') (Reference' t h) (Reference' t h')
metadataSetFormatReferences_ :: forall t h h'.
(Ord t, Ord h, Ord h') =>
Traversal
  (MetadataSetFormat' t h)
  (MetadataSetFormat' t h')
  (Reference' t h)
  (Reference' t h')
metadataSetFormatReferences_ Reference' t h -> f (Reference' t h')
f (Inline Set (Reference' t h)
refs) = Set (Reference' t h') -> MetadataSetFormat' t h'
forall t h. Set (Reference' t h) -> MetadataSetFormat' t h
Inline (Set (Reference' t h') -> MetadataSetFormat' t h')
-> f (Set (Reference' t h')) -> f (MetadataSetFormat' t h')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference' t h -> f (Reference' t h'))
-> Set (Reference' t h) -> f (Set (Reference' t h'))
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse Reference' t h -> f (Reference' t h')
f Set (Reference' t h)
refs

quadmap :: forall t h p c t' h' p' c'. (Ord t', Ord h') => (t -> t') -> (h -> h') -> (p -> p') -> (c -> c') -> Branch' t h p c -> Branch' t' h' p' c'
quadmap :: forall t h p c t' h' p' c'.
(Ord t', Ord h') =>
(t -> t')
-> (h -> h')
-> (p -> p')
-> (c -> c')
-> Branch' t h p c
-> Branch' t' h' p' c'
quadmap t -> t'
ft h -> h'
fh p -> p'
fp c -> c'
fc Branch' t h p c
branch =
  Identity (Branch' t' h' p' c') -> Branch' t' h' p' c'
forall a. Identity a -> a
runIdentity (Identity (Branch' t' h' p' c') -> Branch' t' h' p' c')
-> Identity (Branch' t' h' p' c') -> Branch' t' h' p' c'
forall a b. (a -> b) -> a -> b
$ (t -> Identity t')
-> (h -> Identity h')
-> (p -> Identity p')
-> (c -> Identity c')
-> Branch' t h p c
-> Identity (Branch' t' h' p' c')
forall t h p c t' h' p' c' (m :: * -> *).
(Ord t', Ord h', Applicative m) =>
(t -> m t')
-> (h -> m h')
-> (p -> m p')
-> (c -> m c')
-> Branch' t h p c
-> m (Branch' t' h' p' c')
quadmapM (t' -> Identity t'
forall a. a -> Identity a
Identity (t' -> Identity t') -> (t -> t') -> t -> Identity t'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t'
ft) (h' -> Identity h'
forall a. a -> Identity a
Identity (h' -> Identity h') -> (h -> h') -> h -> Identity h'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h -> h'
fh) (p' -> Identity p'
forall a. a -> Identity a
Identity (p' -> Identity p') -> (p -> p') -> p -> Identity p'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> p'
fp) (c' -> Identity c'
forall a. a -> Identity a
Identity (c' -> Identity c') -> (c -> c') -> c -> Identity c'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> c'
fc) Branch' t h p c
branch

quadmapM :: forall t h p c t' h' p' c' m. (Ord t', Ord h', Applicative m) => (t -> m t') -> (h -> m h') -> (p -> m p') -> (c -> m c') -> Branch' t h p c -> m (Branch' t' h' p' c')
quadmapM :: forall t h p c t' h' p' c' (m :: * -> *).
(Ord t', Ord h', Applicative m) =>
(t -> m t')
-> (h -> m h')
-> (p -> m p')
-> (c -> m c')
-> Branch' t h p c
-> m (Branch' t' h' p' c')
quadmapM t -> m t'
ft h -> m h'
fh p -> m p'
fp c -> m c'
fc (Branch Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types Map t p
patches Map t c
children) =
  Map
  t'
  (Map
     (Referent' (Reference' t' h') (Reference' t' h'))
     (MetadataSetFormat' t' h'))
-> Map t' (Map (Reference' t' h') (MetadataSetFormat' t' h'))
-> Map t' p'
-> Map t' c'
-> Branch' t' h' p' c'
forall t h p c.
Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> Map t p
-> Map t c
-> Branch' t h p c
Branch
    (Map
   t'
   (Map
      (Referent' (Reference' t' h') (Reference' t' h'))
      (MetadataSetFormat' t' h'))
 -> Map t' (Map (Reference' t' h') (MetadataSetFormat' t' h'))
 -> Map t' p'
 -> Map t' c'
 -> Branch' t' h' p' c')
-> m (Map
        t'
        (Map
           (Referent' (Reference' t' h') (Reference' t' h'))
           (MetadataSetFormat' t' h')))
-> m (Map t' (Map (Reference' t' h') (MetadataSetFormat' t' h'))
      -> Map t' p' -> Map t' c' -> Branch' t' h' p' c')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((t -> m t')
-> (Map (Referent'' t h) (MetadataSetFormat' t h)
    -> m (Map
            (Referent' (Reference' t' h') (Reference' t' h'))
            (MetadataSetFormat' t' h')))
-> Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
-> m (Map
        t'
        (Map
           (Referent' (Reference' t' h') (Reference' t' h'))
           (MetadataSetFormat' t' h')))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse t -> m t'
ft Map (Referent'' t h) (MetadataSetFormat' t h)
-> m (Map
        (Referent' (Reference' t' h') (Reference' t' h'))
        (MetadataSetFormat' t' h'))
doTerms Map t (Map (Referent'' t h) (MetadataSetFormat' t h))
terms)
    m (Map t' (Map (Reference' t' h') (MetadataSetFormat' t' h'))
   -> Map t' p' -> Map t' c' -> Branch' t' h' p' c')
-> m (Map t' (Map (Reference' t' h') (MetadataSetFormat' t' h')))
-> m (Map t' p' -> Map t' c' -> Branch' t' h' p' c')
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((t -> m t')
-> (Map (TypeReference' t h) (MetadataSetFormat' t h)
    -> m (Map (Reference' t' h') (MetadataSetFormat' t' h')))
-> Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
-> m (Map t' (Map (Reference' t' h') (MetadataSetFormat' t' h')))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse t -> m t'
ft Map (TypeReference' t h) (MetadataSetFormat' t h)
-> m (Map (Reference' t' h') (MetadataSetFormat' t' h'))
doTypes Map t (Map (TypeReference' t h) (MetadataSetFormat' t h))
types)
    m (Map t' p' -> Map t' c' -> Branch' t' h' p' c')
-> m (Map t' p') -> m (Map t' c' -> Branch' t' h' p' c')
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((t -> m t') -> (p -> m p') -> Map t p -> m (Map t' p')
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse t -> m t'
ft p -> m p'
fp Map t p
patches)
    m (Map t' c' -> Branch' t' h' p' c')
-> m (Map t' c') -> m (Branch' t' h' p' c')
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((t -> m t') -> (c -> m c') -> Map t c -> m (Map t' c')
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse t -> m t'
ft c -> m c'
fc Map t c
children)
  where
    doTerms :: Map (Referent'' t h) (MetadataSetFormat' t h)
-> m (Map
        (Referent' (Reference' t' h') (Reference' t' h'))
        (MetadataSetFormat' t' h'))
doTerms = (Referent'' t h
 -> m (Referent' (Reference' t' h') (Reference' t' h')))
-> (MetadataSetFormat' t h -> m (MetadataSetFormat' t' h'))
-> Map (Referent'' t h) (MetadataSetFormat' t h)
-> m (Map
        (Referent' (Reference' t' h') (Reference' t' h'))
        (MetadataSetFormat' t' h'))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse ((TypeReference' t h -> m (Reference' t' h'))
-> (TypeReference' t h -> m (Reference' t' h'))
-> Referent'' t h
-> m (Referent' (Reference' t' h') (Reference' t' h'))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Referent' a b -> f (Referent' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((t -> m t')
-> (h -> m h') -> TypeReference' t h -> m (Reference' t' h')
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse t -> m t'
ft h -> m h'
fh) ((t -> m t')
-> (h -> m h') -> TypeReference' t h -> m (Reference' t' h')
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse t -> m t'
ft h -> m h'
fh)) MetadataSetFormat' t h -> m (MetadataSetFormat' t' h')
doMetadata
    doTypes :: Map (TypeReference' t h) (MetadataSetFormat' t h)
-> m (Map (Reference' t' h') (MetadataSetFormat' t' h'))
doTypes = (TypeReference' t h -> m (Reference' t' h'))
-> (MetadataSetFormat' t h -> m (MetadataSetFormat' t' h'))
-> Map (TypeReference' t h) (MetadataSetFormat' t h)
-> m (Map (Reference' t' h') (MetadataSetFormat' t' h'))
forall (f :: * -> *) a' a b b'.
(Applicative f, Ord a') =>
(a -> f a') -> (b -> f b') -> Map a b -> f (Map a' b')
Map.bitraverse ((t -> m t')
-> (h -> m h') -> TypeReference' t h -> m (Reference' t' h')
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse t -> m t'
ft h -> m h'
fh) MetadataSetFormat' t h -> m (MetadataSetFormat' t' h')
doMetadata
    doMetadata :: MetadataSetFormat' t h -> m (MetadataSetFormat' t' h')
doMetadata (Inline Set (TypeReference' t h)
s) = Set (Reference' t' h') -> MetadataSetFormat' t' h'
forall t h. Set (Reference' t h) -> MetadataSetFormat' t h
Inline (Set (Reference' t' h') -> MetadataSetFormat' t' h')
-> m (Set (Reference' t' h')) -> m (MetadataSetFormat' t' h')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeReference' t h -> m (Reference' t' h'))
-> Set (TypeReference' t h) -> m (Set (Reference' t' h'))
forall (f :: * -> *) b a.
(Applicative f, Ord b) =>
(a -> f b) -> Set a -> f (Set b)
Set.traverse ((t -> m t')
-> (h -> m h') -> TypeReference' t h -> m (Reference' t' h')
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reference' a b -> f (Reference' c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse t -> m t'
ft h -> m h'
fh) Set (TypeReference' t h)
s

-- | Traversal over text references in a branch
t_ :: (Ord t', Ord h) => Traversal (Branch' t h p c) (Branch' t' h p c) t t'
t_ :: forall t' h t p c.
(Ord t', Ord h) =>
Traversal (Branch' t h p c) (Branch' t' h p c) t t'
t_ t -> f t'
f = (t -> f t')
-> (h -> f h)
-> (p -> f p)
-> (c -> f c)
-> Branch' t h p c
-> f (Branch' t' h p c)
forall t h p c t' h' p' c' (m :: * -> *).
(Ord t', Ord h', Applicative m) =>
(t -> m t')
-> (h -> m h')
-> (p -> m p')
-> (c -> m c')
-> Branch' t h p c
-> m (Branch' t' h' p' c')
quadmapM t -> f t'
f h -> f h
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure p -> f p
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c -> f c
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Traversal over hash references in a branch
h_ :: (Ord t, Ord h') => Traversal (Branch' t h p c) (Branch' t h' p c) h h'
h_ :: forall t h' h p c.
(Ord t, Ord h') =>
Traversal (Branch' t h p c) (Branch' t h' p c) h h'
h_ h -> f h'
f = (t -> f t)
-> (h -> f h')
-> (p -> f p)
-> (c -> f c)
-> Branch' t h p c
-> f (Branch' t h' p c)
forall t h p c t' h' p' c' (m :: * -> *).
(Ord t', Ord h', Applicative m) =>
(t -> m t')
-> (h -> m h')
-> (p -> m p')
-> (c -> m c')
-> Branch' t h p c
-> m (Branch' t' h' p' c')
quadmapM t -> f t
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure h -> f h'
f p -> f p
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c -> f c
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Traversal over patch references in a branch
p_ :: (Ord t, Ord h) => Traversal (Branch' t h p c) (Branch' t h p' c) p p'
p_ :: forall t h p c p'.
(Ord t, Ord h) =>
Traversal (Branch' t h p c) (Branch' t h p' c) p p'
p_ p -> f p'
f = (t -> f t)
-> (h -> f h)
-> (p -> f p')
-> (c -> f c)
-> Branch' t h p c
-> f (Branch' t h p' c)
forall t h p c t' h' p' c' (m :: * -> *).
(Ord t', Ord h', Applicative m) =>
(t -> m t')
-> (h -> m h')
-> (p -> m p')
-> (c -> m c')
-> Branch' t h p c
-> m (Branch' t' h' p' c')
quadmapM t -> f t
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure h -> f h
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure p -> f p'
f c -> f c
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Traversal over child references in a branch
c_ :: (Ord t, Ord h) => Traversal (Branch' t h p c) (Branch' t h p c') c c'
c_ :: forall t h p c c'.
(Ord t, Ord h) =>
Traversal (Branch' t h p c) (Branch' t h p c') c c'
c_ c -> f c'
f = (t -> f t)
-> (h -> f h)
-> (p -> f p)
-> (c -> f c')
-> Branch' t h p c
-> f (Branch' t h p c')
forall t h p c t' h' p' c' (m :: * -> *).
(Ord t', Ord h', Applicative m) =>
(t -> m t')
-> (h -> m h')
-> (p -> m p')
-> (c -> m c')
-> Branch' t h p c
-> m (Branch' t' h' p' c')
quadmapM t -> f t
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure h -> f h
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure p -> f p
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure c -> f c'
f