{-# LANGUAGE RecordWildCards #-}

module Unison.Codebase.Editor.Propagate
  ( propagateAndApply,
  )
where

import Control.Lens
import Control.Monad.Reader (ask)
import Data.Graph qualified as Graph
import Data.Map qualified as Map
import Data.Set qualified as Set
import U.Codebase.Reference qualified as Reference
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.TypeCheck qualified as Cli (computeTypecheckingEnvironment)
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.Output
import Unison.Codebase.Metadata qualified as Metadata
import Unison.Codebase.Patch (Patch (..))
import Unison.Codebase.Patch qualified as Patch
import Unison.Codebase.TermEdit (TermEdit (..))
import Unison.Codebase.TermEdit qualified as TermEdit
import Unison.Codebase.TermEdit.Typing qualified as TermEdit
import Unison.Codebase.TypeEdit (TypeEdit (..))
import Unison.Codebase.TypeEdit qualified as TypeEdit
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.DataDeclaration (Decl)
import Unison.DataDeclaration qualified as Decl
import Unison.FileParsers qualified as FileParsers
import Unison.Hash (Hash)
import Unison.Hashing.V2.Convert qualified as Hashing
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.NameSegment qualified as NameSegment
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann (..))
import Unison.Prelude
import Unison.Reference (Reference, Reference' (..), TermReference, TypeReference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Result qualified as Result
import Unison.Runtime.IOSource qualified as IOSource
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Typechecker qualified as Typechecker
import Unison.UnisonFile (UnisonFile (..))
import Unison.UnisonFile qualified as UF
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Relation qualified as R
import Unison.Util.Set qualified as Set
import Unison.Util.Star2 qualified as Star2
import Unison.Util.TransitiveClosure (transitiveClosure)
import Unison.Var (Var)
import Unison.WatchKind (WatchKind)

data Edits v = Edits
  { forall v. Edits v -> Map Reference TermEdit
termEdits :: Map Reference TermEdit,
    -- same info as `termEdits` but in more efficient form for calling `Term.updateDependencies`
    forall v. Edits v -> Map Referent Referent
termReplacements :: Map Referent Referent,
    forall v. Edits v -> Map Reference (Term v Ann, Type v Ann)
newTerms :: Map Reference (Term v Ann, Type v Ann),
    forall v. Edits v -> Map Reference TypeEdit
typeEdits :: Map Reference TypeEdit,
    forall v. Edits v -> Map Reference Reference
typeReplacements :: Map Reference Reference,
    forall v. Edits v -> Map Reference (Decl v Ann)
newTypes :: Map Reference (Decl v Ann),
    forall v. Edits v -> Map Referent Referent
constructorReplacements :: Map Referent Referent
  }
  deriving (Edits v -> Edits v -> Bool
(Edits v -> Edits v -> Bool)
-> (Edits v -> Edits v -> Bool) -> Eq (Edits v)
forall v. Var v => Edits v -> Edits v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Var v => Edits v -> Edits v -> Bool
== :: Edits v -> Edits v -> Bool
$c/= :: forall v. Var v => Edits v -> Edits v -> Bool
/= :: Edits v -> Edits v -> Bool
Eq, Int -> Edits v -> ShowS
[Edits v] -> ShowS
Edits v -> String
(Int -> Edits v -> ShowS)
-> (Edits v -> String) -> ([Edits v] -> ShowS) -> Show (Edits v)
forall v. Show v => Int -> Edits v -> ShowS
forall v. Show v => [Edits v] -> ShowS
forall v. Show v => Edits v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Edits v -> ShowS
showsPrec :: Int -> Edits v -> ShowS
$cshow :: forall v. Show v => Edits v -> String
show :: Edits v -> String
$cshowList :: forall v. Show v => [Edits v] -> ShowS
showList :: [Edits v] -> ShowS
Show)

noEdits :: Edits v
noEdits :: forall v. Edits v
noEdits = Map Reference TermEdit
-> Map Referent Referent
-> Map Reference (Term v Ann, Type v Ann)
-> Map Reference TypeEdit
-> Map Reference Reference
-> Map Reference (Decl v Ann)
-> Map Referent Referent
-> Edits v
forall v.
Map Reference TermEdit
-> Map Referent Referent
-> Map Reference (Term v Ann, Type v Ann)
-> Map Reference TypeEdit
-> Map Reference Reference
-> Map Reference (Decl v Ann)
-> Map Referent Referent
-> Edits v
Edits Map Reference TermEdit
forall a. Monoid a => a
mempty Map Referent Referent
forall a. Monoid a => a
mempty Map Reference (Term v Ann, Type v Ann)
forall a. Monoid a => a
mempty Map Reference TypeEdit
forall a. Monoid a => a
mempty Map Reference Reference
forall a. Monoid a => a
mempty Map Reference (Decl v Ann)
forall a. Monoid a => a
mempty Map Referent Referent
forall a. Monoid a => a
mempty

propagateAndApply ::
  Names ->
  Patch ->
  Branch0 IO ->
  Cli (Branch0 IO)
propagateAndApply :: Names -> Patch -> Branch0 IO -> Cli (Branch0 IO)
propagateAndApply Names
rootNames Patch
patch Branch0 IO
branch = do
  Edits Symbol
edits <- Names -> Patch -> Branch0 IO -> Cli (Edits Symbol)
propagate Names
rootNames Patch
patch Branch0 IO
branch
  let f :: Branch0 IO -> Branch0 IO
f = Patch -> Edits Symbol -> Branch0 IO -> Branch0 IO
forall (m :: * -> *).
Applicative m =>
Patch -> Edits Symbol -> Branch0 m -> Branch0 m
applyPropagate Patch
patch Edits Symbol
edits
  (Branch0 IO -> Cli (Branch0 IO)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch0 IO -> Cli (Branch0 IO))
-> (Branch0 IO -> Branch0 IO) -> Branch0 IO -> Cli (Branch0 IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 IO -> Branch0 IO
f (Branch0 IO -> Branch0 IO)
-> (Branch0 IO -> Branch0 IO) -> Branch0 IO -> Branch0 IO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Patch -> Branch0 IO -> Branch0 IO
forall (m :: * -> *).
Applicative m =>
Patch -> Branch0 m -> Branch0 m
applyDeprecations Patch
patch) Branch0 IO
branch

-- This function produces constructor mappings for propagated type updates.
--
-- For instance in `type Foo = Blah Bar | Zoink Nat`, if `Bar` is updated
-- from `Bar#old` to `Bar#new`, `Foo` will be a "propagated update" and
-- we want to map the `Foo#old.Blah` constructor to `Foo#new.Blah`.
--
-- The function works by aligning same-named types and same-named constructors,
-- using the names of the types provided by the two maps and the names
-- of constructors embedded in the data decls themselves.
--
-- This is correct, and relies only on the type and constructor names coming
-- out of the codebase and Decl.unhashComponent being unique, which they are.
--
-- What happens is that the declaration component is pulled out of the codebase,
-- references are converted back to variables, substitutions are made in
-- constructor type signatures, and then the component is rehashed, which
-- re-canonicalizes the constructor orders in a possibly different way.
--
-- The unique names for the types and constructors are just carried through
-- unchanged through this process, so their being the same establishes that they
-- had the same role in the two versions of the cycle.
propagateCtorMapping ::
  (Var v, Show a) =>
  Map v (Reference, Decl v a) ->
  Map v (Reference, Decl.DataDeclaration v a) ->
  Map Referent Referent
propagateCtorMapping :: forall v a.
(Var v, Show a) =>
Map v (Reference, Decl v a)
-> Map v (Reference, DataDeclaration v a) -> Map Referent Referent
propagateCtorMapping Map v (Reference, Decl v a)
oldComponent Map v (Reference, DataDeclaration v a)
newComponent =
  let singletons :: Bool
singletons = Map v (Reference, Decl v a) -> Int
forall k a. Map k a -> Int
Map.size Map v (Reference, Decl v a)
oldComponent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Map v (Reference, DataDeclaration v a) -> Int
forall k a. Map k a -> Int
Map.size Map v (Reference, DataDeclaration v a)
newComponent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      isSingleton :: DataDeclaration v a -> Bool
isSingleton DataDeclaration v a
c = [(a, v, Type v a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(a, v, Type v a)] -> Bool)
-> ([(a, v, Type v a)] -> [(a, v, Type v a)])
-> [(a, v, Type v a)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(a, v, Type v a)] -> [(a, v, Type v a)]
forall a. Int -> [a] -> [a]
drop Int
1 ([(a, v, Type v a)] -> Bool) -> [(a, v, Type v a)] -> Bool
forall a b. (a -> b) -> a -> b
$ DataDeclaration v a -> [(a, v, Type v a)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
Decl.constructors' DataDeclaration v a
c
      r :: Map Referent Referent
r =
        [(Referent, Referent)] -> Map Referent Referent
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Referent
oldCon, Referent
newCon)
            | (v
v1, (Reference
oldR, Decl v a
oldDecl)) <- Map v (Reference, Decl v a) -> [(v, (Reference, Decl v a))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (Reference, Decl v a)
oldComponent,
              (v
v2, (Reference
newR, DataDeclaration v a
newDecl)) <- Map v (Reference, DataDeclaration v a)
-> [(v, (Reference, DataDeclaration v a))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (Reference, DataDeclaration v a)
newComponent,
              v
v1 v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v2 Bool -> Bool -> Bool
|| Bool
singletons,
              let t :: ConstructorType
t = Decl v a -> ConstructorType
forall v a. Decl v a -> ConstructorType
Decl.constructorType Decl v a
oldDecl,
              (ConstructorId
oldC, (a
_, v
ol'Name, Type v a
_)) <- [ConstructorId]
-> [(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ConstructorId
0 ..] ([(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))])
-> [(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))]
forall a b. (a -> b) -> a -> b
$ DataDeclaration v a -> [(a, v, Type v a)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
Decl.constructors' (Decl v a -> DataDeclaration v a
forall v a. Decl v a -> DataDeclaration v a
Decl.asDataDecl Decl v a
oldDecl),
              (ConstructorId
newC, (a
_, v
newName, Type v a
_)) <- [ConstructorId]
-> [(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ConstructorId
0 ..] ([(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))])
-> [(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))]
forall a b. (a -> b) -> a -> b
$ DataDeclaration v a -> [(a, v, Type v a)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
Decl.constructors' DataDeclaration v a
newDecl,
              v
ol'Name v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
newName Bool -> Bool -> Bool
|| (DataDeclaration v a -> Bool
forall {v} {a}. DataDeclaration v a -> Bool
isSingleton (Decl v a -> DataDeclaration v a
forall v a. Decl v a -> DataDeclaration v a
Decl.asDataDecl Decl v a
oldDecl) Bool -> Bool -> Bool
&& DataDeclaration v a -> Bool
forall {v} {a}. DataDeclaration v a -> Bool
isSingleton DataDeclaration v a
newDecl),
              Reference
oldR Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
/= Reference
newR,
              let oldCon :: Referent
oldCon = ConstructorReference -> ConstructorType -> Referent
Referent.Con (Reference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference Reference
oldR ConstructorId
oldC) ConstructorType
t
                  newCon :: Referent
newCon = ConstructorReference -> ConstructorType -> Referent
Referent.Con (Reference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference Reference
newR ConstructorId
newC) ConstructorType
t
          ]
   in if Bool
debugMode then (Text, Map Referent Referent)
-> Map Referent Referent -> Map Referent Referent
forall a b. Show a => a -> b -> b
traceShow (Text
"constructorMappings" :: Text, Map Referent Referent
r) Map Referent Referent
r else Map Referent Referent
r

-- TODO: Use of this function will go away soon, once constructor mappings can be
-- added directly to the patch.
--
-- Given a set of type replacements, this creates a mapping from the constructors
-- of the old type(s) to the constructors of the new types.
--
-- Constructors for the same-unqualified-named type with a same-unqualified-name
-- constructor are mapped to each other.
--
-- If the cycle is size 1 for old and new, then the type names need not be the same,
-- and if the number of constructors is 1, then the constructor names need not
-- be the same.
genInitialCtorMapping :: Names -> Map Reference Reference -> Sqlite.Transaction (Map Referent Referent)
genInitialCtorMapping :: Names
-> Map Reference Reference -> Transaction (Map Referent Referent)
genInitialCtorMapping Names
rootNames Map Reference Reference
initialTypeReplacements = do
  let mappings :: (Reference, Reference) -> Sqlite.Transaction (Map Referent Referent)
      mappings :: (Reference, Reference) -> Transaction (Map Referent Referent)
mappings (Reference
old, Reference
new) = do
        Map Symbol (Reference, Decl Symbol Ann)
old <- Reference -> Transaction (Map Symbol (Reference, Decl Symbol Ann))
unhashTypeComponent Reference
old
        Map Symbol (Reference, DataDeclaration Symbol Ann)
new <- ((Reference, Decl Symbol Ann)
 -> (Reference, DataDeclaration Symbol Ann))
-> Map Symbol (Reference, Decl Symbol Ann)
-> Map Symbol (Reference, DataDeclaration Symbol Ann)
forall a b. (a -> b) -> Map Symbol a -> Map Symbol b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter
  (Reference, Decl Symbol Ann)
  (Reference, DataDeclaration Symbol Ann)
  (Decl Symbol Ann)
  (DataDeclaration Symbol Ann)
-> (Decl Symbol Ann -> DataDeclaration Symbol Ann)
-> (Reference, Decl Symbol Ann)
-> (Reference, DataDeclaration Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Reference, Decl Symbol Ann)
  (Reference, DataDeclaration Symbol Ann)
  (Decl Symbol Ann)
  (DataDeclaration Symbol Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Reference, Decl Symbol Ann)
  (Reference, DataDeclaration Symbol Ann)
  (Decl Symbol Ann)
  (DataDeclaration Symbol Ann)
_2 ((EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> (DataDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> Decl Symbol Ann
-> DataDeclaration Symbol Ann
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall v a. EffectDeclaration v a -> DataDeclaration v a
Decl.toDataDecl DataDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall a. a -> a
id)) (Map Symbol (Reference, Decl Symbol Ann)
 -> Map Symbol (Reference, DataDeclaration Symbol Ann))
-> Transaction (Map Symbol (Reference, Decl Symbol Ann))
-> Transaction (Map Symbol (Reference, DataDeclaration Symbol Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference -> Transaction (Map Symbol (Reference, Decl Symbol Ann))
unhashTypeComponent Reference
new
        pure $ Map Symbol (Reference, Decl Symbol Ann)
-> Map Symbol (Reference, DataDeclaration Symbol Ann)
-> Map Referent Referent
forall v a.
Map v (Reference, Decl v a)
-> Map v (Reference, DataDeclaration v a) -> Map Referent Referent
ctorMapping Map Symbol (Reference, Decl Symbol Ann)
old Map Symbol (Reference, DataDeclaration Symbol Ann)
new
  [Map Referent Referent] -> Map Referent Referent
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([Map Referent Referent] -> Map Referent Referent)
-> Transaction [Map Referent Referent]
-> Transaction (Map Referent Referent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Reference, Reference) -> Transaction (Map Referent Referent))
-> [(Reference, Reference)] -> Transaction [Map Referent Referent]
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) -> [a] -> f [b]
traverse (Reference, Reference) -> Transaction (Map Referent Referent)
mappings (Map Reference Reference -> [(Reference, Reference)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Reference Reference
initialTypeReplacements)
  where
    -- True if the unqualified versions of the names in the two sets overlap
    -- ex: {foo.bar, foo.baz} matches the set {blah.bar}.
    unqualifiedNamesMatch :: Set Name.Name -> Set Name.Name -> Bool
    unqualifiedNamesMatch :: Set Name -> Set Name -> Bool
unqualifiedNamesMatch Set Name
n1 Set Name
n2 | Bool
debugMode Bool -> Bool -> Bool
&& (Text, Set Name, Set Name) -> Bool -> Bool
forall a b. Show a => a -> b -> b
traceShow (Text
"namesMatch" :: Text, Set Name
n1, Set Name
n2) Bool
False = Bool
forall a. HasCallStack => a
undefined
    unqualifiedNamesMatch Set Name
n1 Set Name
n2 =
      (Bool -> Bool
not (Bool -> Bool) -> (Set Name -> Bool) -> Set Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Name -> Bool
forall a. Set a -> Bool
Set.null)
        ( Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
            ((Name -> Name) -> Set Name -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Name -> Name
Name.unqualified Set Name
n1)
            ((Name -> Name) -> Set Name -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Name -> Name
Name.unqualified Set Name
n2)
        )
    ctorNamesMatch :: Referent -> Referent -> Bool
ctorNamesMatch Referent
oldR Referent
newR =
      Set Name -> Set Name -> Bool
unqualifiedNamesMatch
        (Names -> Referent -> Set Name
Names.namesForReferent Names
rootNames Referent
oldR)
        (Names -> Referent -> Set Name
Names.namesForReferent Names
rootNames Referent
newR)

    typeNamesMatch :: Map Reference Reference -> Reference -> Reference -> Bool
typeNamesMatch Map Reference Reference
typeMapping Reference
oldType Reference
newType =
      Reference -> Map Reference Reference -> Maybe Reference
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
oldType Map Reference Reference
typeMapping Maybe Reference -> Maybe Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference -> Maybe Reference
forall a. a -> Maybe a
Just Reference
newType
        Bool -> Bool -> Bool
|| Set Name -> Set Name -> Bool
unqualifiedNamesMatch
          (Names -> Reference -> Set Name
Names.namesForReference Names
rootNames Reference
oldType)
          (Names -> Reference -> Set Name
Names.namesForReference Names
rootNames Reference
oldType)

    ctorMapping ::
      Map v (Reference, Decl v a) ->
      Map v (Reference, Decl.DataDeclaration v a) ->
      Map Referent Referent
    ctorMapping :: forall v a.
Map v (Reference, Decl v a)
-> Map v (Reference, DataDeclaration v a) -> Map Referent Referent
ctorMapping Map v (Reference, Decl v a)
oldComponent Map v (Reference, DataDeclaration v a)
newComponent =
      let singletons :: Bool
singletons = Map v (Reference, Decl v a) -> Int
forall k a. Map k a -> Int
Map.size Map v (Reference, Decl v a)
oldComponent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Map v (Reference, DataDeclaration v a) -> Int
forall k a. Map k a -> Int
Map.size Map v (Reference, DataDeclaration v a)
newComponent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
          isSingleton :: DataDeclaration v a -> Bool
isSingleton DataDeclaration v a
c = [(a, v, Type v a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(a, v, Type v a)] -> Bool)
-> ([(a, v, Type v a)] -> [(a, v, Type v a)])
-> [(a, v, Type v a)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(a, v, Type v a)] -> [(a, v, Type v a)]
forall a. Int -> [a] -> [a]
drop Int
1 ([(a, v, Type v a)] -> Bool) -> [(a, v, Type v a)] -> Bool
forall a b. (a -> b) -> a -> b
$ DataDeclaration v a -> [(a, v, Type v a)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
Decl.constructors' DataDeclaration v a
c
          r :: Map Referent Referent
r =
            [(Referent, Referent)] -> Map Referent Referent
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              [ (Referent
oldCon, Referent
newCon)
                | (v
_, (Reference
oldR, Decl v a
oldDecl)) <- Map v (Reference, Decl v a) -> [(v, (Reference, Decl v a))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (Reference, Decl v a)
oldComponent,
                  (v
_, (Reference
newR, DataDeclaration v a
newDecl)) <- Map v (Reference, DataDeclaration v a)
-> [(v, (Reference, DataDeclaration v a))]
forall k a. Map k a -> [(k, a)]
Map.toList Map v (Reference, DataDeclaration v a)
newComponent,
                  Map Reference Reference -> Reference -> Reference -> Bool
typeNamesMatch Map Reference Reference
initialTypeReplacements Reference
oldR Reference
newR Bool -> Bool -> Bool
|| Bool
singletons,
                  let t :: ConstructorType
t = Decl v a -> ConstructorType
forall v a. Decl v a -> ConstructorType
Decl.constructorType Decl v a
oldDecl,
                  (ConstructorId
oldC, (a, v, Type v a)
_) <- [ConstructorId]
-> [(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ConstructorId
0 ..] ([(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))])
-> [(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))]
forall a b. (a -> b) -> a -> b
$ DataDeclaration v a -> [(a, v, Type v a)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
Decl.constructors' (Decl v a -> DataDeclaration v a
forall v a. Decl v a -> DataDeclaration v a
Decl.asDataDecl Decl v a
oldDecl),
                  (ConstructorId
newC, (a, v, Type v a)
_) <- [ConstructorId]
-> [(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ConstructorId
0 ..] ([(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))])
-> [(a, v, Type v a)] -> [(ConstructorId, (a, v, Type v a))]
forall a b. (a -> b) -> a -> b
$ DataDeclaration v a -> [(a, v, Type v a)]
forall v a. DataDeclaration v a -> [(a, v, Type v a)]
Decl.constructors' DataDeclaration v a
newDecl,
                  let oldCon :: Referent
oldCon = ConstructorReference -> ConstructorType -> Referent
Referent.Con (Reference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference Reference
oldR ConstructorId
oldC) ConstructorType
t
                      newCon :: Referent
newCon = ConstructorReference -> ConstructorType -> Referent
Referent.Con (Reference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference Reference
newR ConstructorId
newC) ConstructorType
t,
                  Referent -> Referent -> Bool
ctorNamesMatch Referent
oldCon Referent
newCon
                    Bool -> Bool -> Bool
|| (DataDeclaration v a -> Bool
forall {v} {a}. DataDeclaration v a -> Bool
isSingleton (Decl v a -> DataDeclaration v a
forall v a. Decl v a -> DataDeclaration v a
Decl.asDataDecl Decl v a
oldDecl) Bool -> Bool -> Bool
&& DataDeclaration v a -> Bool
forall {v} {a}. DataDeclaration v a -> Bool
isSingleton DataDeclaration v a
newDecl),
                  Reference
oldR Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
/= Reference
newR
              ]
       in if Bool
debugMode then (Text, Map Referent Referent)
-> Map Referent Referent -> Map Referent Referent
forall a b. Show a => a -> b -> b
traceShow (Text
"constructorMappings" :: Text, Map Referent Referent
r) Map Referent Referent
r else Map Referent Referent
r

debugMode :: Bool
debugMode :: Bool
debugMode = Bool
False

-- Note: this function adds definitions to the codebase as it propagates.
-- Description:
------------------
-- For any `Reference` in the frontier which has an unconflicted
-- term edit, `old -> new`, replace `old` with `new` in dependents of the
-- frontier, and call `propagate'` recursively on the new frontier if
-- the dependents still typecheck.
--
-- If the term is `Typing.Same`, the dependents don't need to be typechecked.
-- If the term is `Typing.Subtype`, and the dependent only has inferred type,
-- it should be re-typechecked, and the new inferred type should be used.
--
-- This will create a whole bunch of new terms and types in the codebase and
-- move the names onto those new terms. Uses `updateDependencies` to perform
-- the substitutions.
--
-- Algorithm:
----------------
-- compute the frontier relation (dependencies of updated terms and types)
-- for each dirty definition d:
--  for each member c of cycle(d):
--   construct c', an updated c incorporating all edits
--   Add an edit c -> c'
--     and save c' to a `Map Reference Term` or `Map Reference Type`
--     as appropriate
--   Collect all c' into a new cycle and typecheck (TODO: kindcheck) that cycle.
--     If the cycle doesn't check, discard edits to that cycle.
--
-- "dirty" means in need of update
-- "frontier" means updated definitions responsible for the "dirty"
propagate :: Names -> Patch -> Branch0 IO -> Cli (Edits Symbol)
propagate :: Names -> Patch -> Branch0 IO -> Cli (Edits Symbol)
propagate Names
rootNames Patch
patch Branch0 IO
b = case Patch -> Maybe (Map Reference TermEdit, Map Reference TypeEdit)
validatePatch Patch
patch of
  Maybe (Map Reference TermEdit, Map Reference TypeEdit)
Nothing -> do
    Output -> Cli ()
Cli.respond Output
PatchNeedsToBeConflictFree
    pure Edits Symbol
forall v. Edits v
noEdits
  Just (Map Reference TermEdit
initialTermEdits, Map Reference TypeEdit
initialTypeEdits) -> do
    -- TODO: this can be removed once patches have term replacement of type `Referent -> Referent`
    let -- TODO: these are just used for tracing, could be deleted if we don't care
        -- about printing meaningful names for definitions during propagation, or if
        -- we want to just remove the tracing.
        refName :: Reference -> String
refName Reference
r =
          -- could just become show r if we don't care
          let rns :: Set Name
rns =
                Names -> Referent -> Set Name
Names.namesForReferent Names
rootNames (Reference -> Referent
Referent.Ref Reference
r)
                  Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> Names -> Reference -> Set Name
Names.namesForReference Names
rootNames Reference
r
           in case Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Name
rns of
                [] -> Reference -> String
forall a. Show a => a -> String
show Reference
r
                Name
n : [Name]
_ -> Name -> String
forall a. Show a => a -> String
show Name
n
        -- this could also become show r if we're removing the dependency on Names
        referentName :: Referent -> String
referentName Referent
r = case Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Names -> Referent -> Set Name
Names.namesForReferent Names
rootNames Referent
r) of
          [] -> Referent -> String
Referent.toString Referent
r
          Name
n : [Name]
_ -> Name -> String
forall a. Show a => a -> String
show Name
n

    Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask

    Transaction (Edits Symbol) -> Cli (Edits Symbol)
forall a. Transaction a -> Cli a
Cli.runTransaction do
      Set Reference
initialDirty <-
        (Reference -> Transaction (Set Reference))
-> Patch -> (Reference -> Bool) -> Transaction (Set Reference)
forall (m :: * -> *).
Monad m =>
(Reference -> m (Set Reference))
-> Patch -> (Reference -> Bool) -> m (Set Reference)
computeDirty
          (DependentsSelector -> Reference -> Transaction (Set Reference)
Codebase.dependents DependentsSelector
Queries.ExcludeOwnComponent)
          Patch
patch
          -- Dirty reference predicate: does the reference have a name in this branch that isn't in the "lib" namespace?
          (Names -> Reference -> Bool
Names.contains ((Name -> Bool) -> Names -> Names
Names.filter Name -> Bool
nameNotInLibNamespace (Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
b)))

      let initialTypeReplacements :: Map Reference Reference
initialTypeReplacements = (TypeEdit -> Maybe Reference)
-> Map Reference TypeEdit -> Map Reference Reference
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe TypeEdit -> Maybe Reference
TypeEdit.toReference Map Reference TypeEdit
initialTypeEdits
      -- TODO: once patches can directly contain constructor replacements, this
      -- line can turn into a pure function that takes the subset of the term replacements
      -- in the patch which have a `Referent.Con` as their LHS.
      Map Referent Referent
initialCtorMappings <- Names
-> Map Reference Reference -> Transaction (Map Referent Referent)
genInitialCtorMapping Names
rootNames Map Reference Reference
initialTypeReplacements

      Map Reference Int
order <-
        let restrictToTypes :: Set TypeReference
            restrictToTypes :: Set Reference
restrictToTypes =
              Relation Reference Name -> Set Reference
forall a b. Relation a b -> Set a
R.dom ((Name -> Bool)
-> Relation Reference Name -> Relation Reference Name
forall a b.
(Ord a, Ord b) =>
(b -> Bool) -> Relation a b -> Relation a b
R.filterRan Name -> Bool
nameNotInLibNamespace (Branch0 IO -> Relation Reference Name
forall (m :: * -> *). Branch0 m -> Relation Reference Name
Branch.deepTypes Branch0 IO
b))
            restrictToTerms :: Set TermReference
            restrictToTerms :: Set Reference
restrictToTerms =
              (Referent -> Maybe Reference) -> Set Referent -> Set Reference
forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
Set.mapMaybe Referent -> Maybe Reference
forall r. Referent' r -> Maybe r
Referent.toTermReference (Relation Referent Name -> Set Referent
forall a b. Relation a b -> Set a
R.dom ((Name -> Bool) -> Relation Referent Name -> Relation Referent Name
forall a b.
(Ord a, Ord b) =>
(b -> Bool) -> Relation a b -> Relation a b
R.filterRan Name -> Bool
nameNotInLibNamespace (Branch0 IO -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
Branch.deepTerms Branch0 IO
b)))
         in Set Reference -> Set Reference -> Transaction (Map Reference Int)
sortDependentsGraph
              Set Reference
initialDirty
              (Set Reference -> Set Reference -> Set Reference
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Reference
restrictToTypes Set Reference
restrictToTerms)

      let getOrdered :: Set Reference -> Map Int Reference
          getOrdered :: Set Reference -> Map Int Reference
getOrdered Set Reference
rs =
            [(Int, Reference)] -> Map Int Reference
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int
i, Reference
r) | Reference
r <- Set Reference -> [Reference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Reference
rs, Just Int
i <- [Reference -> Map Reference Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Reference
r Map Reference Int
order]]
          collectEdits ::
            Edits Symbol ->
            Set Reference ->
            Map Int Reference ->
            Sqlite.Transaction (Edits Symbol)
          collectEdits :: Edits Symbol
-> Set Reference -> Map Int Reference -> Transaction (Edits Symbol)
collectEdits es :: Edits Symbol
es@Edits {Map Reference (Decl Symbol Ann)
Map Reference (Term Symbol Ann, Type Symbol Ann)
Map Reference Reference
Map Reference TermEdit
Map Reference TypeEdit
Map Referent Referent
$sel:termEdits:Edits :: forall v. Edits v -> Map Reference TermEdit
$sel:termReplacements:Edits :: forall v. Edits v -> Map Referent Referent
$sel:newTerms:Edits :: forall v. Edits v -> Map Reference (Term v Ann, Type v Ann)
$sel:typeEdits:Edits :: forall v. Edits v -> Map Reference TypeEdit
$sel:typeReplacements:Edits :: forall v. Edits v -> Map Reference Reference
$sel:newTypes:Edits :: forall v. Edits v -> Map Reference (Decl v Ann)
$sel:constructorReplacements:Edits :: forall v. Edits v -> Map Referent Referent
termEdits :: Map Reference TermEdit
termReplacements :: Map Referent Referent
newTerms :: Map Reference (Term Symbol Ann, Type Symbol Ann)
typeEdits :: Map Reference TypeEdit
typeReplacements :: Map Reference Reference
newTypes :: Map Reference (Decl Symbol Ann)
constructorReplacements :: Map Referent Referent
..} Set Reference
seen Map Int Reference
todo = case Map Int Reference -> Maybe (Reference, Map Int Reference)
forall k a. Map k a -> Maybe (a, Map k a)
Map.minView Map Int Reference
todo of
            Maybe (Reference, Map Int Reference)
Nothing -> Edits Symbol -> Transaction (Edits Symbol)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Edits Symbol
es
            Just (Reference
r, Map Int Reference
todo) -> case Reference
r of
              ReferenceBuiltin Text
_ -> Edits Symbol
-> Set Reference -> Map Int Reference -> Transaction (Edits Symbol)
collectEdits Edits Symbol
es Set Reference
seen Map Int Reference
todo
              ReferenceDerived Id
_ -> Reference -> Map Int Reference -> Transaction (Edits Symbol)
go Reference
r Map Int Reference
todo
            where
              debugCtors :: String
debugCtors =
                [String] -> String
unlines
                  [ Referent -> String
referentName Referent
old String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" -> " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Referent -> String
referentName Referent
new
                    | (Referent
old, Referent
new) <- Map Referent Referent -> [(Referent, Referent)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Referent Referent
constructorReplacements
                  ]
              go :: Reference -> Map Int Reference -> Transaction (Edits Symbol)
go Reference
r Map Int Reference
_ | Bool
debugMode Bool -> Bool -> Bool
&& (Text, String) -> Bool -> Bool
forall a b. Show a => a -> b -> b
traceShow (Text
"Rewriting: " :: Text, Reference -> String
refName Reference
r) Bool
False = Transaction (Edits Symbol)
forall a. HasCallStack => a
undefined
              go Reference
_ Map Int Reference
_ | Bool
debugMode Bool -> Bool -> Bool
&& String -> Bool -> Bool
forall a. String -> a -> a
trace (String
"** Constructor replacements:\n\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
debugCtors) Bool
False = Transaction (Edits Symbol)
forall a. HasCallStack => a
undefined
              go Reference
r Map Int Reference
todo =
                if Reference -> Map Reference TermEdit -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Reference
r Map Reference TermEdit
termEdits Bool -> Bool -> Bool
|| Reference -> Set Reference -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Reference
r Set Reference
seen Bool -> Bool -> Bool
|| Reference -> Map Reference TypeEdit -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Reference
r Map Reference TypeEdit
typeEdits
                  then Edits Symbol
-> Set Reference -> Map Int Reference -> Transaction (Edits Symbol)
collectEdits Edits Symbol
es Set Reference
seen Map Int Reference
todo
                  else do
                    Bool
haveType <- Codebase IO Symbol Ann -> Reference -> Transaction Bool
forall (m :: * -> *) v a.
Codebase m v a -> Reference -> Transaction Bool
Codebase.isType Codebase IO Symbol Ann
codebase Reference
r
                    Bool
haveTerm <- Codebase IO Symbol Ann -> Reference -> Transaction Bool
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a -> Reference -> Transaction Bool
Codebase.isTerm Codebase IO Symbol Ann
codebase Reference
r
                    let message :: String
message =
                          String
"This reference is not a term nor a type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Reference -> String
forall a. Show a => a -> String
show Reference
r
                        mmayEdits :: Transaction (Maybe (Edits Symbol), Set Reference)
mmayEdits
                          | Bool
haveTerm = Reference -> Transaction (Maybe (Edits Symbol), Set Reference)
doTerm Reference
r
                          | Bool
haveType = Reference -> Transaction (Maybe (Edits Symbol), Set Reference)
doType Reference
r
                          | Bool
otherwise = String -> Transaction (Maybe (Edits Symbol), Set Reference)
forall a. HasCallStack => String -> a
error String
message
                    (Maybe (Edits Symbol), Set Reference)
mayEdits <- Transaction (Maybe (Edits Symbol), Set Reference)
mmayEdits
                    case (Maybe (Edits Symbol), Set Reference)
mayEdits of
                      (Maybe (Edits Symbol)
Nothing, Set Reference
seen') -> Edits Symbol
-> Set Reference -> Map Int Reference -> Transaction (Edits Symbol)
collectEdits Edits Symbol
es Set Reference
seen' Map Int Reference
todo
                      (Just Edits Symbol
edits', Set Reference
seen') -> do
                        -- plan to update the dependents of this component too
                        Set Reference
dependents <- case Reference
r of
                          ReferenceBuiltin {} -> DependentsSelector -> Reference -> Transaction (Set Reference)
Codebase.dependents DependentsSelector
Queries.ExcludeOwnComponent Reference
r
                          Reference.Derived Hash
h ConstructorId
_i -> Hash -> Transaction (Set Reference)
Codebase.dependentsOfComponent Hash
h
                        let todo' :: Map Int Reference
todo' = Map Int Reference
todo Map Int Reference -> Map Int Reference -> Map Int Reference
forall a. Semigroup a => a -> a -> a
<> Set Reference -> Map Int Reference
getOrdered Set Reference
dependents
                        Edits Symbol
-> Set Reference -> Map Int Reference -> Transaction (Edits Symbol)
collectEdits Edits Symbol
edits' Set Reference
seen' Map Int Reference
todo'

              doType :: Reference -> Sqlite.Transaction (Maybe (Edits Symbol), Set Reference)
              doType :: Reference -> Transaction (Maybe (Edits Symbol), Set Reference)
doType Reference
r = do
                Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugMode (Transaction () -> Transaction ())
-> Transaction () -> Transaction ()
forall a b. (a -> b) -> a -> b
$ String -> Transaction ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM (String
"Rewriting type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Reference -> String
refName Reference
r)
                Map Symbol (Reference, Decl Symbol Ann)
componentMap <- Reference -> Transaction (Map Symbol (Reference, Decl Symbol Ann))
unhashTypeComponent Reference
r
                let componentMap' :: Map Symbol (Reference, Decl Symbol Ann)
componentMap' =
                      ASetter
  (Reference, Decl Symbol Ann)
  (Reference, Decl Symbol Ann)
  (Decl Symbol Ann)
  (Decl Symbol Ann)
-> (Decl Symbol Ann -> Decl Symbol Ann)
-> (Reference, Decl Symbol Ann)
-> (Reference, Decl Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Reference, Decl Symbol Ann)
  (Reference, Decl Symbol Ann)
  (Decl Symbol Ann)
  (Decl Symbol Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Reference, Decl Symbol Ann)
  (Reference, Decl Symbol Ann)
  (Decl Symbol Ann)
  (Decl Symbol Ann)
_2 (Map Reference Reference -> Decl Symbol Ann -> Decl Symbol Ann
forall v a.
Ord v =>
Map Reference Reference -> Decl v a -> Decl v a
Decl.updateDependencies Map Reference Reference
typeReplacements)
                        ((Reference, Decl Symbol Ann) -> (Reference, Decl Symbol Ann))
-> Map Symbol (Reference, Decl Symbol Ann)
-> Map Symbol (Reference, Decl Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Symbol (Reference, Decl Symbol Ann)
componentMap
                    declMap :: Map Symbol (Reference, DataDeclaration Symbol Ann)
declMap = ASetter
  (Reference, Decl Symbol Ann)
  (Reference, DataDeclaration Symbol Ann)
  (Decl Symbol Ann)
  (DataDeclaration Symbol Ann)
-> (Decl Symbol Ann -> DataDeclaration Symbol Ann)
-> (Reference, Decl Symbol Ann)
-> (Reference, DataDeclaration Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Reference, Decl Symbol Ann)
  (Reference, DataDeclaration Symbol Ann)
  (Decl Symbol Ann)
  (DataDeclaration Symbol Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Reference, Decl Symbol Ann)
  (Reference, DataDeclaration Symbol Ann)
  (Decl Symbol Ann)
  (DataDeclaration Symbol Ann)
_2 ((EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> (DataDeclaration Symbol Ann -> DataDeclaration Symbol Ann)
-> Decl Symbol Ann
-> DataDeclaration Symbol Ann
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EffectDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall v a. EffectDeclaration v a -> DataDeclaration v a
Decl.toDataDecl DataDeclaration Symbol Ann -> DataDeclaration Symbol Ann
forall a. a -> a
id) ((Reference, Decl Symbol Ann)
 -> (Reference, DataDeclaration Symbol Ann))
-> Map Symbol (Reference, Decl Symbol Ann)
-> Map Symbol (Reference, DataDeclaration Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Symbol (Reference, Decl Symbol Ann)
componentMap'
                    -- TODO: kind-check the new components
                    hashedDecls :: Either
  (Seq (ResolutionFailure Ann))
  [(Symbol, Reference, DataDeclaration Symbol Ann)]
hashedDecls =
                      (([(Symbol, Id, DataDeclaration Symbol Ann)]
 -> [(Symbol, Reference, DataDeclaration Symbol Ann)])
-> Either
     (Seq (ResolutionFailure Ann))
     [(Symbol, Id, DataDeclaration Symbol Ann)]
-> Either
     (Seq (ResolutionFailure Ann))
     [(Symbol, Reference, DataDeclaration Symbol Ann)]
forall a b.
(a -> b)
-> Either (Seq (ResolutionFailure Ann)) a
-> Either (Seq (ResolutionFailure Ann)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(Symbol, Id, DataDeclaration Symbol Ann)]
  -> [(Symbol, Reference, DataDeclaration Symbol Ann)])
 -> Either
      (Seq (ResolutionFailure Ann))
      [(Symbol, Id, DataDeclaration Symbol Ann)]
 -> Either
      (Seq (ResolutionFailure Ann))
      [(Symbol, Reference, DataDeclaration Symbol Ann)])
-> (((Symbol, Id, DataDeclaration Symbol Ann)
     -> (Symbol, Reference, DataDeclaration Symbol Ann))
    -> [(Symbol, Id, DataDeclaration Symbol Ann)]
    -> [(Symbol, Reference, DataDeclaration Symbol Ann)])
-> ((Symbol, Id, DataDeclaration Symbol Ann)
    -> (Symbol, Reference, DataDeclaration Symbol Ann))
-> Either
     (Seq (ResolutionFailure Ann))
     [(Symbol, Id, DataDeclaration Symbol Ann)]
-> Either
     (Seq (ResolutionFailure Ann))
     [(Symbol, Reference, DataDeclaration Symbol Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Symbol, Id, DataDeclaration Symbol Ann)
 -> (Symbol, Reference, DataDeclaration Symbol Ann))
-> [(Symbol, Id, DataDeclaration Symbol Ann)]
-> [(Symbol, Reference, DataDeclaration Symbol Ann)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (ASetter
  (Symbol, Id, DataDeclaration Symbol Ann)
  (Symbol, Reference, DataDeclaration Symbol Ann)
  Id
  Reference
-> (Id -> Reference)
-> (Symbol, Id, DataDeclaration Symbol Ann)
-> (Symbol, Reference, DataDeclaration Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Symbol, Id, DataDeclaration Symbol Ann)
  (Symbol, Reference, DataDeclaration Symbol Ann)
  Id
  Reference
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Symbol, Id, DataDeclaration Symbol Ann)
  (Symbol, Reference, DataDeclaration Symbol Ann)
  Id
  Reference
_2 Id -> Reference
forall h t. Id' h -> Reference' t h
DerivedId)
                        (Either
   (Seq (ResolutionFailure Ann))
   [(Symbol, Id, DataDeclaration Symbol Ann)]
 -> Either
      (Seq (ResolutionFailure Ann))
      [(Symbol, Reference, DataDeclaration Symbol Ann)])
-> (Map Symbol (DataDeclaration Symbol Ann)
    -> Either
         (Seq (ResolutionFailure Ann))
         [(Symbol, Id, DataDeclaration Symbol Ann)])
-> Map Symbol (DataDeclaration Symbol Ann)
-> Either
     (Seq (ResolutionFailure Ann))
     [(Symbol, Reference, DataDeclaration Symbol Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Symbol (DataDeclaration Symbol Ann)
-> Either
     (Seq (ResolutionFailure Ann))
     [(Symbol, Id, DataDeclaration Symbol Ann)]
forall v a.
Var v =>
Map v (DataDeclaration v a)
-> ResolutionResult a [(v, Id, DataDeclaration v a)]
Hashing.hashDataDecls
                        (Map Symbol (DataDeclaration Symbol Ann)
 -> Either
      (Seq (ResolutionFailure Ann))
      [(Symbol, Reference, DataDeclaration Symbol Ann)])
-> Map Symbol (DataDeclaration Symbol Ann)
-> Either
     (Seq (ResolutionFailure Ann))
     [(Symbol, Reference, DataDeclaration Symbol Ann)]
forall a b. (a -> b) -> a -> b
$ Getting
  (DataDeclaration Symbol Ann)
  (Reference, DataDeclaration Symbol Ann)
  (DataDeclaration Symbol Ann)
-> (Reference, DataDeclaration Symbol Ann)
-> DataDeclaration Symbol Ann
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (DataDeclaration Symbol Ann)
  (Reference, DataDeclaration Symbol Ann)
  (DataDeclaration Symbol Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Reference, DataDeclaration Symbol Ann)
  (Reference, DataDeclaration Symbol Ann)
  (DataDeclaration Symbol Ann)
  (DataDeclaration Symbol Ann)
_2 ((Reference, DataDeclaration Symbol Ann)
 -> DataDeclaration Symbol Ann)
-> Map Symbol (Reference, DataDeclaration Symbol Ann)
-> Map Symbol (DataDeclaration Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Symbol (Reference, DataDeclaration Symbol Ann)
declMap
                Map Symbol (Reference, DataDeclaration Symbol Ann)
hashedComponents' <- case Either
  (Seq (ResolutionFailure Ann))
  [(Symbol, Reference, DataDeclaration Symbol Ann)]
hashedDecls of
                  Left Seq (ResolutionFailure Ann)
_ ->
                    String
-> Transaction (Map Symbol (Reference, DataDeclaration Symbol Ann))
forall a. HasCallStack => String -> a
error (String
 -> Transaction
      (Map Symbol (Reference, DataDeclaration Symbol Ann)))
-> String
-> Transaction (Map Symbol (Reference, DataDeclaration Symbol Ann))
forall a b. (a -> b) -> a -> b
$
                      String
"Edit propagation failed because some of the dependencies of "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Reference -> String
forall a. Show a => a -> String
show Reference
r
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" could not be resolved."
                  Right [(Symbol, Reference, DataDeclaration Symbol Ann)]
c -> Map Symbol (Reference, DataDeclaration Symbol Ann)
-> Transaction (Map Symbol (Reference, DataDeclaration Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Symbol (Reference, DataDeclaration Symbol Ann)
 -> Transaction
      (Map Symbol (Reference, DataDeclaration Symbol Ann)))
-> ([(Symbol, (Reference, DataDeclaration Symbol Ann))]
    -> Map Symbol (Reference, DataDeclaration Symbol Ann))
-> [(Symbol, (Reference, DataDeclaration Symbol Ann))]
-> Transaction (Map Symbol (Reference, DataDeclaration Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Symbol, (Reference, DataDeclaration Symbol Ann))]
-> Map Symbol (Reference, DataDeclaration Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Symbol, (Reference, DataDeclaration Symbol Ann))]
 -> Transaction
      (Map Symbol (Reference, DataDeclaration Symbol Ann)))
-> [(Symbol, (Reference, DataDeclaration Symbol Ann))]
-> Transaction (Map Symbol (Reference, DataDeclaration Symbol Ann))
forall a b. (a -> b) -> a -> b
$ (\(Symbol
v, Reference
r, DataDeclaration Symbol Ann
d) -> (Symbol
v, (Reference
r, DataDeclaration Symbol Ann
d))) ((Symbol, Reference, DataDeclaration Symbol Ann)
 -> (Symbol, (Reference, DataDeclaration Symbol Ann)))
-> [(Symbol, Reference, DataDeclaration Symbol Ann)]
-> [(Symbol, (Reference, DataDeclaration Symbol Ann))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, Reference, DataDeclaration Symbol Ann)]
c
                let -- Relation: (nameOfType, oldRef, newRef, newType)
                    joinedStuff :: [(Symbol, (Reference, Reference, Decl.DataDeclaration Symbol Ann))]
                    joinedStuff :: [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
joinedStuff =
                      Map Symbol (Reference, Reference, DataDeclaration Symbol Ann)
-> [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (((Reference, DataDeclaration Symbol Ann)
 -> (Reference, DataDeclaration Symbol Ann)
 -> (Reference, Reference, DataDeclaration Symbol Ann))
-> Map Symbol (Reference, DataDeclaration Symbol Ann)
-> Map Symbol (Reference, DataDeclaration Symbol Ann)
-> Map Symbol (Reference, Reference, DataDeclaration Symbol Ann)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (Reference, DataDeclaration Symbol Ann)
-> (Reference, DataDeclaration Symbol Ann)
-> (Reference, Reference, DataDeclaration Symbol Ann)
forall {a} {b} {b} {c}. (a, b) -> (b, c) -> (a, b, c)
f Map Symbol (Reference, DataDeclaration Symbol Ann)
declMap Map Symbol (Reference, DataDeclaration Symbol Ann)
hashedComponents')
                    f :: (a, b) -> (b, c) -> (a, b, c)
f (a
oldRef, b
_) (b
newRef, c
newType) = (a
oldRef, b
newRef, c
newType)
                    typeEdits' :: Map Reference TypeEdit
typeEdits' = Map Reference TypeEdit
typeEdits Map Reference TypeEdit
-> Map Reference TypeEdit -> Map Reference TypeEdit
forall a. Semigroup a => a -> a -> a
<> ([(Reference, TypeEdit)] -> Map Reference TypeEdit
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, TypeEdit)] -> Map Reference TypeEdit)
-> ([(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
    -> [(Reference, TypeEdit)])
-> [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
-> Map Reference TypeEdit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
 -> (Reference, TypeEdit))
-> [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
-> [(Reference, TypeEdit)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
-> (Reference, TypeEdit)
forall {a} {a} {c}. (a, (a, Reference, c)) -> (a, TypeEdit)
toEdit) [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
joinedStuff
                    toEdit :: (a, (a, Reference, c)) -> (a, TypeEdit)
toEdit (a
_, (a
r, Reference
r', c
_)) = (a
r, Reference -> TypeEdit
TypeEdit.Replace Reference
r')
                    typeReplacements' :: Map Reference Reference
typeReplacements' =
                      Map Reference Reference
typeReplacements
                        Map Reference Reference
-> Map Reference Reference -> Map Reference Reference
forall a. Semigroup a => a -> a -> a
<> ([(Reference, Reference)] -> Map Reference Reference
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, Reference)] -> Map Reference Reference)
-> ([(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
    -> [(Reference, Reference)])
-> [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
-> Map Reference Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
 -> (Reference, Reference))
-> [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
-> [(Reference, Reference)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
-> (Reference, Reference)
forall {a} {a} {b} {c}. (a, (a, b, c)) -> (a, b)
toReplacement) [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
joinedStuff
                    toReplacement :: (a, (a, b, c)) -> (a, b)
toReplacement (a
_, (a
r, b
r', c
_)) = (a
r, b
r')
                    -- New types this iteration
                    newNewTypes :: Map Reference (Decl Symbol Ann)
newNewTypes = ([(Reference, Decl Symbol Ann)] -> Map Reference (Decl Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, Decl Symbol Ann)] -> Map Reference (Decl Symbol Ann))
-> ([(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
    -> [(Reference, Decl Symbol Ann)])
-> [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
-> Map Reference (Decl Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
 -> (Reference, Decl Symbol Ann))
-> [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
-> [(Reference, Decl Symbol Ann)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
-> (Reference, Decl Symbol Ann)
toNewType) [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
joinedStuff
                    -- Accumulated new types
                    newTypes' :: Map Reference (Decl Symbol Ann)
newTypes' = Map Reference (Decl Symbol Ann)
newTypes Map Reference (Decl Symbol Ann)
-> Map Reference (Decl Symbol Ann)
-> Map Reference (Decl Symbol Ann)
forall a. Semigroup a => a -> a -> a
<> Map Reference (Decl Symbol Ann)
newNewTypes
                    toNewType :: (Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
-> (Reference, Decl Symbol Ann)
toNewType (Symbol
v, (Reference
_, Reference
r', DataDeclaration Symbol Ann
tp)) =
                      ( Reference
r',
                        case Symbol
-> Map Symbol (Reference, Decl Symbol Ann)
-> Maybe (Reference, Decl Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
v Map Symbol (Reference, Decl Symbol Ann)
componentMap of
                          Just (Reference
_, Left EffectDeclaration Symbol Ann
_) -> EffectDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. a -> Either a b
Left (DataDeclaration Symbol Ann -> EffectDeclaration Symbol Ann
forall v a. DataDeclaration v a -> EffectDeclaration v a
Decl.EffectDeclaration DataDeclaration Symbol Ann
tp)
                          Just (Reference
_, Right DataDeclaration Symbol Ann
_) -> DataDeclaration Symbol Ann -> Decl Symbol Ann
forall a b. b -> Either a b
Right DataDeclaration Symbol Ann
tp
                          Maybe (Reference, Decl Symbol Ann)
_ -> String -> Decl Symbol Ann
forall a. HasCallStack => String -> a
error String
"It's not gone well!"
                      )
                    seen' :: Set Reference
seen' = Set Reference
seen Set Reference -> Set Reference -> Set Reference
forall a. Semigroup a => a -> a -> a
<> [Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
Set.fromList (Getting
  Reference
  (Reference, Reference, DataDeclaration Symbol Ann)
  Reference
-> (Reference, Reference, DataDeclaration Symbol Ann) -> Reference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  Reference
  (Reference, Reference, DataDeclaration Symbol Ann)
  Reference
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Reference, Reference, DataDeclaration Symbol Ann)
  (Reference, Reference, DataDeclaration Symbol Ann)
  Reference
  Reference
_1 ((Reference, Reference, DataDeclaration Symbol Ann) -> Reference)
-> ((Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
    -> (Reference, Reference, DataDeclaration Symbol Ann))
-> (Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
-> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Reference, Reference, DataDeclaration Symbol Ann)
  (Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
  (Reference, Reference, DataDeclaration Symbol Ann)
-> (Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
-> (Reference, Reference, DataDeclaration Symbol Ann)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Reference, Reference, DataDeclaration Symbol Ann)
  (Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
  (Reference, Reference, DataDeclaration Symbol Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
  (Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
  (Reference, Reference, DataDeclaration Symbol Ann)
  (Reference, Reference, DataDeclaration Symbol Ann)
_2 ((Symbol, (Reference, Reference, DataDeclaration Symbol Ann))
 -> Reference)
-> [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
-> [Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, (Reference, Reference, DataDeclaration Symbol Ann))]
joinedStuff)
                    writeTypes :: [(Reference, Decl Symbol Ann)] -> Transaction ()
writeTypes = ((Reference, Decl Symbol Ann) -> Transaction ())
-> [(Reference, Decl Symbol Ann)] -> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (((Reference, Decl Symbol Ann) -> Transaction ())
 -> [(Reference, Decl Symbol Ann)] -> Transaction ())
-> ((Reference, Decl Symbol Ann) -> Transaction ())
-> [(Reference, Decl Symbol Ann)]
-> Transaction ()
forall a b. (a -> b) -> a -> b
$ \case
                      (ReferenceDerived Id
id, Decl Symbol Ann
tp) -> Codebase IO Symbol Ann -> Id -> Decl Symbol Ann -> Transaction ()
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Decl v a -> Transaction ()
Codebase.putTypeDeclaration Codebase IO Symbol Ann
codebase Id
id Decl Symbol Ann
tp
                      (Reference, Decl Symbol Ann)
_ -> String -> Transaction ()
forall a. HasCallStack => String -> a
error String
"propagate: Expected DerivedId"
                    !newCtorMappings :: Map Referent Referent
newCtorMappings =
                      let r :: Map Referent Referent
r = Map Symbol (Reference, Decl Symbol Ann)
-> Map Symbol (Reference, DataDeclaration Symbol Ann)
-> Map Referent Referent
forall v a.
(Var v, Show a) =>
Map v (Reference, Decl v a)
-> Map v (Reference, DataDeclaration v a) -> Map Referent Referent
propagateCtorMapping Map Symbol (Reference, Decl Symbol Ann)
componentMap Map Symbol (Reference, DataDeclaration Symbol Ann)
hashedComponents'
                       in if Bool
debugMode then (Text, Map Referent Referent)
-> Map Referent Referent -> Map Referent Referent
forall a b. Show a => a -> b -> b
traceShow (Text
"constructorMappings: " :: Text, Map Referent Referent
r) Map Referent Referent
r else Map Referent Referent
r
                    constructorReplacements' :: Map Referent Referent
constructorReplacements' = Map Referent Referent
constructorReplacements Map Referent Referent
-> Map Referent Referent -> Map Referent Referent
forall a. Semigroup a => a -> a -> a
<> Map Referent Referent
newCtorMappings
                [(Reference, Decl Symbol Ann)] -> Transaction ()
writeTypes ([(Reference, Decl Symbol Ann)] -> Transaction ())
-> [(Reference, Decl Symbol Ann)] -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Map Reference (Decl Symbol Ann) -> [(Reference, Decl Symbol Ann)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Reference (Decl Symbol Ann)
newNewTypes
                pure
                  ( Edits Symbol -> Maybe (Edits Symbol)
forall a. a -> Maybe a
Just (Edits Symbol -> Maybe (Edits Symbol))
-> Edits Symbol -> Maybe (Edits Symbol)
forall a b. (a -> b) -> a -> b
$
                      Map Reference TermEdit
-> Map Referent Referent
-> Map Reference (Term Symbol Ann, Type Symbol Ann)
-> Map Reference TypeEdit
-> Map Reference Reference
-> Map Reference (Decl Symbol Ann)
-> Map Referent Referent
-> Edits Symbol
forall v.
Map Reference TermEdit
-> Map Referent Referent
-> Map Reference (Term v Ann, Type v Ann)
-> Map Reference TypeEdit
-> Map Reference Reference
-> Map Reference (Decl v Ann)
-> Map Referent Referent
-> Edits v
Edits
                        Map Reference TermEdit
termEdits
                        (Map Referent Referent
newCtorMappings Map Referent Referent
-> Map Referent Referent -> Map Referent Referent
forall a. Semigroup a => a -> a -> a
<> Map Referent Referent
termReplacements)
                        Map Reference (Term Symbol Ann, Type Symbol Ann)
newTerms
                        Map Reference TypeEdit
typeEdits'
                        Map Reference Reference
typeReplacements'
                        Map Reference (Decl Symbol Ann)
newTypes'
                        Map Referent Referent
constructorReplacements',
                    Set Reference
seen'
                  )
              doTerm :: Reference -> Sqlite.Transaction (Maybe (Edits Symbol), Set Reference)
              doTerm :: Reference -> Transaction (Maybe (Edits Symbol), Set Reference)
doTerm Reference
r = do
                Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugMode (String -> Transaction ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM (String -> Transaction ()) -> String -> Transaction ()
forall a b. (a -> b) -> a -> b
$ String
"Rewriting term: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Reference -> String
forall a. Show a => a -> String
show Reference
r)
                Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
componentMap <- Codebase IO Symbol Ann
-> Reference
-> Transaction
     (Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> Reference
-> Transaction
     (Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann))
unhashTermComponent Codebase IO Symbol Ann
codebase Reference
r
                let seen' :: Set Reference
seen' = Set Reference
seen Set Reference -> Set Reference -> Set Reference
forall a. Semigroup a => a -> a -> a
<> [Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
Set.fromList (Getting
  Reference (Reference, Term Symbol Ann, Type Symbol Ann) Reference
-> (Reference, Term Symbol Ann, Type Symbol Ann) -> Reference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  Reference (Reference, Term Symbol Ann, Type Symbol Ann) Reference
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Reference, Term Symbol Ann, Type Symbol Ann)
  (Reference, Term Symbol Ann, Type Symbol Ann)
  Reference
  Reference
_1 ((Reference, Term Symbol Ann, Type Symbol Ann) -> Reference)
-> [(Reference, Term Symbol Ann, Type Symbol Ann)] -> [Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
-> [(Reference, Term Symbol Ann, Type Symbol Ann)]
forall k a. Map k a -> [a]
Map.elems Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
componentMap)
                Maybe
  (Map
     Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
mayComponent <- do
                  let componentMap' :: Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
componentMap' =
                        ASetter
  (Reference, Term Symbol Ann, Type Symbol Ann)
  (Reference, Term Symbol Ann, Type Symbol Ann)
  (Term Symbol Ann)
  (Term Symbol Ann)
-> (Term Symbol Ann -> Term Symbol Ann)
-> (Reference, Term Symbol Ann, Type Symbol Ann)
-> (Reference, Term Symbol Ann, Type Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
                          ASetter
  (Reference, Term Symbol Ann, Type Symbol Ann)
  (Reference, Term Symbol Ann, Type Symbol Ann)
  (Term Symbol Ann)
  (Term Symbol Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Reference, Term Symbol Ann, Type Symbol Ann)
  (Reference, Term Symbol Ann, Type Symbol Ann)
  (Term Symbol Ann)
  (Term Symbol Ann)
_2
                          (Map Referent Referent
-> Map Reference Reference -> Term Symbol Ann -> Term Symbol Ann
forall v a.
Ord v =>
Map Referent Referent
-> Map Reference Reference -> Term v a -> Term v a
Term.updateDependencies Map Referent Referent
termReplacements Map Reference Reference
typeReplacements)
                          ((Reference, Term Symbol Ann, Type Symbol Ann)
 -> (Reference, Term Symbol Ann, Type Symbol Ann))
-> Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
-> Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
componentMap
                  Codebase IO Symbol Ann
-> Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
-> Edits Symbol
-> Transaction
     (Maybe
        (Map
           Symbol
           (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)))
forall a.
Codebase IO Symbol Ann
-> Map Symbol (Reference, Term Symbol Ann, a)
-> Edits Symbol
-> Transaction
     (Maybe
        (Map
           Symbol
           (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)))
verifyTermComponent Codebase IO Symbol Ann
codebase Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
componentMap' Edits Symbol
es
                case Maybe
  (Map
     Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
mayComponent of
                  Maybe
  (Map
     Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
Nothing -> do
                    Bool -> Transaction () -> Transaction ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugMode (String -> Transaction ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM (String -> Transaction ()) -> String -> Transaction ()
forall a b. (a -> b) -> a -> b
$ Reference -> String
refName Reference
r String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" did not typecheck after substitutions")
                    pure (Maybe (Edits Symbol)
forall a. Maybe a
Nothing, Set Reference
seen')
                  Just Map
  Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
componentMap'' -> do
                    let joinedStuff :: [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
  Type Symbol Ann)]
joinedStuff =
                          Map
  Symbol
  (Reference, Reference, Term Symbol Ann, Type Symbol Ann,
   Type Symbol Ann)
-> [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
     Type Symbol Ann)]
forall a. Map Symbol a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (((Reference, Term Symbol Ann, Type Symbol Ann)
 -> (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
 -> (Reference, Reference, Term Symbol Ann, Type Symbol Ann,
     Type Symbol Ann))
-> Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
-> Map
     Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> Map
     Symbol
     (Reference, Reference, Term Symbol Ann, Type Symbol Ann,
      Type Symbol Ann)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (Reference, Term Symbol Ann, Type Symbol Ann)
-> (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> (Reference, Reference, Term Symbol Ann, Type Symbol Ann,
    Type Symbol Ann)
forall {v} {a} {b} {loc} {b} {b} {c}.
Var v =>
(a, b, Type v loc)
-> (b, b, c, Type v loc) -> (a, b, c, Type v loc, Type v loc)
f Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
componentMap Map
  Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
componentMap'')
                        f :: (a, b, Type v loc)
-> (b, b, c, Type v loc) -> (a, b, c, Type v loc, Type v loc)
f (a
oldRef, b
_oldTerm, Type v loc
oldType) (b
newRef, b
_newWatchKind, c
newTerm, Type v loc
newType) =
                          (a
oldRef, b
newRef, c
newTerm, Type v loc
oldType, Type v loc
newType')
                          where
                            -- Don't replace the type if it hasn't changed.

                            newType' :: Type v loc
newType'
                              | Type v loc -> Type v loc -> Bool
forall v loc. Var v => Type v loc -> Type v loc -> Bool
Typechecker.isEqual Type v loc
oldType Type v loc
newType = Type v loc
oldType
                              | Bool
otherwise = Type v loc
newType
                        -- collect the hashedComponents into edits/replacements/newterms/seen
                        termEdits' :: Map Reference TermEdit
termEdits' =
                          Map Reference TermEdit
termEdits Map Reference TermEdit
-> Map Reference TermEdit -> Map Reference TermEdit
forall a. Semigroup a => a -> a -> a
<> ([(Reference, TermEdit)] -> Map Reference TermEdit
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, TermEdit)] -> Map Reference TermEdit)
-> ([(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
      Type Symbol Ann)]
    -> [(Reference, TermEdit)])
-> [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
     Type Symbol Ann)]
-> Map Reference TermEdit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, Reference, Term Symbol Ann, Type Symbol Ann,
  Type Symbol Ann)
 -> (Reference, TermEdit))
-> [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
     Type Symbol Ann)]
-> [(Reference, TermEdit)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference, Reference, Term Symbol Ann, Type Symbol Ann,
 Type Symbol Ann)
-> (Reference, TermEdit)
forall {v} {a} {c} {loc}.
Var v =>
(a, Reference, c, Type v loc, Type v loc) -> (a, TermEdit)
toEdit) [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
  Type Symbol Ann)]
joinedStuff
                        toEdit :: (a, Reference, c, Type v loc, Type v loc) -> (a, TermEdit)
toEdit (a
r, Reference
r', c
_newTerm, Type v loc
oldType, Type v loc
newType) =
                          (a
r, Reference -> Typing -> TermEdit
TermEdit.Replace Reference
r' (Typing -> TermEdit) -> Typing -> TermEdit
forall a b. (a -> b) -> a -> b
$ Type v loc -> Type v loc -> Typing
forall v loc. Var v => Type v loc -> Type v loc -> Typing
TermEdit.typing Type v loc
newType Type v loc
oldType)
                        termReplacements' :: Map Referent Referent
termReplacements' =
                          Map Referent Referent
termReplacements
                            Map Referent Referent
-> Map Referent Referent -> Map Referent Referent
forall a. Semigroup a => a -> a -> a
<> ([(Referent, Referent)] -> Map Referent Referent
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Referent, Referent)] -> Map Referent Referent)
-> ([(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
      Type Symbol Ann)]
    -> [(Referent, Referent)])
-> [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
     Type Symbol Ann)]
-> Map Referent Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, Reference, Term Symbol Ann, Type Symbol Ann,
  Type Symbol Ann)
 -> (Referent, Referent))
-> [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
     Type Symbol Ann)]
-> [(Referent, Referent)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference, Reference, Term Symbol Ann, Type Symbol Ann,
 Type Symbol Ann)
-> (Referent, Referent)
forall {c} {d} {e}.
(Reference, Reference, c, d, e) -> (Referent, Referent)
toReplacement) [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
  Type Symbol Ann)]
joinedStuff
                        toReplacement :: (Reference, Reference, c, d, e) -> (Referent, Referent)
toReplacement (Reference
r, Reference
r', c
_, d
_, e
_) = (Reference -> Referent
Referent.Ref Reference
r, Reference -> Referent
Referent.Ref Reference
r')
                        newTerms' :: Map Reference (Term Symbol Ann, Type Symbol Ann)
newTerms' =
                          Map Reference (Term Symbol Ann, Type Symbol Ann)
newTerms Map Reference (Term Symbol Ann, Type Symbol Ann)
-> Map Reference (Term Symbol Ann, Type Symbol Ann)
-> Map Reference (Term Symbol Ann, Type Symbol Ann)
forall a. Semigroup a => a -> a -> a
<> ([(Reference, (Term Symbol Ann, Type Symbol Ann))]
-> Map Reference (Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, (Term Symbol Ann, Type Symbol Ann))]
 -> Map Reference (Term Symbol Ann, Type Symbol Ann))
-> ([(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
      Type Symbol Ann)]
    -> [(Reference, (Term Symbol Ann, Type Symbol Ann))])
-> [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
     Type Symbol Ann)]
-> Map Reference (Term Symbol Ann, Type Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Reference, Reference, Term Symbol Ann, Type Symbol Ann,
  Type Symbol Ann)
 -> (Reference, (Term Symbol Ann, Type Symbol Ann)))
-> [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
     Type Symbol Ann)]
-> [(Reference, (Term Symbol Ann, Type Symbol Ann))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference, Reference, Term Symbol Ann, Type Symbol Ann,
 Type Symbol Ann)
-> (Reference, (Term Symbol Ann, Type Symbol Ann))
forall {a} {a} {a} {d} {b}. (a, a, a, d, b) -> (a, (a, b))
toNewTerm) [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
  Type Symbol Ann)]
joinedStuff
                        toNewTerm :: (a, a, a, d, b) -> (a, (a, b))
toNewTerm (a
_, a
r', a
tm, d
_, b
tp) = (a
r', (a
tm, b
tp))
                        writeTerms :: [(Reference, (Term Symbol Ann, Type Symbol Ann))] -> Transaction ()
writeTerms =
                          ((Reference, (Term Symbol Ann, Type Symbol Ann)) -> Transaction ())
-> [(Reference, (Term Symbol Ann, Type Symbol Ann))]
-> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \case
                            (ReferenceDerived Id
id, (Term Symbol Ann
tm, Type Symbol Ann
tp)) -> Codebase IO Symbol Ann
-> Id -> Term Symbol Ann -> Type Symbol Ann -> Transaction ()
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Term v a -> Type v a -> Transaction ()
Codebase.putTerm Codebase IO Symbol Ann
codebase Id
id Term Symbol Ann
tm Type Symbol Ann
tp
                            (Reference, (Term Symbol Ann, Type Symbol Ann))
_ -> String -> Transaction ()
forall a. HasCallStack => String -> a
error String
"propagate: Expected DerivedId"
                    [(Reference, (Term Symbol Ann, Type Symbol Ann))] -> Transaction ()
writeTerms
                      [(Reference
r, (Term Symbol Ann
tm, Type Symbol Ann
ty)) | (Reference
_old, Reference
r, Term Symbol Ann
tm, Type Symbol Ann
_oldTy, Type Symbol Ann
ty) <- [(Reference, Reference, Term Symbol Ann, Type Symbol Ann,
  Type Symbol Ann)]
joinedStuff]
                    pure
                      ( Edits Symbol -> Maybe (Edits Symbol)
forall a. a -> Maybe a
Just (Edits Symbol -> Maybe (Edits Symbol))
-> Edits Symbol -> Maybe (Edits Symbol)
forall a b. (a -> b) -> a -> b
$
                          Map Reference TermEdit
-> Map Referent Referent
-> Map Reference (Term Symbol Ann, Type Symbol Ann)
-> Map Reference TypeEdit
-> Map Reference Reference
-> Map Reference (Decl Symbol Ann)
-> Map Referent Referent
-> Edits Symbol
forall v.
Map Reference TermEdit
-> Map Referent Referent
-> Map Reference (Term v Ann, Type v Ann)
-> Map Reference TypeEdit
-> Map Reference Reference
-> Map Reference (Decl v Ann)
-> Map Referent Referent
-> Edits v
Edits
                            Map Reference TermEdit
termEdits'
                            Map Referent Referent
termReplacements'
                            Map Reference (Term Symbol Ann, Type Symbol Ann)
newTerms'
                            Map Reference TypeEdit
typeEdits
                            Map Reference Reference
typeReplacements
                            Map Reference (Decl Symbol Ann)
newTypes
                            Map Referent Referent
constructorReplacements,
                        Set Reference
seen'
                      )

      Edits Symbol
-> Set Reference -> Map Int Reference -> Transaction (Edits Symbol)
collectEdits
        ( Map Reference TermEdit
-> Map Referent Referent
-> Map Reference (Term Symbol Ann, Type Symbol Ann)
-> Map Reference TypeEdit
-> Map Reference Reference
-> Map Reference (Decl Symbol Ann)
-> Map Referent Referent
-> Edits Symbol
forall v.
Map Reference TermEdit
-> Map Referent Referent
-> Map Reference (Term v Ann, Type v Ann)
-> Map Reference TypeEdit
-> Map Reference Reference
-> Map Reference (Decl v Ann)
-> Map Referent Referent
-> Edits v
Edits
            Map Reference TermEdit
initialTermEdits
            (Map Referent Referent
-> Map Reference TermEdit -> Map Referent Referent
initialTermReplacements Map Referent Referent
initialCtorMappings Map Reference TermEdit
initialTermEdits)
            Map Reference (Term Symbol Ann, Type Symbol Ann)
forall a. Monoid a => a
mempty
            Map Reference TypeEdit
initialTypeEdits
            Map Reference Reference
initialTypeReplacements
            Map Reference (Decl Symbol Ann)
forall a. Monoid a => a
mempty
            Map Referent Referent
initialCtorMappings
        )
        Set Reference
forall a. Monoid a => a
mempty -- things to skip
        (Set Reference -> Map Int Reference
getOrdered Set Reference
initialDirty)
  where
    initialTermReplacements :: Map Referent Referent
-> Map Reference TermEdit -> Map Referent Referent
initialTermReplacements Map Referent Referent
ctors Map Reference TermEdit
es =
      Map Referent Referent
ctors
        Map Referent Referent
-> Map Referent Referent -> Map Referent Referent
forall a. Semigroup a => a -> a -> a
<> ((Reference -> Referent)
-> Map Reference Referent -> Map Referent Referent
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Reference -> Referent
Referent.Ref (Map Reference Referent -> Map Referent Referent)
-> (Map Reference TermEdit -> Map Reference Referent)
-> Map Reference TermEdit
-> Map Referent Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Referent)
-> Map Reference Reference -> Map Reference Referent
forall a b. (a -> b) -> Map Reference a -> Map Reference b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Reference -> Referent
Referent.Ref (Map Reference Reference -> Map Reference Referent)
-> (Map Reference TermEdit -> Map Reference Reference)
-> Map Reference TermEdit
-> Map Reference Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TermEdit -> Maybe Reference)
-> Map Reference TermEdit -> Map Reference Reference
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe TermEdit -> Maybe Reference
TermEdit.toReference) Map Reference TermEdit
es
    sortDependentsGraph :: Set Reference -> Set Reference -> Sqlite.Transaction (Map Reference Int)
    sortDependentsGraph :: Set Reference -> Set Reference -> Transaction (Map Reference Int)
sortDependentsGraph Set Reference
dependencies Set Reference
restrictTo = do
      Set Reference
closure <-
        (Reference -> Transaction (Set Reference))
-> Set Reference -> Transaction (Set Reference)
forall (m :: * -> *) a.
(Monad m, Ord a) =>
(a -> m (Set a)) -> Set a -> m (Set a)
transitiveClosure
          ((Set Reference -> Set Reference)
-> Transaction (Set Reference) -> Transaction (Set Reference)
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set Reference -> Set Reference -> Set Reference
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set Reference
restrictTo) (Transaction (Set Reference) -> Transaction (Set Reference))
-> (Reference -> Transaction (Set Reference))
-> Reference
-> Transaction (Set Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependentsSelector -> Reference -> Transaction (Set Reference)
Codebase.dependents DependentsSelector
Queries.ExcludeOwnComponent)
          Set Reference
dependencies
      [(Reference, Set Reference)]
dependents <-
        (Reference -> Transaction (Reference, Set Reference))
-> [Reference] -> Transaction [(Reference, Set Reference)]
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) -> [a] -> f [b]
traverse
          (\Reference
r -> (Reference
r,) (Set Reference -> (Reference, Set Reference))
-> Transaction (Set Reference)
-> Transaction (Reference, Set Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DependentsSelector -> Reference -> Transaction (Set Reference)
Codebase.dependents DependentsSelector
Queries.ExcludeOwnComponent) Reference
r)
          (Set Reference -> [Reference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Reference
closure)
      let graphEdges :: [(Reference, Reference, [Reference])]
graphEdges = [(Reference
r, Reference
r, Set Reference -> [Reference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set Reference
deps) | (Reference
r, Set Reference
deps) <- [(Reference, Set Reference)] -> [(Reference, Set Reference)]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [(Reference, Set Reference)]
dependents]
          (Graph
graph, Int -> (Reference, Reference, [Reference])
getReference, Reference -> Maybe Int
_) = [(Reference, Reference, [Reference])]
-> (Graph, Int -> (Reference, Reference, [Reference]),
    Reference -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
Graph.graphFromEdges [(Reference, Reference, [Reference])]
graphEdges
      Map Reference Int -> Transaction (Map Reference Int)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Reference Int -> Transaction (Map Reference Int))
-> Map Reference Int -> Transaction (Map Reference Int)
forall a b. (a -> b) -> a -> b
$
        [(Reference, Int)] -> Map Reference Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          ([Reference] -> [Int] -> [(Reference, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Getting Reference (Reference, Reference, [Reference]) Reference
-> (Reference, Reference, [Reference]) -> Reference
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Reference (Reference, Reference, [Reference]) Reference
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Reference, Reference, [Reference])
  (Reference, Reference, [Reference])
  Reference
  Reference
_1 ((Reference, Reference, [Reference]) -> Reference)
-> (Int -> (Reference, Reference, [Reference])) -> Int -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Reference, Reference, [Reference])
getReference (Int -> Reference) -> [Int] -> [Reference]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Graph -> [Int]
Graph.topSort Graph
graph) [Int
0 ..])
    -- vertex i precedes j whenever i has an edge to j and not vice versa.
    -- vertex i precedes j when j is a dependent of i.
    validatePatch ::
      Patch -> Maybe (Map Reference TermEdit, Map Reference TypeEdit)
    validatePatch :: Patch -> Maybe (Map Reference TermEdit, Map Reference TypeEdit)
validatePatch Patch
p =
      (,) (Map Reference TermEdit
 -> Map Reference TypeEdit
 -> (Map Reference TermEdit, Map Reference TypeEdit))
-> Maybe (Map Reference TermEdit)
-> Maybe
     (Map Reference TypeEdit
      -> (Map Reference TermEdit, Map Reference TypeEdit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Relation Reference TermEdit -> Maybe (Map Reference TermEdit)
forall a b. Ord a => Relation a b -> Maybe (Map a b)
R.toMap (Patch -> Relation Reference TermEdit
Patch._termEdits Patch
p) Maybe
  (Map Reference TypeEdit
   -> (Map Reference TermEdit, Map Reference TypeEdit))
-> Maybe (Map Reference TypeEdit)
-> Maybe (Map Reference TermEdit, Map Reference TypeEdit)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Relation Reference TypeEdit -> Maybe (Map Reference TypeEdit)
forall a b. Ord a => Relation a b -> Maybe (Map a b)
R.toMap (Patch -> Relation Reference TypeEdit
Patch._typeEdits Patch
p)

    -- Turns a cycle of references into a term with free vars that we can edit
    -- and hash again.
    -- todo: Maybe this an others can be moved to HandleCommand, in the
    --  Free (Command m i v) monad, passing in the actions that are needed.
    -- However, if we want this to be parametric in the annotation type, then
    -- Command would have to be made parametric in the annotation type too.
    unhashTermComponent ::
      Codebase m Symbol Ann ->
      Reference ->
      Sqlite.Transaction (Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann))
    unhashTermComponent :: forall (m :: * -> *).
Codebase m Symbol Ann
-> Reference
-> Transaction
     (Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann))
unhashTermComponent Codebase m Symbol Ann
codebase Reference
r = case Reference -> Maybe Id
Reference.toId Reference
r of
      Maybe Id
Nothing -> Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
-> Transaction
     (Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
forall a. Monoid a => a
mempty
      Just Id
r -> do
        Map Symbol (Id, Term Symbol Ann, Type Symbol Ann)
unhashed <- Codebase m Symbol Ann
-> Hash
-> Transaction (Map Symbol (Id, Term Symbol Ann, Type Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> Hash
-> Transaction (Map Symbol (Id, Term Symbol Ann, Type Symbol Ann))
unhashTermComponent' Codebase m Symbol Ann
codebase (Id -> Hash
Reference.idToHash Id
r)
        pure $ ((Id, Term Symbol Ann, Type Symbol Ann)
 -> (Reference, Term Symbol Ann, Type Symbol Ann))
-> Map Symbol (Id, Term Symbol Ann, Type Symbol Ann)
-> Map Symbol (Reference, Term Symbol Ann, Type Symbol Ann)
forall a b. (a -> b) -> Map Symbol a -> Map Symbol b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter
  (Id, Term Symbol Ann, Type Symbol Ann)
  (Reference, Term Symbol Ann, Type Symbol Ann)
  Id
  Reference
-> (Id -> Reference)
-> (Id, Term Symbol Ann, Type Symbol Ann)
-> (Reference, Term Symbol Ann, Type Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Id, Term Symbol Ann, Type Symbol Ann)
  (Reference, Term Symbol Ann, Type Symbol Ann)
  Id
  Reference
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Id, Term Symbol Ann, Type Symbol Ann)
  (Reference, Term Symbol Ann, Type Symbol Ann)
  Id
  Reference
_1 Id -> Reference
forall t h. Id' h -> Reference' t h
ReferenceDerived) Map Symbol (Id, Term Symbol Ann, Type Symbol Ann)
unhashed

    unhashTermComponent' ::
      Codebase m Symbol Ann ->
      Hash ->
      Sqlite.Transaction (Map Symbol (Reference.Id, Term Symbol Ann, Type Symbol Ann))
    unhashTermComponent' :: forall (m :: * -> *).
Codebase m Symbol Ann
-> Hash
-> Transaction (Map Symbol (Id, Term Symbol Ann, Type Symbol Ann))
unhashTermComponent' Codebase m Symbol Ann
codebase Hash
h = do
      Maybe [(Term Symbol Ann, Type Symbol Ann)]
maybeTermsWithTypes <- Codebase m Symbol Ann
-> Hash -> Transaction (Maybe [(Term Symbol Ann, Type Symbol Ann)])
forall (m :: * -> *) v a.
Codebase m v a
-> Hash -> Transaction (Maybe [(Term v a, Type v a)])
Codebase.getTermComponentWithTypes Codebase m Symbol Ann
codebase Hash
h
      pure do
        ([(Term Symbol Ann, Type Symbol Ann)]
 -> Map Symbol (Id, Term Symbol Ann, Type Symbol Ann))
-> Maybe [(Term Symbol Ann, Type Symbol Ann)]
-> Map Symbol (Id, Term Symbol Ann, Type Symbol Ann)
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\[(Term Symbol Ann, Type Symbol Ann)]
termsWithTypes -> Map Id (Term Symbol Ann, Type Symbol Ann)
-> Map Symbol (Id, Term Symbol Ann, Type Symbol Ann)
forall {k} {a} {c}.
Var k =>
Map Id (Term k a, c) -> Map k (Id, Term k a, c)
unhash (Map Id (Term Symbol Ann, Type Symbol Ann)
 -> Map Symbol (Id, Term Symbol Ann, Type Symbol Ann))
-> Map Id (Term Symbol Ann, Type Symbol Ann)
-> Map Symbol (Id, Term Symbol Ann, Type Symbol Ann)
forall a b. (a -> b) -> a -> b
$ [(Id, (Term Symbol Ann, Type Symbol Ann))]
-> Map Id (Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Hash
-> [(Term Symbol Ann, Type Symbol Ann)]
-> [(Id, (Term Symbol Ann, Type Symbol Ann))]
forall a. Hash -> [a] -> [(Id, a)]
Reference.componentFor Hash
h [(Term Symbol Ann, Type Symbol Ann)]
termsWithTypes)) Maybe [(Term Symbol Ann, Type Symbol Ann)]
maybeTermsWithTypes
      where
        unhash :: Map Id (Term k a, c) -> Map k (Id, Term k a, c)
unhash Map Id (Term k a, c)
m =
          -- this grabs the corresponding input map values (with types)
          -- and arranges them with the newly unhashed terms.
          let f :: (a, c) -> (a, b) -> (a, b, c)
f (a
_oldTm, c
typ) (a
v, b
newTm) = (a
v, b
newTm, c
typ)
              m' :: Map Id (k, Term k a, c)
m' = ((Term k a, c) -> (k, Term k a) -> (k, Term k a, c))
-> Map Id (Term k a, c)
-> Map Id (k, Term k a)
-> Map Id (k, Term k a, c)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (Term k a, c) -> (k, Term k a) -> (k, Term k a, c)
forall {a} {c} {a} {b}. (a, c) -> (a, b) -> (a, b, c)
f Map Id (Term k a, c)
m (Map Id (Term k a) -> Map Id (k, Term k a)
forall v a. Var v => Map Id (Term v a) -> Map Id (v, Term v a)
Term.unhashComponent ((Term k a, c) -> Term k a
forall a b. (a, b) -> a
fst ((Term k a, c) -> Term k a)
-> Map Id (Term k a, c) -> Map Id (Term k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Id (Term k a, c)
m))
           in [(k, (Id, Term k a, c))] -> Map k (Id, Term k a, c)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [(k
v, (Id
r, Term k a
tm, c
tp)) | (Id
r, (k
v, Term k a
tm, c
tp)) <- Map Id (k, Term k a, c) -> [(Id, (k, Term k a, c))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Id (k, Term k a, c)
m']

    verifyTermComponent ::
      Codebase IO Symbol Ann ->
      Map Symbol (Reference, Term Symbol Ann, a) ->
      Edits Symbol ->
      Sqlite.Transaction (Maybe (Map Symbol (Reference, Maybe WatchKind, Term Symbol Ann, Type Symbol Ann)))
    verifyTermComponent :: forall a.
Codebase IO Symbol Ann
-> Map Symbol (Reference, Term Symbol Ann, a)
-> Edits Symbol
-> Transaction
     (Maybe
        (Map
           Symbol
           (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)))
verifyTermComponent Codebase IO Symbol Ann
codebase Map Symbol (Reference, Term Symbol Ann, a)
componentMap Edits {Map Reference (Decl Symbol Ann)
Map Reference (Term Symbol Ann, Type Symbol Ann)
Map Reference Reference
Map Reference TermEdit
Map Reference TypeEdit
Map Referent Referent
$sel:termEdits:Edits :: forall v. Edits v -> Map Reference TermEdit
$sel:termReplacements:Edits :: forall v. Edits v -> Map Referent Referent
$sel:newTerms:Edits :: forall v. Edits v -> Map Reference (Term v Ann, Type v Ann)
$sel:typeEdits:Edits :: forall v. Edits v -> Map Reference TypeEdit
$sel:typeReplacements:Edits :: forall v. Edits v -> Map Reference Reference
$sel:newTypes:Edits :: forall v. Edits v -> Map Reference (Decl v Ann)
$sel:constructorReplacements:Edits :: forall v. Edits v -> Map Referent Referent
termEdits :: Map Reference TermEdit
termReplacements :: Map Referent Referent
newTerms :: Map Reference (Term Symbol Ann, Type Symbol Ann)
typeEdits :: Map Reference TypeEdit
typeReplacements :: Map Reference Reference
newTypes :: Map Reference (Decl Symbol Ann)
constructorReplacements :: Map Referent Referent
..} = do
      -- If the term contains references to old patterns, we can't update it.
      -- If the term had a redunant type signature, it's discarded and a new type
      -- is inferred. If it wasn't redunant, we have already substituted any updates
      -- into it and we're going to check against that signature.
      --
      -- Note: This only works if the type update is kind-preserving.
      let -- See if the constructor dependencies of any element of the cycle
          -- contains one of the old types.
          terms :: [Term Symbol Ann]
terms = Map Symbol (Term Symbol Ann) -> [Term Symbol Ann]
forall k a. Map k a -> [a]
Map.elems (Map Symbol (Term Symbol Ann) -> [Term Symbol Ann])
-> Map Symbol (Term Symbol Ann) -> [Term Symbol Ann]
forall a b. (a -> b) -> a -> b
$ Getting
  (Term Symbol Ann) (Reference, Term Symbol Ann, a) (Term Symbol Ann)
-> (Reference, Term Symbol Ann, a) -> Term Symbol Ann
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Term Symbol Ann) (Reference, Term Symbol Ann, a) (Term Symbol Ann)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Reference, Term Symbol Ann, a)
  (Reference, Term Symbol Ann, a)
  (Term Symbol Ann)
  (Term Symbol Ann)
_2 ((Reference, Term Symbol Ann, a) -> Term Symbol Ann)
-> Map Symbol (Reference, Term Symbol Ann, a)
-> Map Symbol (Term Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Symbol (Reference, Term Symbol Ann, a)
componentMap
          oldTypes :: Set Reference
oldTypes = Map Reference TypeEdit -> Set Reference
forall k a. Map k a -> Set k
Map.keysSet Map Reference TypeEdit
typeEdits
      if Bool -> Bool
not (Bool -> Bool) -> (Set Reference -> Bool) -> Set Reference -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Reference -> Bool
forall a. Set a -> Bool
Set.null (Set Reference -> Bool) -> Set Reference -> Bool
forall a b. (a -> b) -> a -> b
$
        Set Reference -> Set Reference -> Set Reference
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
          ((Term Symbol Ann -> Set Reference)
-> [Term Symbol Ann] -> Set Reference
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term Symbol Ann -> Set Reference
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set Reference
Term.constructorDependencies [Term Symbol Ann]
terms)
          Set Reference
oldTypes
        then Maybe
  (Map
     Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> Transaction
     (Maybe
        (Map
           Symbol
           (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe
  (Map
     Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
forall a. Maybe a
Nothing
        else do
          let file :: UnisonFile Symbol Ann
file =
                Map Symbol (Id, DataDeclaration Symbol Ann)
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
-> Map Symbol (Ann, Term Symbol Ann)
-> Map String [(Symbol, Ann, Term Symbol Ann)]
-> UnisonFile Symbol Ann
forall v a.
Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a)
-> Map v (a, Term v a)
-> Map String [(v, a, Term v a)]
-> UnisonFile v a
UnisonFileId
                  Map Symbol (Id, DataDeclaration Symbol Ann)
forall a. Monoid a => a
mempty
                  Map Symbol (Id, EffectDeclaration Symbol Ann)
forall a. Monoid a => a
mempty
                  (Map Symbol (Reference, Term Symbol Ann, a)
componentMap Map Symbol (Reference, Term Symbol Ann, a)
-> ((Reference, Term Symbol Ann, a) -> (Ann, Term Symbol Ann))
-> Map Symbol (Ann, Term Symbol Ann)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\(Reference
_ref, Term Symbol Ann
tm, a
_) -> (Ann
External, Term Symbol Ann
tm)))
                  Map String [(Symbol, Ann, Term Symbol Ann)]
forall a. Monoid a => a
mempty
          Env Symbol Ann
typecheckingEnv <- ShouldUseTndr Transaction
-> Codebase IO Symbol Ann
-> [Type Symbol Ann]
-> UnisonFile Symbol Ann
-> Transaction (Env Symbol Ann)
Cli.computeTypecheckingEnvironment ShouldUseTndr Transaction
forall (m :: * -> *). ShouldUseTndr m
FileParsers.ShouldUseTndr'No Codebase IO Symbol Ann
codebase [] UnisonFile Symbol Ann
file
          let typecheckResult :: ResultT
  (Seq (Note Symbol Ann)) Identity (TypecheckedUnisonFile Symbol Ann)
typecheckResult = Env Symbol Ann
-> UnisonFile Symbol Ann
-> ResultT
     (Seq (Note Symbol Ann)) Identity (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Env v Ann
-> UnisonFile v
-> ResultT (Seq (Note v Ann)) m (TypecheckedUnisonFile v Ann)
FileParsers.synthesizeFile Env Symbol Ann
typecheckingEnv UnisonFile Symbol Ann
file
          ResultT
  (Seq (Note Symbol Ann)) Identity (TypecheckedUnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
forall notes a. Result notes a -> Maybe a
Result.result ResultT
  (Seq (Note Symbol Ann)) Identity (TypecheckedUnisonFile Symbol Ann)
typecheckResult
            Maybe (TypecheckedUnisonFile Symbol Ann)
-> (Maybe (TypecheckedUnisonFile Symbol Ann)
    -> Maybe
         (Map
            Symbol
            (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)))
-> Maybe
     (Map
        Symbol
        (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
forall a b. a -> (a -> b) -> b
& (TypecheckedUnisonFile Symbol Ann
 -> Map
      Symbol
      (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Maybe
     (Map
        Symbol
        (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol
     (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Reference, Maybe String, Term v a, Type v a)
UF.hashTerms
            Maybe
  (Map
     Symbol
     (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> (Maybe
      (Map
         Symbol
         (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
    -> Maybe
         (Map
            Symbol
            (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)))
-> Maybe
     (Map
        Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
forall a b. a -> (a -> b) -> b
& ((Map
   Symbol
   (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
 -> Map
      Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> Maybe
     (Map
        Symbol
        (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> Maybe
     (Map
        Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Map
    Symbol
    (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
  -> Map
       Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
 -> Maybe
      (Map
         Symbol
         (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
 -> Maybe
      (Map
         Symbol
         (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)))
-> (((Ann, Reference, Maybe String, Term Symbol Ann,
      Type Symbol Ann)
     -> (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
    -> Map
         Symbol
         (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
    -> Map
         Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> ((Ann, Reference, Maybe String, Term Symbol Ann,
     Type Symbol Ann)
    -> (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> Maybe
     (Map
        Symbol
        (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> Maybe
     (Map
        Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
 -> (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> Map
     Symbol
     (Ann, Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> Map
     Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall a b. (a -> b) -> Map Symbol a -> Map Symbol b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (\(Ann
_ann, Reference
ref, Maybe String
wk, Term Symbol Ann
tm, Type Symbol Ann
tp) -> (Reference
ref, Maybe String
wk, Term Symbol Ann
tm, Type Symbol Ann
tp))
            Maybe
  (Map
     Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> (Maybe
      (Map
         Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
    -> Transaction
         (Maybe
            (Map
               Symbol
               (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))))
-> Transaction
     (Maybe
        (Map
           Symbol
           (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)))
forall a b. a -> (a -> b) -> b
& Maybe
  (Map
     Symbol (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann))
-> Transaction
     (Maybe
        (Map
           Symbol
           (Reference, Maybe String, Term Symbol Ann, Type Symbol Ann)))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- TypecheckFile file ambient -> liftIO $ typecheck' ambient codebase file
unhashTypeComponent :: Reference -> Sqlite.Transaction (Map Symbol (Reference, Decl Symbol Ann))
unhashTypeComponent :: Reference -> Transaction (Map Symbol (Reference, Decl Symbol Ann))
unhashTypeComponent Reference
r = case Reference -> Maybe Id
Reference.toId Reference
r of
  Maybe Id
Nothing -> Map Symbol (Reference, Decl Symbol Ann)
-> Transaction (Map Symbol (Reference, Decl Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Symbol (Reference, Decl Symbol Ann)
forall a. Monoid a => a
mempty
  Just Id
id -> do
    Map Symbol (Id, Decl Symbol Ann)
unhashed <- Hash -> Transaction (Map Symbol (Id, Decl Symbol Ann))
unhashTypeComponent' (Id -> Hash
Reference.idToHash Id
id)
    pure $ ASetter
  (Id, Decl Symbol Ann) (Reference, Decl Symbol Ann) Id Reference
-> (Id -> Reference)
-> (Id, Decl Symbol Ann)
-> (Reference, Decl Symbol Ann)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Id, Decl Symbol Ann) (Reference, Decl Symbol Ann) Id Reference
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Id, Decl Symbol Ann) (Reference, Decl Symbol Ann) Id Reference
_1 Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId ((Id, Decl Symbol Ann) -> (Reference, Decl Symbol Ann))
-> Map Symbol (Id, Decl Symbol Ann)
-> Map Symbol (Reference, Decl Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Symbol (Id, Decl Symbol Ann)
unhashed

unhashTypeComponent' :: Hash -> Sqlite.Transaction (Map Symbol (Reference.Id, Decl Symbol Ann))
unhashTypeComponent' :: Hash -> Transaction (Map Symbol (Id, Decl Symbol Ann))
unhashTypeComponent' Hash
h =
  Hash -> Transaction (Maybe [Decl Symbol Ann])
Codebase.getDeclComponent Hash
h Transaction (Maybe [Decl Symbol Ann])
-> (Maybe [Decl Symbol Ann] -> Map Symbol (Id, Decl Symbol Ann))
-> Transaction (Map Symbol (Id, Decl Symbol Ann))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([Decl Symbol Ann] -> Map Symbol (Id, Decl Symbol Ann))
-> Maybe [Decl Symbol Ann] -> Map Symbol (Id, Decl Symbol Ann)
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \[Decl Symbol Ann]
decls ->
    Map Id (Decl Symbol Ann) -> Map Symbol (Id, Decl Symbol Ann)
forall {a}.
Map Id (Decl Symbol a) -> Map Symbol (Id, Decl Symbol a)
unhash (Map Id (Decl Symbol Ann) -> Map Symbol (Id, Decl Symbol Ann))
-> Map Id (Decl Symbol Ann) -> Map Symbol (Id, Decl Symbol Ann)
forall a b. (a -> b) -> a -> b
$ [(Id, Decl Symbol Ann)] -> Map Id (Decl Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Hash -> [Decl Symbol Ann] -> [(Id, Decl Symbol Ann)]
forall a. Hash -> [a] -> [(Id, a)]
Reference.componentFor Hash
h [Decl Symbol Ann]
decls)
  where
    unhash :: Map Id (Decl Symbol a) -> Map Symbol (Id, Decl Symbol a)
unhash =
      [(Symbol, (Id, Decl Symbol a))] -> Map Symbol (Id, Decl Symbol a)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Symbol, (Id, Decl Symbol a))] -> Map Symbol (Id, Decl Symbol a))
-> (Map Id (Decl Symbol a) -> [(Symbol, (Id, Decl Symbol a))])
-> Map Id (Decl Symbol a)
-> Map Symbol (Id, Decl Symbol a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Id, (Symbol, Decl Symbol a)) -> (Symbol, (Id, Decl Symbol a)))
-> [(Id, (Symbol, Decl Symbol a))]
-> [(Symbol, (Id, Decl Symbol a))]
forall a b. (a -> b) -> [a] -> [b]
map (Id, (Symbol, Decl Symbol a)) -> (Symbol, (Id, Decl Symbol a))
forall {a} {a} {b}. (a, (a, b)) -> (a, (a, b))
reshuffle ([(Id, (Symbol, Decl Symbol a))]
 -> [(Symbol, (Id, Decl Symbol a))])
-> (Map Id (Decl Symbol a) -> [(Id, (Symbol, Decl Symbol a))])
-> Map Id (Decl Symbol a)
-> [(Symbol, (Id, Decl Symbol a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Id (Symbol, Decl Symbol a) -> [(Id, (Symbol, Decl Symbol a))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Id (Symbol, Decl Symbol a) -> [(Id, (Symbol, Decl Symbol a))])
-> (Map Id (Decl Symbol a) -> Map Id (Symbol, Decl Symbol a))
-> Map Id (Decl Symbol a)
-> [(Id, (Symbol, Decl Symbol a))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Id (Decl Symbol a) -> Map Id (Symbol, Decl Symbol a)
forall v a. Var v => Map Id (Decl v a) -> Map Id (v, Decl v a)
Decl.unhashComponent
      where
        reshuffle :: (a, (a, b)) -> (a, (a, b))
reshuffle (a
r, (a
v, b
decl)) = (a
v, (a
r, b
decl))

applyDeprecations :: (Applicative m) => Patch -> Branch0 m -> Branch0 m
applyDeprecations :: forall (m :: * -> *).
Applicative m =>
Patch -> Branch0 m -> Branch0 m
applyDeprecations Patch
patch =
  Set Reference -> Branch0 m -> Branch0 m
forall (m :: * -> *). Set Reference -> Branch0 m -> Branch0 m
deleteDeprecatedTerms Set Reference
deprecatedTerms
    (Branch0 m -> Branch0 m)
-> (Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Reference -> Branch0 m -> Branch0 m
forall (m :: * -> *). Set Reference -> Branch0 m -> Branch0 m
deleteDeprecatedTypes Set Reference
deprecatedTypes
  where
    deprecatedTerms, deprecatedTypes :: Set Reference
    deprecatedTerms :: Set Reference
deprecatedTerms =
      [Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
Set.fromList
        [Reference
r | (Reference
r, TermEdit
TermEdit.Deprecate) <- Relation Reference TermEdit -> [(Reference, TermEdit)]
forall a b. Relation a b -> [(a, b)]
R.toList (Patch -> Relation Reference TermEdit
Patch._termEdits Patch
patch)]
    deprecatedTypes :: Set Reference
deprecatedTypes =
      [Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
Set.fromList
        [Reference
r | (Reference
r, TypeEdit
TypeEdit.Deprecate) <- Relation Reference TypeEdit -> [(Reference, TypeEdit)]
forall a b. Relation a b -> [(a, b)]
R.toList (Patch -> Relation Reference TypeEdit
Patch._typeEdits Patch
patch)]
    deleteDeprecatedTerms,
      deleteDeprecatedTypes ::
        Set Reference -> Branch0 m -> Branch0 m
    deleteDeprecatedTerms :: forall (m :: * -> *). Set Reference -> Branch0 m -> Branch0 m
deleteDeprecatedTerms Set Reference
rs =
      ASetter
  (Branch0 m)
  (Branch0 m)
  (Star Referent NameSegment)
  (Star Referent NameSegment)
-> (Star Referent NameSegment -> Star Referent NameSegment)
-> Branch0 m
-> Branch0 m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Branch0 m)
  (Branch0 m)
  (Star Referent NameSegment)
  (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.terms (Set Referent
-> Star Referent NameSegment -> Star Referent NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Set fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.deleteFact ((Reference -> Referent) -> Set Reference -> Set Referent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> Referent
Referent.Ref Set Reference
rs))
    deleteDeprecatedTypes :: forall (m :: * -> *). Set Reference -> Branch0 m -> Branch0 m
deleteDeprecatedTypes Set Reference
rs = ASetter
  (Branch0 m)
  (Branch0 m)
  (Star Reference NameSegment)
  (Star Reference NameSegment)
-> (Star Reference NameSegment -> Star Reference NameSegment)
-> Branch0 m
-> Branch0 m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Branch0 m)
  (Branch0 m)
  (Star Reference NameSegment)
  (Star Reference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Reference NameSegment -> f (Star Reference NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.types (Set Reference
-> Star Reference NameSegment -> Star Reference NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
Set fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.deleteFact Set Reference
rs)

-- | Things in the patch are not marked as propagated changes, but every other
-- definition that is created by the `Edits` which is passed in is marked as
-- a propagated change.
applyPropagate :: forall m. (Applicative m) => Patch -> Edits Symbol -> Branch0 m -> Branch0 m
applyPropagate :: forall (m :: * -> *).
Applicative m =>
Patch -> Edits Symbol -> Branch0 m -> Branch0 m
applyPropagate Patch
patch Edits {Map Referent Referent
$sel:termReplacements:Edits :: forall v. Edits v -> Map Referent Referent
termReplacements :: Map Referent Referent
termReplacements, Map Reference Reference
$sel:typeReplacements:Edits :: forall v. Edits v -> Map Reference Reference
typeReplacements :: Map Reference Reference
typeReplacements, Map Referent Referent
$sel:constructorReplacements:Edits :: forall v. Edits v -> Map Referent Referent
constructorReplacements :: Map Referent Referent
constructorReplacements} = do
  -- recursively update names and delete deprecated definitions
  (Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
stepEverywhereButLib (Map Referent Referent
-> Map Reference Reference -> Branch0 m -> Branch0 m
updateLevel Map Referent Referent
termReplacements Map Reference Reference
typeReplacements)
  where
    -- Like Branch.stepEverywhere, but don't step the child named "lib"
    stepEverywhereButLib :: (Branch0 m -> Branch0 m) -> (Branch0 m -> Branch0 m)
    stepEverywhereButLib :: (Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
stepEverywhereButLib Branch0 m -> Branch0 m
f Branch0 m
branch =
      let children :: Map NameSegment (Branch m)
children =
            (NameSegment -> Branch m -> Branch m)
-> Map NameSegment (Branch m) -> Map NameSegment (Branch m)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
              (\NameSegment
name Branch m
child -> if NameSegment
name NameSegment -> NameSegment -> Bool
forall a. Eq a => a -> a -> Bool
== NameSegment
NameSegment.libSegment then Branch m
child else (Branch0 m -> Branch0 m) -> Branch m -> Branch m
forall (m :: * -> *).
Applicative m =>
(Branch0 m -> Branch0 m) -> Branch m -> Branch m
Branch.step ((Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
forall (m :: * -> *).
Applicative m =>
(Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
Branch.stepEverywhere Branch0 m -> Branch0 m
f) Branch m
child)
              (Branch0 m
branch 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)
       in Branch0 m -> Branch0 m
f (Star Referent NameSegment
-> Star Reference NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
forall (m :: * -> *).
Star Referent NameSegment
-> Star Reference NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
Branch.branch0 (Branch0 m
branch 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) (Branch0 m
branch 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) Map NameSegment (Branch m)
children (Branch0 m
branch 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))
    isPropagated :: Reference -> Bool
isPropagated Reference
r = Reference -> Set Reference -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember Reference
r Set Reference
allPatchTargets
    allPatchTargets :: Set Reference
allPatchTargets = Patch -> Set Reference
Patch.allReferenceTargets Patch
patch
    propagatedMd :: forall r. r -> (r, Metadata.Value)
    propagatedMd :: forall r. r -> (r, Reference)
propagatedMd r
r = (r
r, Reference
IOSource.isPropagatedValue)

    updateLevel ::
      Map Referent Referent ->
      Map Reference Reference ->
      Branch0 m ->
      Branch0 m
    updateLevel :: Map Referent Referent
-> Map Reference Reference -> Branch0 m -> Branch0 m
updateLevel Map Referent Referent
termEdits Map Reference Reference
typeEdits Branch0 m
b =
      Star Referent NameSegment
-> Star Reference NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
forall (m :: * -> *).
Star Referent NameSegment
-> Star Reference NameSegment
-> Map NameSegment (Branch m)
-> Map NameSegment (PatchHash, m Patch)
-> Branch0 m
Branch.branch0 Star Referent NameSegment
terms Star Reference NameSegment
types (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) (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
        isPropagatedReferent :: Referent -> Bool
isPropagatedReferent (Referent.Con ConstructorReference
_ ConstructorType
_) = Bool
True
        isPropagatedReferent (Referent.Ref Reference
r) = Reference -> Bool
isPropagated Reference
r

        terms0 :: Metadata.Star Referent NameSegment
        terms0 :: Star Referent NameSegment
terms0 = (Referent
 -> Referent
 -> Star Referent NameSegment
 -> Star Referent NameSegment)
-> Map Referent Referent
-> Star Referent NameSegment
-> Star Referent NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
(fact -> fact -> Star2 fact d1 d2 -> Star2 fact d1 d2)
-> Map fact fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.replaceFacts Referent
-> Referent
-> Star Referent NameSegment
-> Star Referent NameSegment
replaceConstructor Map Referent Referent
constructorReplacements (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)
        terms :: Branch.Star Referent NameSegment
        terms :: Star Referent NameSegment
terms =
          Star Referent NameSegment -> Star Referent NameSegment
forall r. Ord r => Star r NameSegment -> Star r NameSegment
updateMetadatas (Star Referent NameSegment -> Star Referent NameSegment)
-> Star Referent NameSegment -> Star Referent NameSegment
forall a b. (a -> b) -> a -> b
$
            (Referent
 -> Referent
 -> Star Referent NameSegment
 -> Star Referent NameSegment)
-> Map Referent Referent
-> Star Referent NameSegment
-> Star Referent NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
(fact -> fact -> Star2 fact d1 d2 -> Star2 fact d1 d2)
-> Map fact fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.replaceFacts Referent
-> Referent
-> Star Referent NameSegment
-> Star Referent NameSegment
replaceTerm Map Referent Referent
termEdits Star Referent NameSegment
terms0
        types :: Branch.Star Reference NameSegment
        types :: Star Reference NameSegment
types =
          Star Reference NameSegment -> Star Reference NameSegment
forall r. Ord r => Star r NameSegment -> Star r NameSegment
updateMetadatas (Star Reference NameSegment -> Star Reference NameSegment)
-> Star Reference NameSegment -> Star Reference NameSegment
forall a b. (a -> b) -> a -> b
$
            (Reference
 -> Reference
 -> Star Reference NameSegment
 -> Star Reference NameSegment)
-> Map Reference Reference
-> Star Reference NameSegment
-> Star Reference NameSegment
forall fact d1 d2.
(Ord fact, Ord d1, Ord d2) =>
(fact -> fact -> Star2 fact d1 d2 -> Star2 fact d1 d2)
-> Map fact fact -> Star2 fact d1 d2 -> Star2 fact d1 d2
Star2.replaceFacts Reference
-> Reference
-> Star Reference NameSegment
-> Star Reference NameSegment
replaceType Map Reference Reference
typeEdits (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)

        updateMetadatas ::
          (Ord r) =>
          Metadata.Star r NameSegment ->
          Metadata.Star r NameSegment
        updateMetadatas :: forall r. Ord r => Star r NameSegment -> Star r NameSegment
updateMetadatas Star r NameSegment
s = (Reference -> Reference)
-> Star r NameSegment -> Star r NameSegment
forall fact d2 d2a d1.
(Ord fact, Ord d2, Ord d2a) =>
(d2 -> d2a) -> Star2 fact d1 d2 -> Star2 fact d1 d2a
Star2.mapD2 Reference -> Reference
go Star r NameSegment
s
          where
            go :: Reference -> Reference
go Reference
v = case Referent -> Map Referent Referent -> Maybe Referent
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Reference -> Referent
Referent.Ref Reference
v) Map Referent Referent
termEdits of
              Just (Referent.Ref Reference
r) -> Reference
r
              Maybe Referent
_ -> Reference
v

        replaceTerm :: Referent -> Referent -> Metadata.Star Referent NameSegment -> Metadata.Star Referent NameSegment
        replaceTerm :: Referent
-> Referent
-> Star Referent NameSegment
-> Star Referent NameSegment
replaceTerm Referent
_r Referent
r' Star Referent NameSegment
s =
          ( if Referent -> Bool
isPropagatedReferent Referent
r'
              then (Referent, Reference)
-> Star Referent NameSegment -> Star Referent NameSegment
forall a n.
(Ord a, Ord n) =>
(a, Reference) -> Star a n -> Star a n
Metadata.insert (Referent -> (Referent, Reference)
forall r. r -> (r, Reference)
propagatedMd Referent
r')
              else (Referent, Reference)
-> Star Referent NameSegment -> Star Referent NameSegment
forall a n.
(Ord a, Ord n) =>
(a, Reference) -> Star a n -> Star a n
Metadata.delete (Referent -> (Referent, Reference)
forall r. r -> (r, Reference)
propagatedMd Referent
r')
          )
            (Star Referent NameSegment -> Star Referent NameSegment)
-> Star Referent NameSegment -> Star Referent NameSegment
forall a b. (a -> b) -> a -> b
$ Star Referent NameSegment
s

        replaceConstructor ::
          Referent ->
          Referent ->
          Metadata.Star Referent NameSegment ->
          Metadata.Star Referent NameSegment
        replaceConstructor :: Referent
-> Referent
-> Star Referent NameSegment
-> Star Referent NameSegment
replaceConstructor (Referent.Con ConstructorReference
_ ConstructorType
_) !Referent
new Star Referent NameSegment
s =
          -- TODO: revisit this once patches have constructor mappings
          -- at the moment, all constructor replacements are autopropagated
          -- rather than added manually
          (Referent, Reference)
-> Star Referent NameSegment -> Star Referent NameSegment
forall a n.
(Ord a, Ord n) =>
(a, Reference) -> Star a n -> Star a n
Metadata.insert (Referent -> (Referent, Reference)
forall r. r -> (r, Reference)
propagatedMd Referent
new) (Star Referent NameSegment -> Star Referent NameSegment)
-> Star Referent NameSegment -> Star Referent NameSegment
forall a b. (a -> b) -> a -> b
$ Star Referent NameSegment
s
        replaceConstructor Referent
_ Referent
_ Star Referent NameSegment
s = Star Referent NameSegment
s

        replaceType :: Reference
-> Reference
-> Star Reference NameSegment
-> Star Reference NameSegment
replaceType Reference
_ Reference
r' Star Reference NameSegment
s =
          ( if Reference -> Bool
isPropagated Reference
r'
              then (Reference, Reference)
-> Star Reference NameSegment -> Star Reference NameSegment
forall a n.
(Ord a, Ord n) =>
(a, Reference) -> Star a n -> Star a n
Metadata.insert (Reference -> (Reference, Reference)
forall r. r -> (r, Reference)
propagatedMd Reference
r')
              else (Reference, Reference)
-> Star Reference NameSegment -> Star Reference NameSegment
forall a n.
(Ord a, Ord n) =>
(a, Reference) -> Star a n -> Star a n
Metadata.delete (Reference -> (Reference, Reference)
forall r. r -> (r, Reference)
propagatedMd Reference
r')
          )
            (Star Reference NameSegment -> Star Reference NameSegment)
-> Star Reference NameSegment -> Star Reference NameSegment
forall a b. (a -> b) -> a -> b
$ Star Reference NameSegment
s

-- typePreservingTermEdits :: Patch -> Patch
-- typePreservingTermEdits Patch {..} = Patch termEdits mempty
--   where termEdits = R.filterRan TermEdit.isTypePreserving _termEdits

-- | Compute the set of "dirty" references. They each:
--
-- 1. Depend directly on some reference that was edited in the given patch
-- 2. Are not themselves edited in the given patch.
-- 3. Pass the given predicate.
computeDirty ::
  (Monad m) =>
  (Reference -> m (Set Reference)) -> -- eg Codebase.dependents codebase
  Patch ->
  (Reference -> Bool) ->
  m (Set Reference)
computeDirty :: forall (m :: * -> *).
Monad m =>
(Reference -> m (Set Reference))
-> Patch -> (Reference -> Bool) -> m (Set Reference)
computeDirty Reference -> m (Set Reference)
getDependents Patch
patch Reference -> Bool
shouldUpdate =
  (Reference -> m (Set Reference))
-> Set Reference -> m (Set Reference)
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM (\Reference
ref -> Set Reference -> Set Reference
keepDirtyDependents (Set Reference -> Set Reference)
-> m (Set Reference) -> m (Set Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reference -> m (Set Reference)
getDependents Reference
ref) Set Reference
edited
  where
    -- Given a set of dependent references (satisfying 1. above), keep only the dirty ones (per 2. and 3. above)
    keepDirtyDependents :: Set Reference -> Set Reference
    keepDirtyDependents :: Set Reference -> Set Reference
keepDirtyDependents =
      (Set Reference -> Set Reference -> Set Reference
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Reference
edited) (Set Reference -> Set Reference)
-> (Set Reference -> Set Reference)
-> Set Reference
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Bool) -> Set Reference -> Set Reference
forall a. (a -> Bool) -> Set a -> Set a
Set.filter Reference -> Bool
shouldUpdate

    edited :: Set Reference
    edited :: Set Reference
edited = Relation Reference TermEdit -> Set Reference
forall a b. Relation a b -> Set a
R.dom (Patch -> Relation Reference TermEdit
Patch._termEdits Patch
patch) Set Reference -> Set Reference -> Set Reference
forall a. Semigroup a => a -> a -> a
<> Relation Reference TypeEdit -> Set Reference
forall a b. Relation a b -> Set a
R.dom (Patch -> Relation Reference TypeEdit
Patch._typeEdits Patch
patch)

nameNotInLibNamespace :: Name -> Bool
nameNotInLibNamespace :: Name -> Bool
nameNotInLibNamespace Name
name =
  Bool -> Bool
not (Name -> NameSegment -> Bool
Name.beginsWithSegment Name
name NameSegment
NameSegment.libSegment)