{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}

module Unison.Codebase.SqliteCodebase.Branch.Dependencies where

import Data.Map qualified as Map
import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import Data.Set qualified as Set
import U.Codebase.HashTags (CausalHash, PatchHash)
import Unison.Codebase.Branch.Type as Branch
import Unison.Codebase.Causal qualified as Causal
import Unison.Codebase.Patch (Patch)
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.Hash (Hash)
import Unison.NameSegment (NameSegment)
import Unison.Prelude
import Unison.Reference (Reference, pattern Derived)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Util.Relation qualified as R
import Unison.Util.Star2 qualified as Star2

type Branches m = [(CausalHash, m (Branch m))]

data Dependencies = Dependencies
  { Dependencies -> Set PatchHash
patches :: Set PatchHash,
    Dependencies -> Set Hash
terms :: Set Hash,
    Dependencies -> Set Hash
decls :: Set Hash
  }
  deriving (Int -> Dependencies -> ShowS
[Dependencies] -> ShowS
Dependencies -> String
(Int -> Dependencies -> ShowS)
-> (Dependencies -> String)
-> ([Dependencies] -> ShowS)
-> Show Dependencies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dependencies -> ShowS
showsPrec :: Int -> Dependencies -> ShowS
$cshow :: Dependencies -> String
show :: Dependencies -> String
$cshowList :: [Dependencies] -> ShowS
showList :: [Dependencies] -> ShowS
Show)
  deriving ((forall x. Dependencies -> Rep Dependencies x)
-> (forall x. Rep Dependencies x -> Dependencies)
-> Generic Dependencies
forall x. Rep Dependencies x -> Dependencies
forall x. Dependencies -> Rep Dependencies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dependencies -> Rep Dependencies x
from :: forall x. Dependencies -> Rep Dependencies x
$cto :: forall x. Rep Dependencies x -> Dependencies
to :: forall x. Rep Dependencies x -> Dependencies
Generic)
  deriving (NonEmpty Dependencies -> Dependencies
Dependencies -> Dependencies -> Dependencies
(Dependencies -> Dependencies -> Dependencies)
-> (NonEmpty Dependencies -> Dependencies)
-> (forall b. Integral b => b -> Dependencies -> Dependencies)
-> Semigroup Dependencies
forall b. Integral b => b -> Dependencies -> Dependencies
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Dependencies -> Dependencies -> Dependencies
<> :: Dependencies -> Dependencies -> Dependencies
$csconcat :: NonEmpty Dependencies -> Dependencies
sconcat :: NonEmpty Dependencies -> Dependencies
$cstimes :: forall b. Integral b => b -> Dependencies -> Dependencies
stimes :: forall b. Integral b => b -> Dependencies -> Dependencies
Semigroup, Semigroup Dependencies
Dependencies
Semigroup Dependencies =>
Dependencies
-> (Dependencies -> Dependencies -> Dependencies)
-> ([Dependencies] -> Dependencies)
-> Monoid Dependencies
[Dependencies] -> Dependencies
Dependencies -> Dependencies -> Dependencies
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Dependencies
mempty :: Dependencies
$cmappend :: Dependencies -> Dependencies -> Dependencies
mappend :: Dependencies -> Dependencies -> Dependencies
$cmconcat :: [Dependencies] -> Dependencies
mconcat :: [Dependencies] -> Dependencies
Monoid) via GenericSemigroupMonoid Dependencies

data Dependencies' = Dependencies'
  { Dependencies' -> [PatchHash]
patches' :: [PatchHash],
    Dependencies' -> [Hash]
terms' :: [Hash],
    Dependencies' -> [Hash]
decls' :: [Hash]
  }
  deriving (Dependencies' -> Dependencies' -> Bool
(Dependencies' -> Dependencies' -> Bool)
-> (Dependencies' -> Dependencies' -> Bool) -> Eq Dependencies'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dependencies' -> Dependencies' -> Bool
== :: Dependencies' -> Dependencies' -> Bool
$c/= :: Dependencies' -> Dependencies' -> Bool
/= :: Dependencies' -> Dependencies' -> Bool
Eq, Int -> Dependencies' -> ShowS
[Dependencies'] -> ShowS
Dependencies' -> String
(Int -> Dependencies' -> ShowS)
-> (Dependencies' -> String)
-> ([Dependencies'] -> ShowS)
-> Show Dependencies'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dependencies' -> ShowS
showsPrec :: Int -> Dependencies' -> ShowS
$cshow :: Dependencies' -> String
show :: Dependencies' -> String
$cshowList :: [Dependencies'] -> ShowS
showList :: [Dependencies'] -> ShowS
Show)
  deriving ((forall x. Dependencies' -> Rep Dependencies' x)
-> (forall x. Rep Dependencies' x -> Dependencies')
-> Generic Dependencies'
forall x. Rep Dependencies' x -> Dependencies'
forall x. Dependencies' -> Rep Dependencies' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dependencies' -> Rep Dependencies' x
from :: forall x. Dependencies' -> Rep Dependencies' x
$cto :: forall x. Rep Dependencies' x -> Dependencies'
to :: forall x. Rep Dependencies' x -> Dependencies'
Generic)
  deriving (NonEmpty Dependencies' -> Dependencies'
Dependencies' -> Dependencies' -> Dependencies'
(Dependencies' -> Dependencies' -> Dependencies')
-> (NonEmpty Dependencies' -> Dependencies')
-> (forall b. Integral b => b -> Dependencies' -> Dependencies')
-> Semigroup Dependencies'
forall b. Integral b => b -> Dependencies' -> Dependencies'
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Dependencies' -> Dependencies' -> Dependencies'
<> :: Dependencies' -> Dependencies' -> Dependencies'
$csconcat :: NonEmpty Dependencies' -> Dependencies'
sconcat :: NonEmpty Dependencies' -> Dependencies'
$cstimes :: forall b. Integral b => b -> Dependencies' -> Dependencies'
stimes :: forall b. Integral b => b -> Dependencies' -> Dependencies'
Semigroup, Semigroup Dependencies'
Dependencies'
Semigroup Dependencies' =>
Dependencies'
-> (Dependencies' -> Dependencies' -> Dependencies')
-> ([Dependencies'] -> Dependencies')
-> Monoid Dependencies'
[Dependencies'] -> Dependencies'
Dependencies' -> Dependencies' -> Dependencies'
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Dependencies'
mempty :: Dependencies'
$cmappend :: Dependencies' -> Dependencies' -> Dependencies'
mappend :: Dependencies' -> Dependencies' -> Dependencies'
$cmconcat :: [Dependencies'] -> Dependencies'
mconcat :: [Dependencies'] -> Dependencies'
Monoid) via GenericSemigroupMonoid Dependencies'

to' :: Dependencies -> Dependencies'
to' :: Dependencies -> Dependencies'
to' Dependencies {Set PatchHash
Set Hash
$sel:patches:Dependencies :: Dependencies -> Set PatchHash
$sel:terms:Dependencies :: Dependencies -> Set Hash
$sel:decls:Dependencies :: Dependencies -> Set Hash
patches :: Set PatchHash
terms :: Set Hash
decls :: Set Hash
..} = [PatchHash] -> [Hash] -> [Hash] -> Dependencies'
Dependencies' (Set PatchHash -> [PatchHash]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set PatchHash
patches) (Set Hash -> [Hash]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Hash
terms) (Set Hash -> [Hash]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Hash
decls)

fromBranch :: (Applicative m) => Branch m -> (Branches m, Dependencies)
fromBranch :: forall (m :: * -> *).
Applicative m =>
Branch m -> (Branches m, Dependencies)
fromBranch (Branch UnwrappedBranch m
c) = case UnwrappedBranch m
c of
  Causal.One CausalHash
_hh HashFor (Branch0 m)
_eh Branch0 m
e -> Branch0 m -> (Branches m, Dependencies)
forall (m :: * -> *).
Applicative m =>
Branch0 m -> (Branches m, Dependencies)
fromBranch0 Branch0 m
e
  Causal.Cons CausalHash
_hh HashFor (Branch0 m)
_eh Branch0 m
e (CausalHash
h, m (UnwrappedBranch m)
m) -> Branch0 m -> (Branches m, Dependencies)
forall (m :: * -> *).
Applicative m =>
Branch0 m -> (Branches m, Dependencies)
fromBranch0 Branch0 m
e (Branches m, Dependencies)
-> (Branches m, Dependencies) -> (Branches m, Dependencies)
forall a. Semigroup a => a -> a -> a
<> Map CausalHash (m (UnwrappedBranch m))
-> (Branches m, Dependencies)
forall {f :: * -> *} {b} {a} {m :: * -> *}.
(Functor f, Monoid b) =>
Map a (f (UnwrappedBranch m)) -> ([(a, f (Branch m))], b)
fromTails (CausalHash
-> m (UnwrappedBranch m) -> Map CausalHash (m (UnwrappedBranch m))
forall k a. k -> a -> Map k a
Map.singleton CausalHash
h m (UnwrappedBranch m)
m)
  Causal.Merge CausalHash
_hh HashFor (Branch0 m)
_eh Branch0 m
e Map CausalHash (m (UnwrappedBranch m))
tails -> Branch0 m -> (Branches m, Dependencies)
forall (m :: * -> *).
Applicative m =>
Branch0 m -> (Branches m, Dependencies)
fromBranch0 Branch0 m
e (Branches m, Dependencies)
-> (Branches m, Dependencies) -> (Branches m, Dependencies)
forall a. Semigroup a => a -> a -> a
<> Map CausalHash (m (UnwrappedBranch m))
-> (Branches m, Dependencies)
forall {f :: * -> *} {b} {a} {m :: * -> *}.
(Functor f, Monoid b) =>
Map a (f (UnwrappedBranch m)) -> ([(a, f (Branch m))], b)
fromTails Map CausalHash (m (UnwrappedBranch m))
tails
  where
    fromTails :: Map a (f (UnwrappedBranch m)) -> ([(a, f (Branch m))], b)
fromTails Map a (f (UnwrappedBranch m))
m = ([(a
h, UnwrappedBranch m -> Branch m
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch (UnwrappedBranch m -> Branch m)
-> f (UnwrappedBranch m) -> f (Branch m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (UnwrappedBranch m)
mc) | (a
h, f (UnwrappedBranch m)
mc) <- Map a (f (UnwrappedBranch m)) -> [(a, f (UnwrappedBranch m))]
forall k a. Map k a -> [(k, a)]
Map.toList Map a (f (UnwrappedBranch m))
m], b
forall a. Monoid a => a
mempty)

fromBranch0 :: (Applicative m) => Branch0 m -> (Branches m, Dependencies)
fromBranch0 :: forall (m :: * -> *).
Applicative m =>
Branch0 m -> (Branches m, Dependencies)
fromBranch0 Branch0 m
b =
  ( Map NameSegment (Branch m) -> Branches m
forall (m :: * -> *).
Applicative m =>
Map NameSegment (Branch m) -> Branches m
fromChildren (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 m)
  (Map NameSegment (Branch m))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children),
    Star Referent NameSegment -> Dependencies
fromTermsStar (Branch0 m
b Branch0 m
-> Getting
     (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
-> Star Referent NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.terms)
      Dependencies -> Dependencies -> Dependencies
forall a. Semigroup a => a -> a -> a
<> Star Reference NameSegment -> Dependencies
fromTypesStar (Branch0 m
b Branch0 m
-> Getting
     (Star Reference NameSegment)
     (Branch0 m)
     (Star Reference NameSegment)
-> Star Reference NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Reference NameSegment)
  (Branch0 m)
  (Star Reference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Reference NameSegment -> f (Star Reference NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.types)
      Dependencies -> Dependencies -> Dependencies
forall a. Semigroup a => a -> a -> a
<> Map NameSegment (PatchHash, m Patch) -> Dependencies
forall (m :: * -> *).
Map NameSegment (PatchHash, m Patch) -> Dependencies
fromEdits (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (PatchHash, m Patch))
     (Branch0 m)
     (Map NameSegment (PatchHash, m Patch))
-> Map NameSegment (PatchHash, m Patch)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (PatchHash, m Patch))
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (PatchHash, m Patch)
 -> f (Map NameSegment (PatchHash, m Patch)))
-> Branch0 m -> f (Branch0 m)
Branch.edits)
  )
  where
    fromChildren :: (Applicative m) => Map NameSegment (Branch m) -> Branches m
    fromChildren :: forall (m :: * -> *).
Applicative m =>
Map NameSegment (Branch m) -> Branches m
fromChildren Map NameSegment (Branch m)
m = [(Branch m -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch m
b, Branch m -> m (Branch m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branch m
b) | Branch m
b <- Map NameSegment (Branch m) -> [Branch m]
forall a. Map NameSegment a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map NameSegment (Branch m)
m]
    references :: Branch.Star r NameSegment -> [r]
    references :: forall r. Star r NameSegment -> [r]
references = Set r -> [r]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set r -> [r])
-> (Star r NameSegment -> Set r) -> Star r NameSegment -> [r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation r NameSegment -> Set r
forall a b. Relation a b -> Set a
R.dom (Relation r NameSegment -> Set r)
-> (Star r NameSegment -> Relation r NameSegment)
-> Star r NameSegment
-> Set r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Star r NameSegment -> Relation r NameSegment
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
Star2.d1
    mdValues :: Branch.Star r NameSegment -> [Reference]
    mdValues :: forall r. Star r NameSegment -> [Reference]
mdValues = Set Reference -> [Reference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Reference -> [Reference])
-> (Star r NameSegment -> Set Reference)
-> Star r NameSegment
-> [Reference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation r Reference -> Set Reference
forall a b. Relation a b -> Set b
R.ran (Relation r Reference -> Set Reference)
-> (Star r NameSegment -> Relation r Reference)
-> Star r NameSegment
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Star r NameSegment -> Relation r Reference
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d2
Star2.d2
    fromTermsStar :: Branch.Star Referent NameSegment -> Dependencies
    fromTermsStar :: Star Referent NameSegment -> Dependencies
fromTermsStar Star Referent NameSegment
s = Set PatchHash -> Set Hash -> Set Hash -> Dependencies
Dependencies Set PatchHash
forall a. Monoid a => a
mempty Set Hash
terms Set Hash
decls
      where
        terms :: Set Hash
terms =
          [Hash] -> Set Hash
forall a. Ord a => [a] -> Set a
Set.fromList ([Hash] -> Set Hash) -> [Hash] -> Set Hash
forall a b. (a -> b) -> a -> b
$
            [Hash
h | Referent.Ref (Derived Hash
h Pos
_) <- Star Referent NameSegment -> [Referent]
forall r. Star r NameSegment -> [r]
references Star Referent NameSegment
s]
              [Hash] -> [Hash] -> [Hash]
forall a. [a] -> [a] -> [a]
++ [Hash
h | (Derived Hash
h Pos
_) <- Star Referent NameSegment -> [Reference]
forall r. Star r NameSegment -> [Reference]
mdValues Star Referent NameSegment
s]
        decls :: Set Hash
decls =
          [Hash] -> Set Hash
forall a. Ord a => [a] -> Set a
Set.fromList ([Hash] -> Set Hash) -> [Hash] -> Set Hash
forall a b. (a -> b) -> a -> b
$
            [Hash
h | Referent.Con (ConstructorReference (Derived Hash
h Pos
_i) Pos
_) ConstructorType
_ <- Star Referent NameSegment -> [Referent]
forall r. Star r NameSegment -> [r]
references Star Referent NameSegment
s]
    fromTypesStar :: Branch.Star Reference NameSegment -> Dependencies
    fromTypesStar :: Star Reference NameSegment -> Dependencies
fromTypesStar Star Reference NameSegment
s = Set PatchHash -> Set Hash -> Set Hash -> Dependencies
Dependencies Set PatchHash
forall a. Monoid a => a
mempty Set Hash
terms Set Hash
decls
      where
        terms :: Set Hash
terms = [Hash] -> Set Hash
forall a. Ord a => [a] -> Set a
Set.fromList [Hash
h | (Derived Hash
h Pos
_) <- Star Reference NameSegment -> [Reference]
forall r. Star r NameSegment -> [Reference]
mdValues Star Reference NameSegment
s]
        decls :: Set Hash
decls = [Hash] -> Set Hash
forall a. Ord a => [a] -> Set a
Set.fromList [Hash
h | (Derived Hash
h Pos
_) <- Star Reference NameSegment -> [Reference]
forall r. Star r NameSegment -> [r]
references Star Reference NameSegment
s]
    fromEdits :: Map NameSegment (PatchHash, m Patch) -> Dependencies
    fromEdits :: forall (m :: * -> *).
Map NameSegment (PatchHash, m Patch) -> Dependencies
fromEdits Map NameSegment (PatchHash, m Patch)
m = Set PatchHash -> Set Hash -> Set Hash -> Dependencies
Dependencies ([PatchHash] -> Set PatchHash
forall a. Ord a => [a] -> Set a
Set.fromList ([PatchHash] -> Set PatchHash)
-> ([(PatchHash, m Patch)] -> [PatchHash])
-> [(PatchHash, m Patch)]
-> Set PatchHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PatchHash, m Patch) -> PatchHash)
-> [(PatchHash, m Patch)] -> [PatchHash]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatchHash, m Patch) -> PatchHash
forall a b. (a, b) -> a
fst ([(PatchHash, m Patch)] -> Set PatchHash)
-> [(PatchHash, m Patch)] -> Set PatchHash
forall a b. (a -> b) -> a -> b
$ Map NameSegment (PatchHash, m Patch) -> [(PatchHash, m Patch)]
forall a. Map NameSegment a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map NameSegment (PatchHash, m Patch)
m) Set Hash
forall a. Monoid a => a
mempty Set Hash
forall a. Monoid a => a
mempty