module Unison.Codebase.Editor.HandleInput.Load
  ( handleLoad,
    loadUnisonFile,
    EvalMode (..),
    evalUnisonFile,
  )
where

import Control.Lens ((.=))
import Control.Monad.Reader (ask)
import Control.Monad.State.Strict qualified as State
import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Set.NonEmpty (NESet)
import Data.Set.NonEmpty qualified as Set.NonEmpty
import Data.Text qualified as Text
import System.Environment (withArgs)
import U.Codebase.Sqlite.Project qualified as Sqlite
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Builtin qualified as Builtin
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
import Unison.Cli.UniqueTypeGuidLookup qualified as Cli
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.HandleInput.RuntimeUtils (EvalMode (..), modeProfSpec)
import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Editor.SlurpResult (TermSlurp (..), TypeSlurp (..))
import Unison.Codebase.Execute qualified as Codebase
import Unison.Codebase.ProjectPath (ProjectPathG (..))
import Unison.Codebase.Runtime qualified as Runtime
import Unison.Codebase.Runtime.Profile (ProfileSpec (NoProf))
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.DataDeclaration (DeclOrBuiltin)
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.FileParsers qualified as FileParsers
import Unison.Merge (GUpdated (..))
import Unison.Name (Name)
import Unison.Names (Names (..))
import Unison.Names qualified as Names
import Unison.OrBuiltin (OrBuiltin (..))
import Unison.Parser.Ann (Ann)
import Unison.Parser.Ann qualified as Ann
import Unison.Parsers qualified as Parsers
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
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.Runtime (Error)
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Syntax.Name qualified as Name
import Unison.Syntax.Parser qualified as Parser
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Typed (Typed (..))
import Unison.UnisonFile (TypecheckedUnisonFile)
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.Util.Defns (Defns (..))
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as Relation
import Unison.Util.Timing qualified as Timing
import Unison.Var qualified as Var
import Unison.WatchKind (WatchKind)
import Unison.WatchKind qualified as WatchKind

handleLoad :: Maybe FilePath -> Cli ()
handleLoad :: Maybe FilePath -> Cli ()
handleLoad Maybe FilePath
maybePath = do
  latestFile <- Cli (Maybe (FilePath, Bool))
Cli.getLatestFile
  path <- (maybePath <|> fst <$> latestFile) & onNothing (Cli.returnEarly Output.NoUnisonFile)
  Cli.Env {loadSource} <- ask
  contents <-
    liftIO (loadSource (Text.pack path)) >>= \case
      LoadSourceResult
Cli.InvalidSourceNameError -> Output -> Cli Text
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli Text) -> Output -> Cli Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Output
Output.InvalidSourceName FilePath
path
      LoadSourceResult
Cli.LoadError -> Output -> Cli Text
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli Text) -> Output -> Cli Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Output
Output.SourceLoadFailed FilePath
path
      Cli.LoadSuccess Text
contents -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
contents
  loadUnisonFile (Text.pack path) contents

loadUnisonFile :: Text -> Text -> Cli ()
loadUnisonFile :: Text -> Text -> Cli ()
loadUnisonFile Text
sourceName Text
text = do
  env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask

  Cli.respond $ Output.LoadingFile sourceName
  oldBranch0 <- Cli.getCurrentBranch0
  let oldNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
oldBranch0
  unisonFile <- parseAndTypecheckUnisonFile oldNames sourceName text
  let unisonFileNames = TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames TypecheckedUnisonFile Symbol Ann
unisonFile
  let newNames = TypecheckedUnisonFile Symbol Ann -> Names -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names -> Names
UF.addNamesFromTypeCheckedUnisonFile TypecheckedUnisonFile Symbol Ann
unisonFile Names
oldNames
  let newPpe = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE (Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
newNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
newNames))
  pp <- Cli.getCurrentProjectPath

  -- If we're on an update, upgrade, or merge branch, we have special logic to render changes relative to the parent
  -- branch (in a merge branch, that's the branch we're merging into). This is because, on these branches, dependents
  -- have been pulled out of the underlying namespace and put into the scratch file (so that we can support deleting
  -- things). Without this special logic, all of these things would be classified as new definitions.

  maybeSpecialBranchParentCausalHash <-
    if pp.branch.isUpdate || pp.branch.isUpgrade || pp.branch.isMerge
      then case pp.branch.parentBranchId of
        Maybe ProjectBranchId
Nothing -> Maybe CausalHash -> Cli (Maybe CausalHash)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CausalHash
forall a. Maybe a
Nothing
        Just ProjectBranchId
parentBranchId ->
          CausalHash -> Maybe CausalHash
forall a. a -> Maybe a
Just (CausalHash -> Maybe CausalHash)
-> Cli CausalHash -> Cli (Maybe CausalHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transaction CausalHash -> Cli CausalHash
forall a. Transaction a -> Cli a
Cli.runTransaction (HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHash
ProjectId -> ProjectBranchId -> Transaction CausalHash
Queries.expectProjectBranchHeadHash ProjectPath
pp.project.projectId ProjectBranchId
parentBranchId)
      else pure Nothing

  (oldPpe, slurpEntries, existingTerms) <-
    case maybeSpecialBranchParentCausalHash of
      Maybe CausalHash
Nothing -> do
        slurpEntries <-
          Transaction (Defns (Map Name TermSlurp) (Map Name TypeSlurp))
-> Cli (Defns (Map Name TermSlurp) (Map Name TypeSlurp))
forall a. Transaction a -> Cli a
Cli.runTransaction do
            terms <-
              Codebase IO Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Transaction (Map Name TermSlurp)
forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Transaction (Map Name TermSlurp)
slurpTerms
                Env
env.codebase
                TypecheckedUnisonFile Symbol Ann
unisonFile
                Bool
False
                (Relation Name Referent -> Map Name (Set Referent)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Names
oldNames.terms)
                (Relation Name Referent -> Map Name (Set Referent)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Names
unisonFileNames.terms)
            types <-
              slurpTypes
                env.codebase
                unisonFile
                False
                (Relation.domain oldNames.types)
                (Relation.domain unisonFileNames.types)
            pure Defns {terms, types}

        pure
          ( PPED.suffixifiedPPE (PPED.makePPED (PPE.hqNamer 10 oldNames) (PPE.suffixifyByHash oldNames)),
            slurpEntries,
            oldNames.terms
          )
      Just CausalHash
specialBranchParentCausalHash -> do
        specialBranchParent <- IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Codebase IO Symbol Ann -> CausalHash -> IO (Branch IO)
forall (m :: * -> *) v a.
Monad m =>
Codebase m v a -> CausalHash -> m (Branch m)
Codebase.expectBranchForHash Env
env.codebase CausalHash
specialBranchParentCausalHash)
        let specialBranchParent0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
specialBranchParent
        let specialBranchParentNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
specialBranchParent0
        let specialBranchParentLocalNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
specialBranchParent0)
        let specialBranchLocalNames =
              Names -> Names -> Names
Names.shadowing Names
unisonFileNames (Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
oldBranch0))

        slurpEntries <-
          Cli.runTransaction do
            terms <-
              slurpTerms
                env.codebase
                unisonFile
                True
                (Relation.domain specialBranchParentLocalNames.terms)
                (Relation.domain specialBranchLocalNames.terms)
            types <-
              slurpTypes
                env.codebase
                unisonFile
                False
                (Relation.domain specialBranchParentLocalNames.types)
                (Relation.domain specialBranchLocalNames.types)
            pure Defns {terms, types}

        pure
          ( PPED.suffixifiedPPE $
              PPED.makePPED
                (PPE.hqNamer 10 specialBranchParentNames)
                (PPE.suffixifyByHash specialBranchParentNames),
            slurpEntries,
            specialBranchParentNames.terms
          )

  let aliases :: Map Referent (NESet Name)
      aliases =
        Relation Name Referent
-> Map Name TermSlurp -> Map Referent (NESet Name)
getTermAliases Relation Name Referent
existingTerms Defns (Map Name TermSlurp) (Map Name TypeSlurp)
slurpEntries.terms

  Cli.respond (Output.Typechecked oldPpe newPpe slurpEntries aliases pp.branch.isMerge)

  when (not . null $ UF.watchComponents unisonFile) do
    Timing.time "evaluating watches" do
      evalUnisonFile (Permissive NoProf) newPpe unisonFile [] >>= \case
        Right ([(Symbol, Term Symbol ())]
bindings, Map
  Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
e) -> do
          Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Map
  Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
-> Bool
forall a. Map Symbol a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map
  Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
e)) do
            let f :: (a, b, c, d, c, d) -> (a, b, c, d)
f (a
ann, b
kind, c
_hash, d
_uneval, c
eval, d
isHit) = (a
ann, b
kind, c
eval, d
isHit)
            Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Text
-> PrettyPrintEnv
-> [(Symbol, Term Symbol ())]
-> Map Symbol (Ann, FilePath, Term Symbol (), Bool)
-> Output
Output.Evaluated Text
text PrettyPrintEnv
newPpe [(Symbol, Term Symbol ())]
bindings (((Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
 -> (Ann, FilePath, Term Symbol (), Bool))
-> Map
     Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
-> Map Symbol (Ann, FilePath, Term Symbol (), Bool)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
-> (Ann, FilePath, Term Symbol (), Bool)
forall {a} {b} {c} {d} {c} {d}. (a, b, c, d, c, d) -> (a, b, c, d)
f Map
  Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
e)
        Left Error
err -> Output -> Cli ()
Cli.respond ((Pretty ColorText -> Pretty ColorText) -> Error -> Output
Output.EvaluationFailure Pretty ColorText -> Pretty ColorText
forall a. a -> a
id Error
err)

  #latestTypecheckedFile .= Just (Right unisonFile)

slurpTerms ::
  Codebase m Symbol Ann ->
  TypecheckedUnisonFile Symbol Ann ->
  Bool ->
  Map Name (Set Referent) ->
  Map Name (Set Referent) ->
  Sqlite.Transaction (Map Name TermSlurp)
slurpTerms :: forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Transaction (Map Name TermSlurp)
slurpTerms Codebase m Symbol Ann
codebase TypecheckedUnisonFile Symbol Ann
unisonFile Bool
isUpdate =
  WhenMissing Transaction Name (Set Referent) TermSlurp
-> WhenMissing Transaction Name (Set Referent) TermSlurp
-> WhenMatched
     Transaction Name (Set Referent) (Set Referent) TermSlurp
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Transaction (Map Name TermSlurp)
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
Map.mergeA
    ( if Bool
isUpdate
        then (Name -> Set Referent -> Transaction (Maybe TermSlurp))
-> WhenMissing Transaction Name (Set Referent) TermSlurp
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
Map.traverseMaybeMissing \Name
_ Set Referent
refs ->
          case Set Referent -> Referent
forall a. Set a -> a
Set.findMin Set Referent
refs of
            Referent.Ref TypeReference
ref -> do
              ty <- Codebase m Symbol Ann
-> TypeReference -> Transaction (Type Symbol Ann)
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a -> TypeReference -> Transaction (Type Symbol a)
Codebase.expectTypeOfTerm Codebase m Symbol Ann
codebase TypeReference
ref
              pure (Just (TermSlurp'Delete (Typed ref ty)))
            Referent.Con ConstructorReference
_ ConstructorType
_ -> Maybe TermSlurp -> Transaction (Maybe TermSlurp)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TermSlurp
forall a. Maybe a
Nothing
        else WhenMissing Transaction Name (Set Referent) TermSlurp
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
    )
    ( (Name -> Set Referent -> Transaction (Maybe TermSlurp))
-> WhenMissing Transaction Name (Set Referent) TermSlurp
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f (Maybe y)) -> WhenMissing f k x y
Map.traverseMaybeMissing \Name
name Set Referent
refs ->
        case Set Referent -> Referent
forall a. Set a -> a
Set.findMin Set Referent
refs of
          Referent.Ref TypeReference
ref -> do
            ty <- Name -> TypeReference -> Transaction (Type Symbol Ann)
getNewRefType Name
name TypeReference
ref
            pure (Just (TermSlurp'Add (Typed ref ty)))
          Referent.Con ConstructorReference
_ ConstructorType
_ -> Maybe TermSlurp -> Transaction (Maybe TermSlurp)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TermSlurp
forall a. Maybe a
Nothing
    )
    ( (Name
 -> Set Referent -> Set Referent -> Transaction (Maybe TermSlurp))
-> WhenMatched
     Transaction Name (Set Referent) (Set Referent) TermSlurp
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
Map.zipWithMaybeAMatched \Name
name Set Referent
oldRefs Set Referent
newRefs ->
        let oldRef :: Referent
oldRef = Set Referent -> Referent
forall a. Set a -> a
Set.findMin Set Referent
oldRefs
            newRef :: Referent
newRef = Set Referent -> Referent
forall a. Set a -> a
Set.findMin Set Referent
newRefs
         in case (Referent
oldRef, Referent
newRef) of
              (Referent.Ref TypeReference
oldRef1, Referent.Ref TypeReference
newRef1) ->
                if TypeReference
oldRef1 TypeReference -> TypeReference -> Bool
forall a. Eq a => a -> a -> Bool
== TypeReference
newRef1
                  then
                    Maybe TermSlurp -> Transaction (Maybe TermSlurp)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                      if Bool
isUpdate Bool -> Bool -> Bool
|| Symbol
-> Map
     Symbol (Ann, Id, Maybe FilePath, Term Symbol Ann, Type Symbol Ann)
-> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
name) (TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol (Ann, Id, Maybe FilePath, Term Symbol Ann, Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Id, Maybe FilePath, Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile Symbol Ann
unisonFile)
                        then TermSlurp -> Maybe TermSlurp
forall a. a -> Maybe a
Just TermSlurp
TermSlurp'Unchanged
                        else Maybe TermSlurp
forall a. Maybe a
Nothing
                  else do
                    oldType <- Codebase m Symbol Ann
-> TypeReference -> Transaction (Type Symbol Ann)
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a -> TypeReference -> Transaction (Type Symbol a)
Codebase.expectTypeOfTerm Codebase m Symbol Ann
codebase TypeReference
oldRef1
                    newType <- getNewRefType name newRef1
                    pure (Just (TermSlurp'Update (Updated (Typed oldRef oldType) (Typed newRef newType))))
              (Referent.Con ConstructorReference
oldRef1 ConstructorType
_, Referent.Ref TypeReference
newRef1) -> do
                oldType <- Codebase m Symbol Ann
-> ConstructorReference -> Transaction (Type Symbol Ann)
forall v (m :: * -> *) a.
Ord v =>
Codebase m v a -> ConstructorReference -> Transaction (Type v a)
Codebase.expectTypeOfConstructor Codebase m Symbol Ann
codebase ConstructorReference
oldRef1
                newType <- getNewRefType name newRef1
                pure (Just (TermSlurp'Update (Updated (Typed oldRef oldType) (Typed newRef newType))))
              (Referent.Ref TypeReference
oldRef1, Referent.Con ConstructorReference
newRef1 ConstructorType
_) -> do
                oldType <- Codebase m Symbol Ann
-> TypeReference -> Transaction (Type Symbol Ann)
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a -> TypeReference -> Transaction (Type Symbol a)
Codebase.expectTypeOfTerm Codebase m Symbol Ann
codebase TypeReference
oldRef1
                newType <- getNewConType name newRef1
                pure (Just (TermSlurp'Update (Updated (Typed oldRef oldType) (Typed newRef newType))))
              (Referent.Con ConstructorReference
_ ConstructorType
_, Referent.Con ConstructorReference
_ ConstructorType
_) ->
                Maybe TermSlurp -> Transaction (Maybe TermSlurp)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TermSlurp
forall a. Maybe a
Nothing
    )
  where
    getNewConType :: Name -> ConstructorReference -> Sqlite.Transaction (Type Symbol Ann)
    getNewConType :: Name -> ConstructorReference -> Transaction (Type Symbol Ann)
getNewConType Name
name ConstructorReference
ref =
      case Symbol
-> Map Symbol (ConstructorReferenceId, Decl Symbol Ann)
-> Maybe (ConstructorReferenceId, Decl Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
name) (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (ConstructorReferenceId, Decl Symbol Ann)
forall v a.
(Ord v, Show v) =>
TypecheckedUnisonFile v a
-> Map v (ConstructorReferenceId, Decl v a)
UF.constructorsId TypecheckedUnisonFile Symbol Ann
unisonFile) of
        Just (ConstructorReference Id
_ ConstructorId
conId, Decl Symbol Ann
decl) ->
          Type Symbol Ann -> Transaction (Type Symbol Ann)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataDeclaration Symbol Ann -> ConstructorId -> Type Symbol Ann
forall a v.
(Show a, Show v) =>
DataDeclaration v a -> ConstructorId -> Type v a
DataDeclaration.expectTypeOfConstructor (Decl Symbol Ann -> DataDeclaration Symbol Ann
forall v a. Decl v a -> DataDeclaration v a
DataDeclaration.asDataDecl Decl Symbol Ann
decl) ConstructorId
conId)
        Maybe (ConstructorReferenceId, Decl Symbol Ann)
Nothing -> Codebase m Symbol Ann
-> ConstructorReference -> Transaction (Type Symbol Ann)
forall v (m :: * -> *) a.
Ord v =>
Codebase m v a -> ConstructorReference -> Transaction (Type v a)
Codebase.expectTypeOfConstructor Codebase m Symbol Ann
codebase ConstructorReference
ref

    getNewRefType :: Name -> TermReference -> Sqlite.Transaction (Type Symbol Ann)
    getNewRefType :: Name -> TypeReference -> Transaction (Type Symbol Ann)
getNewRefType Name
name TypeReference
ref =
      case Symbol
-> Map
     Symbol (Ann, Id, Maybe FilePath, Term Symbol Ann, Type Symbol Ann)
-> Maybe
     (Ann, Id, Maybe FilePath, Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
name) (TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol (Ann, Id, Maybe FilePath, Term Symbol Ann, Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Id, Maybe FilePath, Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile Symbol Ann
unisonFile) of
        Just (Ann
_, Id
_, Maybe FilePath
_, Term Symbol Ann
_, Type Symbol Ann
ty) -> Type Symbol Ann -> Transaction (Type Symbol Ann)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type Symbol Ann
ty
        Maybe (Ann, Id, Maybe FilePath, Term Symbol Ann, Type Symbol Ann)
Nothing ->
          -- This is super unlikely in practice (but has been observed in a transcript) - the term name matches an
          -- unnamed test watch's generated name. In this case, the map lookup above (by Name.toVar name) won't find the
          -- unnamed test watch, as it has a var type of UnnamedWatch, not User.
          case Name -> Map Name (Type Symbol Ann) -> Maybe (Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name (Type Symbol Ann)
unnamedTestWatchesByName of
            Maybe (Type Symbol Ann)
Nothing -> Codebase m Symbol Ann
-> TypeReference -> Transaction (Type Symbol Ann)
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a -> TypeReference -> Transaction (Type Symbol a)
Codebase.expectTypeOfTerm Codebase m Symbol Ann
codebase TypeReference
ref
            Just Type Symbol Ann
ty -> Type Symbol Ann -> Transaction (Type Symbol Ann)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type Symbol Ann
ty

    unnamedTestWatchesByName :: Map Name (Type Symbol Ann)
    unnamedTestWatchesByName :: Map Name (Type Symbol Ann)
unnamedTestWatchesByName =
      ((FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
 -> Map Name (Type Symbol Ann) -> Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
-> [(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> Map Name (Type Symbol Ann)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> Map Name (Type Symbol Ann) -> Map Name (Type Symbol Ann)
f Map Name (Type Symbol Ann)
forall k a. Map k a
Map.empty TypecheckedUnisonFile Symbol Ann
unisonFile.watchComponents
      where
        f ::
          (WatchKind, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]) ->
          Map Name (Type Symbol Ann) ->
          Map Name (Type Symbol Ann)
        f :: (FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
-> Map Name (Type Symbol Ann) -> Map Name (Type Symbol Ann)
f (FilePath
WatchKind.TestWatch, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
component) Map Name (Type Symbol Ann)
acc = ((Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
 -> Map Name (Type Symbol Ann) -> Map Name (Type Symbol Ann))
-> Map Name (Type Symbol Ann)
-> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
-> Map Name (Type Symbol Ann)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
-> Map Name (Type Symbol Ann) -> Map Name (Type Symbol Ann)
g Map Name (Type Symbol Ann)
acc [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
component
        f (FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])
_ Map Name (Type Symbol Ann)
acc = Map Name (Type Symbol Ann)
acc

        g ::
          (Symbol, Ann, Term Symbol Ann, Type Symbol Ann) ->
          Map Name (Type Symbol Ann) ->
          Map Name (Type Symbol Ann)
        g :: (Symbol, Ann, Term Symbol Ann, Type Symbol Ann)
-> Map Name (Type Symbol Ann) -> Map Name (Type Symbol Ann)
g (Symbol
var, Ann
_, Term Symbol Ann
_, Type Symbol Ann
ty) Map Name (Type Symbol Ann)
acc =
          case Symbol -> Type
forall v. Var v => v -> Type
Var.typeOf Symbol
var of
            Var.UnnamedWatch FilePath
_ Text
_ -> Name
-> Type Symbol Ann
-> Map Name (Type Symbol Ann)
-> Map Name (Type Symbol Ann)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
var) Type Symbol Ann
ty Map Name (Type Symbol Ann)
acc
            Type
_ -> Map Name (Type Symbol Ann)
acc

slurpTypes ::
  Codebase m Symbol Ann ->
  TypecheckedUnisonFile Symbol Ann ->
  Bool ->
  Map Name (Set TypeReference) ->
  Map Name (Set TypeReference) ->
  Sqlite.Transaction (Map Name TypeSlurp)
slurpTypes :: forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name TypeSlurp)
slurpTypes Codebase m Symbol Ann
codebase TypecheckedUnisonFile Symbol Ann
unisonFile Bool
isUpdate =
  WhenMissing Transaction Name (Set TypeReference) TypeSlurp
-> WhenMissing Transaction Name (Set TypeReference) TypeSlurp
-> WhenMatched
     Transaction Name (Set TypeReference) (Set TypeReference) TypeSlurp
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name TypeSlurp)
forall (f :: * -> *) k a c b.
(Applicative f, Ord k) =>
WhenMissing f k a c
-> WhenMissing f k b c
-> WhenMatched f k a b c
-> Map k a
-> Map k b
-> f (Map k c)
Map.mergeA
    ( if Bool
isUpdate
        then (Name -> Set TypeReference -> Transaction TypeSlurp)
-> WhenMissing Transaction Name (Set TypeReference) TypeSlurp
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
Map.traverseMissing \Name
_ -> (DeclOrBuiltin Symbol Ann -> TypeSlurp)
-> Transaction (DeclOrBuiltin Symbol Ann) -> Transaction TypeSlurp
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DeclOrBuiltin Symbol Ann -> TypeSlurp
TypeSlurp'Delete (Transaction (DeclOrBuiltin Symbol Ann) -> Transaction TypeSlurp)
-> (Set TypeReference -> Transaction (DeclOrBuiltin Symbol Ann))
-> Set TypeReference
-> Transaction TypeSlurp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeReference -> Transaction (DeclOrBuiltin Symbol Ann)
getOldDecl (TypeReference -> Transaction (DeclOrBuiltin Symbol Ann))
-> (Set TypeReference -> TypeReference)
-> Set TypeReference
-> Transaction (DeclOrBuiltin Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TypeReference -> TypeReference
forall a. Set a -> a
Set.findMin
        else WhenMissing Transaction Name (Set TypeReference) TypeSlurp
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
    )
    ((Name -> Set TypeReference -> Transaction TypeSlurp)
-> WhenMissing Transaction Name (Set TypeReference) TypeSlurp
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
Map.traverseMissing \Name
name -> (DeclOrBuiltin Symbol Ann -> TypeSlurp)
-> Transaction (DeclOrBuiltin Symbol Ann) -> Transaction TypeSlurp
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DeclOrBuiltin Symbol Ann -> TypeSlurp
TypeSlurp'Add (Transaction (DeclOrBuiltin Symbol Ann) -> Transaction TypeSlurp)
-> (Set TypeReference -> Transaction (DeclOrBuiltin Symbol Ann))
-> Set TypeReference
-> Transaction TypeSlurp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TypeReference -> Transaction (DeclOrBuiltin Symbol Ann)
getNewDecl Name
name (TypeReference -> Transaction (DeclOrBuiltin Symbol Ann))
-> (Set TypeReference -> TypeReference)
-> Set TypeReference
-> Transaction (DeclOrBuiltin Symbol Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TypeReference -> TypeReference
forall a. Set a -> a
Set.findMin)
    ( (Name
 -> Set TypeReference
 -> Set TypeReference
 -> Transaction (Maybe TypeSlurp))
-> WhenMatched
     Transaction Name (Set TypeReference) (Set TypeReference) TypeSlurp
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
Map.zipWithMaybeAMatched \Name
name Set TypeReference
oldRefs Set TypeReference
newRefs ->
        let oldRef :: TypeReference
oldRef = Set TypeReference -> TypeReference
forall a. Set a -> a
Set.findMin Set TypeReference
oldRefs
            newRef :: TypeReference
newRef = Set TypeReference -> TypeReference
forall a. Set a -> a
Set.findMin Set TypeReference
newRefs
         in if TypeReference
oldRef TypeReference -> TypeReference -> Bool
forall a. Eq a => a -> a -> Bool
/= TypeReference
newRef
              then (TypeSlurp -> Maybe TypeSlurp)
-> Transaction TypeSlurp -> Transaction (Maybe TypeSlurp)
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeSlurp -> Maybe TypeSlurp
forall a. a -> Maybe a
Just do
                oldDecl <- TypeReference -> Transaction (DeclOrBuiltin Symbol Ann)
getOldDecl TypeReference
oldRef
                newDecl <- getNewDecl name newRef
                pure (TypeSlurp'Update (Updated oldDecl newDecl))
              else
                Maybe TypeSlurp -> Transaction (Maybe TypeSlurp)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  if Bool
isUpdate
                    then case Symbol
-> TypecheckedUnisonFile Symbol Ann -> Maybe (Id, Decl Symbol Ann)
forall v a.
Ord v =>
v -> TypecheckedUnisonFile v a -> Maybe (Id, Decl v a)
UF.lookupDecl (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
name) TypecheckedUnisonFile Symbol Ann
unisonFile of
                      Maybe (Id, Decl Symbol Ann)
Nothing -> Maybe TypeSlurp
forall a. Maybe a
Nothing
                      Just (Id, Decl Symbol Ann)
_ -> TypeSlurp -> Maybe TypeSlurp
forall a. a -> Maybe a
Just TypeSlurp
TypeSlurp'Unchanged
                    else TypeSlurp -> Maybe TypeSlurp
forall a. a -> Maybe a
Just TypeSlurp
TypeSlurp'Unchanged
    )
  where
    getOldDecl :: TypeReference -> Sqlite.Transaction (DeclOrBuiltin Symbol Ann)
    getOldDecl :: TypeReference -> Transaction (DeclOrBuiltin Symbol Ann)
getOldDecl = \case
      Reference.DerivedId Id
ref -> Decl Symbol Ann -> DeclOrBuiltin Symbol Ann
forall a b. b -> OrBuiltin a b
NotBuiltin (Decl Symbol Ann -> DeclOrBuiltin Symbol Ann)
-> Transaction (Decl Symbol Ann)
-> Transaction (DeclOrBuiltin Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m Symbol Ann -> Id -> Transaction (Decl Symbol Ann)
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id -> Transaction (Decl v a)
Codebase.unsafeGetTypeDeclaration Codebase m Symbol Ann
codebase Id
ref
      Reference.Builtin Text
builtin -> DeclOrBuiltin Symbol Ann -> Transaction (DeclOrBuiltin Symbol Ann)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstructorType -> DeclOrBuiltin Symbol Ann
forall a b. a -> OrBuiltin a b
Builtin (Text -> ConstructorType
Builtin.expectBuiltinConstructorType Text
builtin))
    getNewDecl :: Name -> TypeReference -> Sqlite.Transaction (DeclOrBuiltin Symbol Ann)
    getNewDecl :: Name -> TypeReference -> Transaction (DeclOrBuiltin Symbol Ann)
getNewDecl Name
name = \case
      Reference.DerivedId Id
ref ->
        case Symbol
-> TypecheckedUnisonFile Symbol Ann -> Maybe (Id, Decl Symbol Ann)
forall v a.
Ord v =>
v -> TypecheckedUnisonFile v a -> Maybe (Id, Decl v a)
UF.lookupDecl (Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
name) TypecheckedUnisonFile Symbol Ann
unisonFile of
          Just (Id
_, Decl Symbol Ann
decl) -> DeclOrBuiltin Symbol Ann -> Transaction (DeclOrBuiltin Symbol Ann)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decl Symbol Ann -> DeclOrBuiltin Symbol Ann
forall a b. b -> OrBuiltin a b
NotBuiltin Decl Symbol Ann
decl)
          Maybe (Id, Decl Symbol Ann)
Nothing -> Decl Symbol Ann -> DeclOrBuiltin Symbol Ann
forall a b. b -> OrBuiltin a b
NotBuiltin (Decl Symbol Ann -> DeclOrBuiltin Symbol Ann)
-> Transaction (Decl Symbol Ann)
-> Transaction (DeclOrBuiltin Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m Symbol Ann -> Id -> Transaction (Decl Symbol Ann)
forall (m :: * -> *) v a.
HasCallStack =>
Codebase m v a -> Id -> Transaction (Decl v a)
Codebase.unsafeGetTypeDeclaration Codebase m Symbol Ann
codebase Id
ref
      Reference.Builtin Text
builtin -> DeclOrBuiltin Symbol Ann -> Transaction (DeclOrBuiltin Symbol Ann)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstructorType -> DeclOrBuiltin Symbol Ann
forall a b. a -> OrBuiltin a b
Builtin (Text -> ConstructorType
Builtin.expectBuiltinConstructorType Text
builtin))

getTermAliases :: Relation Name Referent -> Map Name TermSlurp -> Map Referent (NESet Name)
getTermAliases :: Relation Name Referent
-> Map Name TermSlurp -> Map Referent (NESet Name)
getTermAliases Relation Name Referent
existingTerms Map Name TermSlurp
slurpTerms =
  -- For the purpose of identifying aliases to call out, we omit names that are changing by this update.
  let (Set Name
changedNames, Set Referent
changedRefs) =
        ((Set Name, Set Referent)
 -> Name -> TermSlurp -> (Set Name, Set Referent))
-> (Set Name, Set Referent)
-> Map Name TermSlurp
-> (Set Name, Set Referent)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
          ( \ ~acc :: (Set Name, Set Referent)
acc@(Set Name
names, Set Referent
refs) Name
name -> \case
              TermSlurp'Add (Typed TypeReference
ref Type Symbol Ann
_) ->
                let !names1 :: Set Name
names1 = Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert Name
name Set Name
names
                    !refs1 :: Set Referent
refs1 = Referent -> Set Referent -> Set Referent
forall a. Ord a => a -> Set a -> Set a
Set.insert (TypeReference -> Referent
Referent.Ref TypeReference
ref) Set Referent
refs
                 in (Set Name
names1, Set Referent
refs1)
              TermSlurp'Delete (Typed TypeReference
ref Type Symbol Ann
_) ->
                let !names1 :: Set Name
names1 = Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert Name
name Set Name
names
                    !refs1 :: Set Referent
refs1 = Referent -> Set Referent -> Set Referent
forall a. Ord a => a -> Set a -> Set a
Set.insert (TypeReference -> Referent
Referent.Ref TypeReference
ref) Set Referent
refs
                 in (Set Name
names1, Set Referent
refs1)
              TermSlurp'Update (Updated (Typed Referent
old Type Symbol Ann
_) (Typed Referent
new Type Symbol Ann
_)) ->
                let !names1 :: Set Name
names1 = Name -> Set Name -> Set Name
forall a. Ord a => a -> Set a -> Set a
Set.insert Name
name Set Name
names
                    !refs1 :: Set Referent
refs1 = Referent -> Set Referent -> Set Referent
forall a. Ord a => a -> Set a -> Set a
Set.insert Referent
new (Referent -> Set Referent -> Set Referent
forall a. Ord a => a -> Set a -> Set a
Set.insert Referent
old Set Referent
refs)
                 in (Set Name
names1, Set Referent
refs1)
              TermSlurp
TermSlurp'Unchanged -> (Set Name, Set Referent)
acc
          )
          (Set Name
forall a. Set a
Set.empty, Set Referent
forall a. Set a
Set.empty)
          Map Name TermSlurp
slurpTerms

      step :: Map Referent (NESet Name) -> Referent -> Map Referent (NESet Name)
step Map Referent (NESet Name)
acc Referent
ref =
        let existingNames :: Set Name
existingNames = Referent -> Relation Name Referent -> Set Name
forall b a. Ord b => b -> Relation a b -> Set a
Relation.lookupRan Referent
ref Relation Name Referent
existingTerms
         in case Set Name -> Maybe (NESet Name)
forall a. Set a -> Maybe (NESet a)
Set.NonEmpty.nonEmptySet (Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Name
existingNames Set Name
changedNames) of
              Maybe (NESet Name)
Nothing -> Map Referent (NESet Name)
acc
              Just NESet Name
aliases -> Referent
-> NESet Name
-> Map Referent (NESet Name)
-> Map Referent (NESet Name)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Referent
ref NESet Name
aliases Map Referent (NESet Name)
acc
   in (Map Referent (NESet Name)
 -> Referent -> Map Referent (NESet Name))
-> Map Referent (NESet Name)
-> Set Referent
-> Map Referent (NESet Name)
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Map Referent (NESet Name) -> Referent -> Map Referent (NESet Name)
step Map Referent (NESet Name)
forall k a. Map k a
Map.empty Set Referent
changedRefs

parseAndTypecheckUnisonFile ::
  Names ->
  Text ->
  Text ->
  Cli (TypecheckedUnisonFile Symbol Ann)
parseAndTypecheckUnisonFile :: Names -> Text -> Text -> Cli (TypecheckedUnisonFile Symbol Ann)
parseAndTypecheckUnisonFile Names
names Text
sourceName Text
text = do
  pp <- Cli ProjectPath
Cli.getCurrentProjectPath
  State.modify' \LoopState
loopState ->
    LoopState
loopState
      LoopState -> (LoopState -> LoopState) -> LoopState
forall a b. a -> (a -> b) -> b
& (ASetter
  LoopState
  LoopState
  (Maybe (FilePath, Bool))
  (Maybe (FilePath, Bool))
#latestFile ASetter
  LoopState
  LoopState
  (Maybe (FilePath, Bool))
  (Maybe (FilePath, Bool))
-> Maybe (FilePath, Bool) -> LoopState -> LoopState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (FilePath, Bool) -> Maybe (FilePath, Bool)
forall a. a -> Maybe a
Just (Text -> FilePath
Text.unpack Text
sourceName, Bool
False))
      LoopState -> (LoopState -> LoopState) -> LoopState
forall a b. a -> (a -> b) -> b
& (ASetter
  LoopState
  LoopState
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
#latestTypecheckedFile ASetter
  LoopState
  LoopState
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
  (Maybe
     (Either
        (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)))
-> Maybe
     (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
-> LoopState
-> LoopState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe
  (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
forall a. Maybe a
Nothing)
  Cli.Env {codebase, generateUniqueName} <- ask
  uniqueName <- liftIO generateUniqueName
  let parsingEnv =
        Parser.ParsingEnv
          { uniqueNames :: UniqueName
uniqueNames = UniqueName
uniqueName,
            uniqueTypeGuid :: Name -> Transaction (Maybe Text)
uniqueTypeGuid = ProjectPath -> Name -> Transaction (Maybe Text)
Cli.loadUniqueTypeGuid ProjectPath
pp,
            Names
names :: Names
names :: Names
names,
            maybeNamespace :: Maybe Name
maybeNamespace = Maybe Name
forall a. Maybe a
Nothing,
            localNamespacePrefixedTypesAndConstructors :: Names
localNamespacePrefixedTypesAndConstructors = Names
forall a. Monoid a => a
mempty
          }
  unisonFile <-
    Cli.runTransaction (Parsers.parseFile (Text.unpack sourceName) (Text.unpack text) parsingEnv)
      & onLeftM \Err Symbol
err -> Output -> Cli (UnisonFile Symbol Ann)
forall a. Output -> Cli a
Cli.returnEarly (Text -> [Err Symbol] -> Output
Output.ParseErrors Text
text [Err Symbol
err])
  -- set that the file at least parsed (but didn't typecheck)
  State.modify' (& #latestTypecheckedFile .~ Just (Left unisonFile))
  typecheckingEnv <-
    Cli.runTransaction do
      computeTypecheckingEnvironment (FileParsers.ShouldUseTndr'Yes parsingEnv) codebase [] unisonFile
  let Result.Result notes maybeTypecheckedUnisonFile = FileParsers.synthesizeFile typecheckingEnv unisonFile
      tws = [Warn Symbol Ann] -> [Warn Symbol Ann]
forall a. [a] -> [a]
reverse [Warn Symbol Ann
wrn | Result.TypeWarning Warn Symbol Ann
wrn <- Seq (Note Symbol Ann) -> [Note Symbol Ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Note Symbol Ann)
notes]
      suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
      pped =
        let ns :: Names
ns =
              Names
names
                -- Shadow just the type decl and constructor names (because the unison file didn't typecheck so we
                -- don't have term `Names`)
                Names -> (Names -> Names) -> Names
forall a b. a -> (a -> b) -> b
& Names -> Names -> Names
Names.shadowing (UnisonFile Symbol Ann -> Names
forall v a. Var v => UnisonFile v a -> Names
UF.toNames UnisonFile Symbol Ann
unisonFile)
         in Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED
              (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
ns)
              ( Set Name -> Names -> Suffixifier
PPE.suffixifyByHashWithUnhashedTermsInScope
                  ( Set Name -> Set Name -> Set Name
forall a. Ord a => Set a -> Set a -> Set a
Set.union
                      ((Symbol -> Name) -> Set Symbol -> Set Name
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar (Map Symbol (Ann, Term Symbol Ann) -> Set Symbol
forall k a. Map k a -> Set k
Map.keysSet (UnisonFile Symbol Ann -> Map Symbol (Ann, Term Symbol Ann)
forall v a. UnisonFile v a -> Map v (a, Term v a)
UF.terms UnisonFile Symbol Ann
unisonFile)))
                      ( ([(Symbol, Ann, Term Symbol Ann)] -> Set Name)
-> Map FilePath [(Symbol, Ann, Term Symbol Ann)] -> Set Name
forall m a. Monoid m => (a -> m) -> Map FilePath a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                          ( ((Symbol, Ann, Term Symbol Ann) -> Set Name)
-> [(Symbol, Ann, Term Symbol Ann)] -> Set Name
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
                              (Symbol
v, Ann
_, Term Symbol Ann
_) ->
                                case Symbol -> Type
forall v. Var v => v -> Type
Var.typeOf Symbol
v of
                                  Var.User Text
_ -> Name -> Set Name
forall a. a -> Set a
Set.singleton (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)
                                  Type
_ -> Set Name
forall a. Set a
Set.empty
                          )
                          (UnisonFile Symbol Ann
-> Map FilePath [(Symbol, Ann, Term Symbol Ann)]
forall v a. UnisonFile v a -> Map FilePath [(v, a, Term v a)]
UF.watches UnisonFile Symbol Ann
unisonFile)
                      )
                  )
                  Names
ns
              )

  when (not $ null tws) do
    currentPath <- Cli.getCurrentPath
    Cli.respond $
      Output.TypeWarns currentPath text suffixifiedPPE tws

  maybeTypecheckedUnisonFile & onNothing do
    let tes = [ErrorNote Symbol Ann
err | Result.TypeError ErrorNote Symbol Ann
err <- Seq (Note Symbol Ann) -> [Note Symbol Ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Note Symbol Ann)
notes]
        cbs =
          [ CompilerBug Symbol Ann
bug
          | Result.CompilerBug (Result.TypecheckerBug CompilerBug Symbol Ann
bug) <-
              Seq (Note Symbol Ann) -> [Note Symbol Ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Note Symbol Ann)
notes
          ]

    when (not (null tes)) do
      currentPath <- Cli.getCurrentPath
      Cli.respond (Output.TypeErrors currentPath text suffixifiedPPE tes)
    when (not (null cbs)) do
      Cli.respond (Output.CompilerBugs text suffixifiedPPE cbs)
    Cli.returnEarlyWithoutOutput

-- | Evaluate all watched expressions in a UnisonFile and return
-- their results, keyed by the name of the watch variable. The tuple returned
-- has the form:
--   (hash, (ann, sourceTerm, evaluatedTerm, isCacheHit))
--
-- where
--   `hash` is the hash of the original watch expression definition
--   `ann` gives the location of the watch expression
--   `sourceTerm` is a closed term (no free vars) for the watch expression
--   `evaluatedTerm` is the result of evaluating that `sourceTerm`
--   `isCacheHit` is True if the result was computed by just looking up
--   in a cache
--
-- It's expected that the user of this action might add the
-- `(hash, evaluatedTerm)` mapping to a cache to make future evaluations
-- of the same watches instantaneous.
evalUnisonFile ::
  EvalMode ->
  PPE.PrettyPrintEnv ->
  TypecheckedUnisonFile Symbol Ann ->
  [String] ->
  Cli
    ( Either
        Error
        ( [(Symbol, Term Symbol ())],
          Map Symbol (Ann, WatchKind, Reference.Id, Term Symbol (), Term Symbol (), Bool)
        )
    )
evalUnisonFile :: EvalMode
-> PrettyPrintEnv
-> TypecheckedUnisonFile Symbol Ann
-> [FilePath]
-> Cli
     (Either
        Error
        ([(Symbol, Term Symbol ())],
         Map
           Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)))
evalUnisonFile EvalMode
mode PrettyPrintEnv
ppe TypecheckedUnisonFile Symbol Ann
unisonFile [FilePath]
args = do
  env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask

  let theRuntime = case EvalMode
mode of
        EvalMode
Sandboxed -> Env
env.sandboxedRuntime
        Permissive ProfileSpec
_ -> Env
env.runtime
      prof = EvalMode -> ProfileSpec
modeProfSpec EvalMode
mode

  let watchCache :: Reference.Id -> IO (Maybe (Term Symbol ()))
      watchCache Id
ref = do
        maybeTerm <- Codebase IO Symbol Ann
-> Transaction (Maybe (Term Symbol Ann))
-> IO (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Env
env.codebase (Codebase IO Symbol Ann
-> Id -> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Term v a))
Codebase.lookupWatchCache Env
env.codebase Id
ref)
        pure (Term.amap (\(Ann
_ :: Ann) -> ()) <$> maybeTerm)

  Cli.with_ (withArgs args) do
    let codeLookup = Codebase IO Symbol Ann -> CodeLookup Symbol IO Ann
forall (m :: * -> *).
MonadIO m =>
Codebase m Symbol Ann -> CodeLookup Symbol m Ann
Codebase.codebaseToCodeLookup Env
env.codebase
    liftIO (Runtime.evaluateWatches codeLookup ppe prof watchCache theRuntime unisonFile) >>= \case
      Right ([(Symbol, Term Symbol ())]
nts, Response DecompError
resp, Map
  Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
map) -> do
        cache <- case Response DecompError
resp of
          Runtime.DecompErrs [DecompError]
errs
            | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [DecompError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DecompError]
errs ->
                Bool
False Bool -> Cli () -> Cli Bool
forall a b. a -> Cli b -> Cli a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [DecompError] -> Cli ()
RuntimeUtils.displayDecompileErrors [DecompError]
errs
          Runtime.Profile Pretty ColorText
prof ->
            Bool
True Bool -> Cli () -> Cli Bool
forall a b. a -> Cli b -> Cli a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Output -> Cli ()
Cli.respond (Pretty ColorText -> Output
Output.Literal Pretty ColorText
prof)
          Response DecompError
_ -> Bool -> Cli Bool
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        for_ (Map.elems map) \(Ann
_loc, FilePath
kind, Id
hash, Term Symbol ()
_src, Term Symbol ()
value, Bool
isHit) -> do
          -- only update the watch cache when there are no errors
          Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isHit Bool -> Bool -> Bool
&& Bool
cache) do
            let value' :: Term Symbol Ann
value' = (() -> Ann) -> Term Symbol () -> Term Symbol Ann
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap (\() -> Ann
Ann.External) Term Symbol ()
value
            Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction (FilePath -> Id -> Term Symbol Ann -> Transaction ()
Codebase.putWatch FilePath
kind Id
hash Term Symbol Ann
value')
        pure (Right (nts, map))
      Left Error
err -> Either
  Error
  ([(Symbol, Term Symbol ())],
   Map
     Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool))
-> Cli
     (Either
        Error
        ([(Symbol, Term Symbol ())],
         Map
           Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error
-> Either
     Error
     ([(Symbol, Term Symbol ())],
      Map
        Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool))
forall a b. a -> Either a b
Left Error
err)