-- | This module contains functionality that is common to the general idea of "updating" a term in Unison, which is when
-- we reassign a name from one hash to another and then see if all dependents still typecheck.
--
-- This occurs in the `pull`, `merge`, `update`, and `upgrade` commands.
module Unison.Cli.UpdateUtils
  ( -- * Getting dependents in a namespace
    getNamespaceDependentsOf,
    subtractDependents,

    -- * Hydrating definitions
    hydrateRefs,
    nameHydratedRefIds,
    nameHydratedRefIds2,

    -- * Unique type guids
    makeUniqueTypeGuids,

    -- * Parsing and typechecking
    parseAndTypecheck,
  )
where

import Control.Monad.Reader (ask)
import Data.Bitraversable (bitraverse)
import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import U.Codebase.Decl qualified as V2.Decl
import U.Codebase.Reference (Reference' (..), TermReferenceId, TypeReferenceId)
import U.Codebase.Sqlite.Operations qualified as Operations
import Unison.Cli.Monad (Cli, Env (..))
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.DataDeclaration (Decl)
import Unison.Debug qualified as Debug
import Unison.FileParsers qualified as FileParsers
import Unison.Hash (Hash)
import Unison.Name (Name)
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Parsers qualified as Parsers
import Unison.Prelude
import Unison.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.Sqlite (Transaction)
import Unison.Symbol (Symbol)
import Unison.Syntax.Parser qualified as Parser
import Unison.Term (Term)
import Unison.Type (Type)
import Unison.UnisonFile (TypecheckedUnisonFile)
import Unison.Util.BiMultimap (BiMultimap)
import Unison.Util.BiMultimap qualified as BiMultimap
import Unison.Util.Defns (Defns (..), DefnsF, zipDefnsWith)
import Unison.Util.Map qualified as Map (thenInsertPair)
import Unison.Util.Pretty (Pretty)
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Set qualified as Set
import Prelude hiding (unzip, zip, zipWith)

------------------------------------------------------------------------------------------------------------------------
-- Getting dependents in a namespace

-- | Given an unconflicted namespace and a set of dependencies, return the subset of the namespace that consists of only
-- the (transitive) dependents of the dependencies.
getNamespaceDependentsOf ::
  Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) ->
  DefnsF Set TermReference TypeReference ->
  Transaction (DefnsF (Map Name) TermReferenceId TypeReferenceId)
getNamespaceDependentsOf :: Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> DefnsF Set Reference Reference
-> Transaction (DefnsF (Map Name) TypeReferenceId TypeReferenceId)
getNamespaceDependentsOf Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
defns DefnsF Set Reference Reference
dependencies = do
  DefnsF Set TypeReferenceId TypeReferenceId
-> DefnsF Set Reference Reference
-> Transaction (DefnsF Set TypeReferenceId TypeReferenceId)
Operations.transitiveDependentsWithinScope (Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
-> DefnsF Set TypeReferenceId TypeReferenceId
Names.unconflictedReferenceIds Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
defns) DefnsF Set Reference Reference
dependencies
    Transaction (DefnsF Set TypeReferenceId TypeReferenceId)
-> (DefnsF Set TypeReferenceId TypeReferenceId
    -> DefnsF (Map Name) TypeReferenceId TypeReferenceId)
-> Transaction (DefnsF (Map Name) TypeReferenceId TypeReferenceId)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Set TypeReferenceId -> Map Name TypeReferenceId)
-> (Set TypeReferenceId -> Map Name TypeReferenceId)
-> DefnsF Set TypeReferenceId TypeReferenceId
-> DefnsF (Map Name) TypeReferenceId TypeReferenceId
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Map Name TypeReferenceId
 -> TypeReferenceId -> Map Name TypeReferenceId)
-> Map Name TypeReferenceId
-> Set TypeReferenceId
-> Map Name TypeReferenceId
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Map Name TypeReferenceId
-> TypeReferenceId -> Map Name TypeReferenceId
addTerms Map Name TypeReferenceId
forall k a. Map k a
Map.empty) ((Map Name TypeReferenceId
 -> TypeReferenceId -> Map Name TypeReferenceId)
-> Map Name TypeReferenceId
-> Set TypeReferenceId
-> Map Name TypeReferenceId
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Map Name TypeReferenceId
-> TypeReferenceId -> Map Name TypeReferenceId
addTypes Map Name TypeReferenceId
forall k a. Map k a
Map.empty)
  where
    addTerms :: Map Name TermReferenceId -> TermReferenceId -> Map Name TermReferenceId
    addTerms :: Map Name TypeReferenceId
-> TypeReferenceId -> Map Name TypeReferenceId
addTerms Map Name TypeReferenceId
acc0 TypeReferenceId
ref =
      let names :: Set Name
names = Referent -> BiMultimap Referent Name -> Set Name
forall a b. Ord a => a -> BiMultimap a b -> Set b
BiMultimap.lookupDom (TypeReferenceId -> Referent
Referent.fromTermReferenceId TypeReferenceId
ref) Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
defns.terms
       in (Map Name TypeReferenceId -> Name -> Map Name TypeReferenceId)
-> Map Name TypeReferenceId -> Set Name -> Map Name TypeReferenceId
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' (\Map Name TypeReferenceId
acc Name
name -> Name
-> TypeReferenceId
-> Map Name TypeReferenceId
-> Map Name TypeReferenceId
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
name TypeReferenceId
ref Map Name TypeReferenceId
acc) Map Name TypeReferenceId
acc0 Set Name
names

    addTypes :: Map Name TypeReferenceId -> TypeReferenceId -> Map Name TypeReferenceId
    addTypes :: Map Name TypeReferenceId
-> TypeReferenceId -> Map Name TypeReferenceId
addTypes Map Name TypeReferenceId
acc0 TypeReferenceId
ref =
      let names :: Set Name
names = Reference -> BiMultimap Reference Name -> Set Name
forall a b. Ord a => a -> BiMultimap a b -> Set b
BiMultimap.lookupDom (TypeReferenceId -> Reference
Reference.fromId TypeReferenceId
ref) Defns (BiMultimap Referent Name) (BiMultimap Reference Name)
defns.types
       in (Map Name TypeReferenceId -> Name -> Map Name TypeReferenceId)
-> Map Name TypeReferenceId -> Set Name -> Map Name TypeReferenceId
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' (\Map Name TypeReferenceId
acc Name
name -> Name
-> TypeReferenceId
-> Map Name TypeReferenceId
-> Map Name TypeReferenceId
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
name TypeReferenceId
ref Map Name TypeReferenceId
acc) Map Name TypeReferenceId
acc0 Set Name
names

subtractDependents ::
  DefnsF Set TermReferenceId TypeReferenceId ->
  DefnsF (Map Name) Referent TypeReference ->
  DefnsF (Map Name) Referent TypeReference
subtractDependents :: DefnsF Set TypeReferenceId TypeReferenceId
-> DefnsF (Map Name) Referent Reference
-> DefnsF (Map Name) Referent Reference
subtractDependents DefnsF Set TypeReferenceId TypeReferenceId
dependents =
  (Map Name Referent -> Map Name Referent)
-> (Map Name Reference -> Map Name Reference)
-> DefnsF (Map Name) Referent Reference
-> DefnsF (Map Name) Referent Reference
forall a b c d. (a -> b) -> (c -> d) -> Defns a c -> Defns b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Referent -> Bool) -> Map Name Referent -> Map Name Referent
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Referent -> Bool
keepTerm) ((Reference -> Bool) -> Map Name Reference -> Map Name Reference
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Reference -> Bool
keepType)
  where
    keepType :: TypeReference -> Bool
    keepType :: Reference -> Bool
keepType = \case
      ReferenceBuiltin Text
_ -> Bool
True
      ReferenceDerived TypeReferenceId
refId -> Bool -> Bool
not (TypeReferenceId -> Set TypeReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeReferenceId
refId DefnsF Set TypeReferenceId TypeReferenceId
dependents.types)
    keepTerm :: Referent -> Bool
    keepTerm :: Referent -> Bool
keepTerm = \case
      Referent.Con (ConstructorReference Reference
ref ConstructorId
_) ConstructorType
_ -> Reference -> Bool
keepType Reference
ref
      Referent.Ref Reference
ref ->
        case Reference
ref of
          ReferenceBuiltin Text
_ -> Bool
True
          ReferenceDerived TypeReferenceId
refId -> Bool -> Bool
not (TypeReferenceId -> Set TypeReferenceId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member TypeReferenceId
refId DefnsF Set TypeReferenceId TypeReferenceId
dependents.terms)

------------------------------------------------------------------------------------------------------------------------
-- Hydrating definitions

-- | Hydrate term/type references to actual terms/types.
hydrateRefs ::
  Codebase m v a ->
  DefnsF Set TermReferenceId TypeReferenceId ->
  Transaction (Defns (Map TermReferenceId (Term v a, Type v a)) (Map TypeReferenceId (Decl v a)))
hydrateRefs :: forall (m :: * -> *) v a.
Codebase m v a
-> DefnsF Set TypeReferenceId TypeReferenceId
-> Transaction
     (Defns
        (Map TypeReferenceId (Term v a, Type v a))
        (Map TypeReferenceId (Decl v a)))
hydrateRefs Codebase m v a
codebase =
  (Set TypeReferenceId
 -> Transaction (Map TypeReferenceId (Term v a, Type v a)))
-> (Set TypeReferenceId
    -> Transaction (Map TypeReferenceId (Decl v a)))
-> DefnsF Set TypeReferenceId TypeReferenceId
-> Transaction
     (Defns
        (Map TypeReferenceId (Term v a, Type v a))
        (Map TypeReferenceId (Decl v a)))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Defns a b -> f (Defns c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse
    ((Hash -> Transaction [(Term v a, Type v a)])
-> Set TypeReferenceId
-> Transaction (Map TypeReferenceId (Term v a, Type v a))
forall defn (m :: * -> *).
Monad m =>
(Hash -> m [defn])
-> Set TypeReferenceId -> m (Map TypeReferenceId defn)
hydrateRefs1 (Codebase m v a -> Hash -> Transaction [(Term v a, Type v a)]
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Hash -> Transaction [(Term v a, Type v a)]
Codebase.unsafeGetTermComponent Codebase m v a
codebase))
    ((Hash -> Transaction [Decl v a])
-> Set TypeReferenceId
-> Transaction (Map TypeReferenceId (Decl v a))
forall defn (m :: * -> *).
Monad m =>
(Hash -> m [defn])
-> Set TypeReferenceId -> m (Map TypeReferenceId defn)
hydrateRefs1 (Codebase m v a -> Hash -> Transaction [Decl v a]
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Hash -> Transaction [Decl v a]
Codebase.expectTypeDeclarationComponent Codebase m v a
codebase))

hydrateRefs1 ::
  forall defn m.
  (Monad m) =>
  (Hash -> m [defn]) ->
  Set Reference.Id ->
  m (Map Reference.Id defn)
hydrateRefs1 :: forall defn (m :: * -> *).
Monad m =>
(Hash -> m [defn])
-> Set TypeReferenceId -> m (Map TypeReferenceId defn)
hydrateRefs1 Hash -> m [defn]
getComponent =
  (Hash -> Map TypeReferenceId defn -> m (Map TypeReferenceId defn))
-> Map TypeReferenceId defn
-> Set Hash
-> m (Map TypeReferenceId defn)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m b) -> b -> Set a -> m b
Set.foldCommutativeM Hash -> Map TypeReferenceId defn -> m (Map TypeReferenceId defn)
f Map TypeReferenceId defn
forall k a. Map k a
Map.empty (Set Hash -> m (Map TypeReferenceId defn))
-> (Set TypeReferenceId -> Set Hash)
-> Set TypeReferenceId
-> m (Map TypeReferenceId defn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeReferenceId -> Hash) -> Set TypeReferenceId -> Set Hash
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TypeReferenceId -> Hash
Reference.idToHash
  where
    f :: Hash -> Map Reference.Id defn -> m (Map Reference.Id defn)
    f :: Hash -> Map TypeReferenceId defn -> m (Map TypeReferenceId defn)
f Hash
hash Map TypeReferenceId defn
acc =
      (Map TypeReferenceId defn
 -> (TypeReferenceId, defn) -> Map TypeReferenceId defn)
-> Map TypeReferenceId defn
-> [(TypeReferenceId, defn)]
-> Map TypeReferenceId defn
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map TypeReferenceId defn
-> (TypeReferenceId, defn) -> Map TypeReferenceId defn
forall k v. Ord k => Map k v -> (k, v) -> Map k v
Map.thenInsertPair Map TypeReferenceId defn
acc ([(TypeReferenceId, defn)] -> Map TypeReferenceId defn)
-> ([defn] -> [(TypeReferenceId, defn)])
-> [defn]
-> Map TypeReferenceId defn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> [defn] -> [(TypeReferenceId, defn)]
forall a. Hash -> [a] -> [(TypeReferenceId, a)]
Reference.componentFor Hash
hash ([defn] -> Map TypeReferenceId defn)
-> m [defn] -> m (Map TypeReferenceId defn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hash -> m [defn]
getComponent Hash
hash

-- | Associate names with hydrated terms/types.
nameHydratedRefIds ::
  DefnsF (Map name) TermReferenceId TypeReferenceId ->
  Defns (Map TermReferenceId term) (Map TypeReferenceId typ) ->
  DefnsF (Map name) (TermReferenceId, term) (TypeReferenceId, typ)
nameHydratedRefIds :: forall name term typ.
DefnsF (Map name) TypeReferenceId TypeReferenceId
-> Defns (Map TypeReferenceId term) (Map TypeReferenceId typ)
-> DefnsF (Map name) (TypeReferenceId, term) (TypeReferenceId, typ)
nameHydratedRefIds =
  (Map name TypeReferenceId
 -> Map TypeReferenceId term -> Map name (TypeReferenceId, term))
-> (Map name TypeReferenceId
    -> Map TypeReferenceId typ -> Map name (TypeReferenceId, typ))
-> Defns (Map name TypeReferenceId) (Map name TypeReferenceId)
-> Defns (Map TypeReferenceId term) (Map TypeReferenceId typ)
-> Defns
     (Map name (TypeReferenceId, term))
     (Map name (TypeReferenceId, typ))
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith Map name TypeReferenceId
-> Map TypeReferenceId term -> Map name (TypeReferenceId, term)
forall name defn.
Map name TypeReferenceId
-> Map TypeReferenceId defn -> Map name (TypeReferenceId, defn)
f Map name TypeReferenceId
-> Map TypeReferenceId typ -> Map name (TypeReferenceId, typ)
forall name defn.
Map name TypeReferenceId
-> Map TypeReferenceId defn -> Map name (TypeReferenceId, defn)
f
  where
    f :: Map name Reference.Id -> Map Reference.Id defn -> Map name (Reference.Id, defn)
    f :: forall name defn.
Map name TypeReferenceId
-> Map TypeReferenceId defn -> Map name (TypeReferenceId, defn)
f Map name TypeReferenceId
nameToRef Map TypeReferenceId defn
refToDefn =
      (TypeReferenceId -> Maybe (TypeReferenceId, defn))
-> Map name TypeReferenceId -> Map name (TypeReferenceId, defn)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\TypeReferenceId
ref -> (TypeReferenceId
ref,) (defn -> (TypeReferenceId, defn))
-> Maybe defn -> Maybe (TypeReferenceId, defn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeReferenceId -> Map TypeReferenceId defn -> Maybe defn
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TypeReferenceId
ref Map TypeReferenceId defn
refToDefn) Map name TypeReferenceId
nameToRef

-- | Like 'nameHydratedRefIds', but takes the entire namespace as a first argument, which includes constructors.
nameHydratedRefIds2 ::
  forall name term typ.
  (Ord name) =>
  Defns (BiMultimap Referent name) (BiMultimap TypeReference name) ->
  Defns (Map TermReferenceId term) (Map TypeReferenceId typ) ->
  DefnsF (Map name) (TermReferenceId, term) (TypeReferenceId, typ)
nameHydratedRefIds2 :: forall name term typ.
Ord name =>
Defns (BiMultimap Referent name) (BiMultimap Reference name)
-> Defns (Map TypeReferenceId term) (Map TypeReferenceId typ)
-> DefnsF (Map name) (TypeReferenceId, term) (TypeReferenceId, typ)
nameHydratedRefIds2 =
  (BiMultimap Referent name
 -> Map TypeReferenceId term -> Map name (TypeReferenceId, term))
-> (BiMultimap Reference name
    -> Map TypeReferenceId typ -> Map name (TypeReferenceId, typ))
-> Defns (BiMultimap Referent name) (BiMultimap Reference name)
-> Defns (Map TypeReferenceId term) (Map TypeReferenceId typ)
-> Defns
     (Map name (TypeReferenceId, term))
     (Map name (TypeReferenceId, typ))
forall tm1 tm2 tm3 ty1 ty2 ty3.
(tm1 -> tm2 -> tm3)
-> (ty1 -> ty2 -> ty3)
-> Defns tm1 ty1
-> Defns tm2 ty2
-> Defns tm3 ty3
zipDefnsWith ((TypeReferenceId -> Referent)
-> BiMultimap Referent name
-> Map TypeReferenceId term
-> Map name (TypeReferenceId, term)
forall defn ref refId.
Ord ref =>
(refId -> ref)
-> BiMultimap ref name -> Map refId defn -> Map name (refId, defn)
f TypeReferenceId -> Referent
Referent.fromTermReferenceId) ((TypeReferenceId -> Reference)
-> BiMultimap Reference name
-> Map TypeReferenceId typ
-> Map name (TypeReferenceId, typ)
forall defn ref refId.
Ord ref =>
(refId -> ref)
-> BiMultimap ref name -> Map refId defn -> Map name (refId, defn)
f TypeReferenceId -> Reference
Reference.fromId)
  where
    f ::
      forall defn ref refId.
      (Ord ref) =>
      (refId -> ref) ->
      BiMultimap ref name ->
      Map refId defn ->
      Map name (refId, defn)
    f :: forall defn ref refId.
Ord ref =>
(refId -> ref)
-> BiMultimap ref name -> Map refId defn -> Map name (refId, defn)
f refId -> ref
toRef BiMultimap ref name
defns =
      (Map name (refId, defn) -> refId -> defn -> Map name (refId, defn))
-> Map name (refId, defn)
-> Map refId defn
-> Map name (refId, defn)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' ((refId -> ref)
-> BiMultimap ref name
-> Map name (refId, defn)
-> refId
-> defn
-> Map name (refId, defn)
forall defn ref refId.
Ord ref =>
(refId -> ref)
-> BiMultimap ref name
-> Map name (refId, defn)
-> refId
-> defn
-> Map name (refId, defn)
g refId -> ref
toRef BiMultimap ref name
defns) Map name (refId, defn)
forall k a. Map k a
Map.empty

    g ::
      forall defn ref refId.
      (Ord ref) =>
      (refId -> ref) ->
      BiMultimap ref name ->
      Map name (refId, defn) ->
      refId ->
      defn ->
      Map name (refId, defn)
    g :: forall defn ref refId.
Ord ref =>
(refId -> ref)
-> BiMultimap ref name
-> Map name (refId, defn)
-> refId
-> defn
-> Map name (refId, defn)
g refId -> ref
toRef BiMultimap ref name
defns Map name (refId, defn)
acc refId
ref defn
defn =
      Map name (refId, defn)
-> Map name (refId, defn) -> Map name (refId, defn)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ((name -> (refId, defn)) -> Set name -> Map name (refId, defn)
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (\name
_ -> (refId
ref, defn
defn)) Set name
names) Map name (refId, defn)
acc
      where
        names :: Set name
        names :: Set name
names =
          ref -> BiMultimap ref name -> Set name
forall a b. Ord a => a -> BiMultimap a b -> Set b
BiMultimap.lookupDom (refId -> ref
toRef refId
ref) BiMultimap ref name
defns

------------------------------------------------------------------------------------------------------------------------
-- Unique type guids

-- Make a unique type name to guid mapping from definitions, by looking up each decl individually. Maybe there will be
-- a more efficient way to accomplish this some day, but this is how it works for now.
makeUniqueTypeGuids :: Map Name TypeReference -> Transaction (Map Name Text)
makeUniqueTypeGuids :: Map Name Reference -> Transaction (Map Name Text)
makeUniqueTypeGuids Map Name Reference
types = do
  let step :: Map TypeReferenceId Text -> TypeReferenceId -> Transaction (Map TypeReferenceId Text)
      step :: Map TypeReferenceId Text
-> TypeReferenceId -> Transaction (Map TypeReferenceId Text)
step Map TypeReferenceId Text
acc TypeReferenceId
refId = do
        decl <- TypeReferenceId -> Transaction (Decl Symbol)
Operations.expectDeclByReference TypeReferenceId
refId
        pure case decl.modifier of
          V2.Decl.Unique Text
guid -> TypeReferenceId
-> Text -> Map TypeReferenceId Text -> Map TypeReferenceId Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TypeReferenceId
refId Text
guid Map TypeReferenceId Text
acc
          Modifier
V2.Decl.Structural -> Map TypeReferenceId Text
acc

  uniqueTypeGuidsByRef <-
    (Map TypeReferenceId Text
 -> TypeReferenceId -> Transaction (Map TypeReferenceId Text))
-> Map TypeReferenceId Text
-> Set TypeReferenceId
-> Transaction (Map TypeReferenceId Text)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Foldable.foldlM Map TypeReferenceId Text
-> TypeReferenceId -> Transaction (Map TypeReferenceId Text)
step Map TypeReferenceId Text
forall k a. Map k a
Map.empty ((Reference -> Set TypeReferenceId)
-> Map Name Reference -> Set TypeReferenceId
forall m a. Monoid m => (a -> m) -> Map Name a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Reference -> Set TypeReferenceId
toRefIds Map Name Reference
types)

  let refToUniqueTypeGuid :: TypeReference -> Maybe Text
      refToUniqueTypeGuid = \case
        ReferenceDerived TypeReferenceId
refId -> TypeReferenceId -> Map TypeReferenceId Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TypeReferenceId
refId Map TypeReferenceId Text
uniqueTypeGuidsByRef
        ReferenceBuiltin Text
_ -> Maybe Text
forall a. Maybe a
Nothing

  pure (Map.mapMaybe refToUniqueTypeGuid types)
  where
    toRefIds :: TypeReference -> Set TypeReferenceId
    toRefIds :: Reference -> Set TypeReferenceId
toRefIds = \case
      ReferenceDerived TypeReferenceId
refId -> TypeReferenceId -> Set TypeReferenceId
forall a. a -> Set a
Set.singleton TypeReferenceId
refId
      ReferenceBuiltin Text
_ -> Set TypeReferenceId
forall a. Set a
Set.empty

------------------------------------------------------------------------------------------------------------------------
-- Parsing and typechecking

-- TODO: find a better module for this function, as it's used in a couple places
parseAndTypecheck ::
  Pretty Pretty.ColorText ->
  Parser.ParsingEnv Transaction ->
  Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
parseAndTypecheck :: Pretty ColorText
-> ParsingEnv Transaction
-> Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
parseAndTypecheck Pretty ColorText
prettyUf ParsingEnv Transaction
parsingEnv = do
  env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let stringUf = Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> Text
Pretty.toPlain Width
80 Pretty ColorText
prettyUf
  Debug.whenDebug Debug.Update do
    liftIO do
      putStrLn "--- Scratch ---"
      putStrLn stringUf
  Cli.runTransaction do
    Parsers.parseFile "<update>" stringUf parsingEnv >>= \case
      Left Err Symbol
_ -> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Transaction (Maybe (TypecheckedUnisonFile Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TypecheckedUnisonFile Symbol Ann)
forall a. Maybe a
Nothing
      Right UnisonFile Symbol Ann
uf -> do
        typecheckingEnv <-
          ShouldUseTndr Transaction
-> Codebase IO Symbol Ann
-> [Type Symbol Ann]
-> UnisonFile Symbol Ann
-> Transaction (Env Symbol Ann)
computeTypecheckingEnvironment (ParsingEnv Transaction -> ShouldUseTndr Transaction
forall (m :: * -> *). ParsingEnv m -> ShouldUseTndr m
FileParsers.ShouldUseTndr'Yes ParsingEnv Transaction
parsingEnv) Env
env.codebase [] UnisonFile Symbol Ann
uf
        pure (Result.result (FileParsers.synthesizeFile typecheckingEnv uf))