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
  Maybe (FilePath, Bool)
latestFile <- Cli (Maybe (FilePath, Bool))
Cli.getLatestFile
  FilePath
path <- (Maybe FilePath
maybePath Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, Bool) -> FilePath)
-> Maybe (FilePath, Bool) -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FilePath, Bool)
latestFile) Maybe FilePath -> (Maybe FilePath -> Cli FilePath) -> Cli FilePath
forall a b. a -> (a -> b) -> b
& Cli FilePath -> Maybe FilePath -> Cli FilePath
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing (Output -> Cli FilePath
forall a. Output -> Cli a
Cli.returnEarly Output
Output.NoUnisonFile)
  Cli.Env {Text -> IO LoadSourceResult
loadSource :: Text -> IO LoadSourceResult
$sel:loadSource:Env :: Env -> Text -> IO LoadSourceResult
loadSource} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Text
contents <-
    IO LoadSourceResult -> Cli LoadSourceResult
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> IO LoadSourceResult
loadSource (FilePath -> Text
Text.pack FilePath
path)) Cli LoadSourceResult -> (LoadSourceResult -> Cli Text) -> Cli Text
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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
  Text -> Text -> Cli ()
loadUnisonFile (FilePath -> Text
Text.pack FilePath
path) Text
contents

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

  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Text -> Output
Output.LoadingFile Text
sourceName
  Branch0 IO
oldBranch0 <- Cli (Branch0 IO)
Cli.getCurrentBranch0
  let oldNames :: Names
oldNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
oldBranch0
  TypecheckedUnisonFile Symbol Ann
unisonFile <- Names -> Text -> Text -> Cli (TypecheckedUnisonFile Symbol Ann)
parseAndTypecheckUnisonFile Names
oldNames Text
sourceName Text
text
  let unisonFileNames :: Names
unisonFileNames = TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames TypecheckedUnisonFile Symbol Ann
unisonFile
  let newNames :: Names
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 :: PrettyPrintEnv
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))
  ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath

  Maybe CausalHash
maybeUpdateOrUpgradeBranchParentCausalHash <-
    if ProjectPath
pp.branch.isUpdate Bool -> Bool -> Bool
|| ProjectPath
pp.branch.isUpgrade
      then case ProjectPath
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 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

  case Maybe CausalHash
maybeUpdateOrUpgradeBranchParentCausalHash of
    Maybe CausalHash
Nothing -> do
      Defns (Map Name TermSlurp) (Map Name TypeSlurp)
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
          Map Name TermSlurp
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)
          Map Name TypeSlurp
types <-
            Codebase IO Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name TypeSlurp)
forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name TypeSlurp)
slurpTypes
              Env
env.codebase
              TypecheckedUnisonFile Symbol Ann
unisonFile
              Bool
False
              (Relation Name TypeReference -> Map Name (Set TypeReference)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Names
oldNames.types)
              (Relation Name TypeReference -> Map Name (Set TypeReference)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Names
unisonFileNames.types)
          Defns (Map Name TermSlurp) (Map Name TypeSlurp)
-> Transaction (Defns (Map Name TermSlurp) (Map Name TypeSlurp))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Defns {Map Name TermSlurp
terms :: Map Name TermSlurp
$sel:terms:Defns :: Map Name TermSlurp
terms, Map Name TypeSlurp
types :: Map Name TypeSlurp
$sel:types:Defns :: Map Name TypeSlurp
types}

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

      let oldPpe :: PrettyPrintEnv
oldPpe =
            PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE (Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
oldNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
oldNames))

      Output -> Cli ()
Cli.respond (PrettyPrintEnv
-> PrettyPrintEnv
-> Defns (Map Name TermSlurp) (Map Name TypeSlurp)
-> Map Referent (NESet Name)
-> Output
Output.Typechecked PrettyPrintEnv
oldPpe PrettyPrintEnv
newPpe Defns (Map Name TermSlurp) (Map Name TypeSlurp)
slurpEntries Map Referent (NESet Name)
aliases)
    Just CausalHash
updateOrUpgradeBranchParentCausalHash -> do
      Branch IO
updateOrUpgradeBranchParent <- 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
updateOrUpgradeBranchParentCausalHash)
      let updateOrUpgradeBranchParent0 :: Branch0 IO
updateOrUpgradeBranchParent0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
updateOrUpgradeBranchParent
      let updateOrUpgradeBranchParentNames :: Names
updateOrUpgradeBranchParentNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
updateOrUpgradeBranchParent0
      let updateOrUpgradeBranchParentLocalNames :: Names
updateOrUpgradeBranchParentLocalNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
updateOrUpgradeBranchParent0)
      let updateOrUpgradeBranchLocalNames :: Names
updateOrUpgradeBranchLocalNames =
            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))

      Defns (Map Name TermSlurp) (Map Name TypeSlurp)
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
          Map Name TermSlurp
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
True
              (Relation Name Referent -> Map Name (Set Referent)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Names
updateOrUpgradeBranchParentLocalNames.terms)
              (Relation Name Referent -> Map Name (Set Referent)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Names
updateOrUpgradeBranchLocalNames.terms)
          Map Name TypeSlurp
types <-
            Codebase IO Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name TypeSlurp)
forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name TypeSlurp)
slurpTypes
              Env
env.codebase
              TypecheckedUnisonFile Symbol Ann
unisonFile
              Bool
False
              (Relation Name TypeReference -> Map Name (Set TypeReference)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Names
updateOrUpgradeBranchParentLocalNames.types)
              (Relation Name TypeReference -> Map Name (Set TypeReference)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Names
updateOrUpgradeBranchLocalNames.types)
          Defns (Map Name TermSlurp) (Map Name TypeSlurp)
-> Transaction (Defns (Map Name TermSlurp) (Map Name TypeSlurp))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Defns {Map Name TermSlurp
$sel:terms:Defns :: Map Name TermSlurp
terms :: Map Name TermSlurp
terms, Map Name TypeSlurp
$sel:types:Defns :: Map Name TypeSlurp
types :: Map Name TypeSlurp
types}

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

      let oldPpe :: PrettyPrintEnv
oldPpe =
            PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE (PrettyPrintEnvDecl -> PrettyPrintEnv)
-> PrettyPrintEnvDecl -> PrettyPrintEnv
forall a b. (a -> b) -> a -> b
$
              Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED
                (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
updateOrUpgradeBranchParentNames)
                (Names -> Suffixifier
PPE.suffixifyByHash Names
updateOrUpgradeBranchParentNames)

      Output -> Cli ()
Cli.respond (PrettyPrintEnv
-> PrettyPrintEnv
-> Defns (Map Name TermSlurp) (Map Name TypeSlurp)
-> Map Referent (NESet Name)
-> Output
Output.Typechecked PrettyPrintEnv
oldPpe PrettyPrintEnv
newPpe Defns (Map Name TermSlurp) (Map Name TypeSlurp)
slurpEntries Map Referent (NESet Name)
aliases)

  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool)
-> ([(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
    -> Bool)
-> [(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
 -> Bool)
-> [(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> Bool
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> [(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
forall v a.
TypecheckedUnisonFile v a
-> [(FilePath, [(v, a, Term v a, Type v a)])]
UF.watchComponents TypecheckedUnisonFile Symbol Ann
unisonFile) do
    Text -> Cli () -> Cli ()
forall (m :: * -> *) a. MonadIO m => Text -> m a -> m a
Timing.time Text
"evaluating watches" do
      EvalMode
-> PrettyPrintEnv
-> TypecheckedUnisonFile Symbol Ann
-> [FilePath]
-> Cli
     (Either
        Error
        ([(Symbol, Term Symbol ())],
         Map
           Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)))
evalUnisonFile (ProfileSpec -> EvalMode
Permissive ProfileSpec
NoProf) PrettyPrintEnv
newPpe TypecheckedUnisonFile Symbol Ann
unisonFile [] Cli
  (Either
     Error
     ([(Symbol, Term Symbol ())],
      Map
        Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)))
-> (Either
      Error
      ([(Symbol, Term Symbol ())],
       Map
         Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool))
    -> Cli ())
-> Cli ()
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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
              Type Symbol Ann
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
              Maybe TermSlurp -> Transaction (Maybe TermSlurp)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermSlurp -> Maybe TermSlurp
forall a. a -> Maybe a
Just (Typed TypeReference Symbol Ann -> TermSlurp
TermSlurp'Delete (TypeReference -> Type Symbol Ann -> Typed TypeReference Symbol Ann
forall a v ann. a -> Type v ann -> Typed a v ann
Typed TypeReference
ref Type Symbol Ann
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
            Type Symbol Ann
ty <- Name -> TypeReference -> Transaction (Type Symbol Ann)
getNewRefType Name
name TypeReference
ref
            Maybe TermSlurp -> Transaction (Maybe TermSlurp)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermSlurp -> Maybe TermSlurp
forall a. a -> Maybe a
Just (Typed TypeReference Symbol Ann -> TermSlurp
TermSlurp'Add (TypeReference -> Type Symbol Ann -> Typed TypeReference Symbol Ann
forall a v ann. a -> Type v ann -> Typed a v ann
Typed TypeReference
ref Type Symbol Ann
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
                    Type Symbol Ann
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
                    Type Symbol Ann
newType <- Name -> TypeReference -> Transaction (Type Symbol Ann)
getNewRefType Name
name TypeReference
newRef1
                    Maybe TermSlurp -> Transaction (Maybe TermSlurp)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermSlurp -> Maybe TermSlurp
forall a. a -> Maybe a
Just (Updated (Typed Referent Symbol Ann) -> TermSlurp
TermSlurp'Update (Typed Referent Symbol Ann
-> Typed Referent Symbol Ann -> Updated (Typed Referent Symbol Ann)
forall a b. a -> b -> GUpdated a b
Updated (Referent -> Type Symbol Ann -> Typed Referent Symbol Ann
forall a v ann. a -> Type v ann -> Typed a v ann
Typed Referent
oldRef Type Symbol Ann
oldType) (Referent -> Type Symbol Ann -> Typed Referent Symbol Ann
forall a v ann. a -> Type v ann -> Typed a v ann
Typed Referent
newRef Type Symbol Ann
newType))))
              (Referent.Con ConstructorReference
oldRef1 ConstructorType
_, Referent.Ref TypeReference
newRef1) -> do
                Type Symbol Ann
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
                Type Symbol Ann
newType <- Name -> TypeReference -> Transaction (Type Symbol Ann)
getNewRefType Name
name TypeReference
newRef1
                Maybe TermSlurp -> Transaction (Maybe TermSlurp)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermSlurp -> Maybe TermSlurp
forall a. a -> Maybe a
Just (Updated (Typed Referent Symbol Ann) -> TermSlurp
TermSlurp'Update (Typed Referent Symbol Ann
-> Typed Referent Symbol Ann -> Updated (Typed Referent Symbol Ann)
forall a b. a -> b -> GUpdated a b
Updated (Referent -> Type Symbol Ann -> Typed Referent Symbol Ann
forall a v ann. a -> Type v ann -> Typed a v ann
Typed Referent
oldRef Type Symbol Ann
oldType) (Referent -> Type Symbol Ann -> Typed Referent Symbol Ann
forall a v ann. a -> Type v ann -> Typed a v ann
Typed Referent
newRef Type Symbol Ann
newType))))
              (Referent.Ref TypeReference
oldRef1, Referent.Con ConstructorReference
newRef1 ConstructorType
_) -> do
                Type Symbol Ann
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
                Type Symbol Ann
newType <- Name -> ConstructorReference -> Transaction (Type Symbol Ann)
getNewConType Name
name ConstructorReference
newRef1
                Maybe TermSlurp -> Transaction (Maybe TermSlurp)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermSlurp -> Maybe TermSlurp
forall a. a -> Maybe a
Just (Updated (Typed Referent Symbol Ann) -> TermSlurp
TermSlurp'Update (Typed Referent Symbol Ann
-> Typed Referent Symbol Ann -> Updated (Typed Referent Symbol Ann)
forall a b. a -> b -> GUpdated a b
Updated (Referent -> Type Symbol Ann -> Typed Referent Symbol Ann
forall a v ann. a -> Type v ann -> Typed a v ann
Typed Referent
oldRef Type Symbol Ann
oldType) (Referent -> Type Symbol Ann -> Typed Referent Symbol Ann
forall a v ann. a -> Type v ann -> Typed a v ann
Typed Referent
newRef Type Symbol Ann
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 =>
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
                DeclOrBuiltin Symbol Ann
oldDecl <- TypeReference -> Transaction (DeclOrBuiltin Symbol Ann)
getOldDecl TypeReference
oldRef
                DeclOrBuiltin Symbol Ann
newDecl <- Name -> TypeReference -> Transaction (DeclOrBuiltin Symbol Ann)
getNewDecl Name
name TypeReference
newRef
                TypeSlurp -> Transaction TypeSlurp
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Updated (DeclOrBuiltin Symbol Ann) -> TypeSlurp
TypeSlurp'Update (DeclOrBuiltin Symbol Ann
-> DeclOrBuiltin Symbol Ann -> Updated (DeclOrBuiltin Symbol Ann)
forall a b. a -> b -> GUpdated a b
Updated DeclOrBuiltin Symbol Ann
oldDecl DeclOrBuiltin Symbol Ann
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
  ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
  (LoopState -> LoopState) -> Cli ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
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 IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase, IO UniqueName
generateUniqueName :: IO UniqueName
$sel:generateUniqueName:Env :: Env -> IO UniqueName
generateUniqueName} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  UniqueName
uniqueName <- IO UniqueName -> Cli UniqueName
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UniqueName
generateUniqueName
  let parsingEnv :: ParsingEnv Transaction
parsingEnv =
        Parser.ParsingEnv
          { $sel:uniqueNames:ParsingEnv :: UniqueName
uniqueNames = UniqueName
uniqueName,
            $sel:uniqueTypeGuid:ParsingEnv :: Name -> Transaction (Maybe Text)
uniqueTypeGuid = ProjectPath -> Name -> Transaction (Maybe Text)
Cli.loadUniqueTypeGuid ProjectPath
pp,
            Names
names :: Names
$sel:names:ParsingEnv :: Names
names,
            $sel:maybeNamespace:ParsingEnv :: Maybe Name
maybeNamespace = Maybe Name
forall a. Maybe a
Nothing,
            $sel:localNamespacePrefixedTypesAndConstructors:ParsingEnv :: Names
localNamespacePrefixedTypesAndConstructors = Names
forall a. Monoid a => a
mempty
          }
  UnisonFile Symbol Ann
unisonFile <-
    Transaction (Either (Err Symbol) (UnisonFile Symbol Ann))
-> Cli (Either (Err Symbol) (UnisonFile Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction (FilePath
-> FilePath
-> ParsingEnv Transaction
-> Transaction (Either (Err Symbol) (UnisonFile Symbol Ann))
forall (m :: * -> *) v.
(Monad m, Var v) =>
FilePath
-> FilePath
-> ParsingEnv m
-> m (Either (Err v) (UnisonFile v Ann))
Parsers.parseFile (Text -> FilePath
Text.unpack Text
sourceName) (Text -> FilePath
Text.unpack Text
text) ParsingEnv Transaction
parsingEnv)
      Cli (Either (Err Symbol) (UnisonFile Symbol Ann))
-> (Cli (Either (Err Symbol) (UnisonFile Symbol Ann))
    -> Cli (UnisonFile Symbol Ann))
-> Cli (UnisonFile Symbol Ann)
forall a b. a -> (a -> b) -> b
& (Err Symbol -> Cli (UnisonFile Symbol Ann))
-> Cli (Either (Err Symbol) (UnisonFile Symbol Ann))
-> Cli (UnisonFile Symbol Ann)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
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)
  (LoopState -> LoopState) -> Cli ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify' (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
.~ Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)
-> Maybe
     (Either (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann))
forall a. a -> Maybe a
Just (UnisonFile Symbol Ann
-> Either
     (UnisonFile Symbol Ann) (TypecheckedUnisonFile Symbol Ann)
forall a b. a -> Either a b
Left UnisonFile Symbol Ann
unisonFile))
  Env Symbol Ann
typecheckingEnv <-
    Transaction (Env Symbol Ann) -> Cli (Env Symbol Ann)
forall a. Transaction a -> Cli a
Cli.runTransaction do
      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) Codebase IO Symbol Ann
codebase [] UnisonFile Symbol Ann
unisonFile
  let Result.Result Seq (Note Symbol Ann)
notes Maybe (TypecheckedUnisonFile Symbol Ann)
maybeTypecheckedUnisonFile = Env Symbol Ann
-> UnisonFile Symbol Ann
-> MaybeT
     (WriterT (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
unisonFile
      tws :: [Warn Symbol Ann]
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 :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
      pped :: PrettyPrintEnvDecl
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
              )

  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Warn Symbol Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Warn Symbol Ann]
tws) do
    Absolute
currentPath <- Cli Absolute
Cli.getCurrentPath
    Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$
      Absolute -> Text -> PrettyPrintEnv -> [Warn Symbol Ann] -> Output
Output.TypeWarns Absolute
currentPath Text
text PrettyPrintEnv
suffixifiedPPE [Warn Symbol Ann]
tws

  Maybe (TypecheckedUnisonFile Symbol Ann)
maybeTypecheckedUnisonFile Maybe (TypecheckedUnisonFile Symbol Ann)
-> (Maybe (TypecheckedUnisonFile Symbol Ann)
    -> Cli (TypecheckedUnisonFile Symbol Ann))
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall a b. a -> (a -> b) -> b
& Cli (TypecheckedUnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Cli (TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing do
    let tes :: [ErrorNote Symbol Ann]
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]
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
          ]

    Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([ErrorNote Symbol Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ErrorNote Symbol Ann]
tes)) do
      Absolute
currentPath <- Cli Absolute
Cli.getCurrentPath
      Output -> Cli ()
Cli.respond (Absolute
-> Text -> PrettyPrintEnv -> [ErrorNote Symbol Ann] -> Output
Output.TypeErrors Absolute
currentPath Text
text PrettyPrintEnv
suffixifiedPPE [ErrorNote Symbol Ann]
tes)
    Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([CompilerBug Symbol Ann] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CompilerBug Symbol Ann]
cbs)) do
      Output -> Cli ()
Cli.respond (Text -> PrettyPrintEnv -> [CompilerBug Symbol Ann] -> Output
Output.CompilerBugs Text
text PrettyPrintEnv
suffixifiedPPE [CompilerBug Symbol Ann]
cbs)
    Cli (TypecheckedUnisonFile Symbol Ann)
forall a. Cli a
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
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask

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

  let watchCache :: Reference.Id -> IO (Maybe (Term Symbol ()))
      watchCache :: Id -> IO (Maybe (Term Symbol ()))
watchCache Id
ref = do
        Maybe (Term Symbol Ann)
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)
        Maybe (Term Symbol ()) -> IO (Maybe (Term Symbol ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Ann -> ()) -> Term Symbol Ann -> Term Symbol ()
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap (\(Ann
_ :: Ann) -> ()) (Term Symbol Ann -> Term Symbol ())
-> Maybe (Term Symbol Ann) -> Maybe (Term Symbol ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Term Symbol Ann)
maybeTerm)

  (forall x. IO x -> IO x)
-> Cli
     (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. (forall x. IO x -> IO x) -> Cli a -> Cli a
Cli.with_ ([FilePath] -> IO x -> IO x
forall a. [FilePath] -> IO a -> IO a
withArgs [FilePath]
args) do
    let codeLookup :: CodeLookup Symbol IO Ann
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
    IO (WatchResults Error DecompError Symbol Ann)
-> Cli (WatchResults Error DecompError Symbol Ann)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CodeLookup Symbol IO Ann
-> PrettyPrintEnv
-> ProfileSpec
-> (Id -> IO (Maybe (Term Symbol ())))
-> Runtime Error DecompError Symbol
-> TypecheckedUnisonFile Symbol Ann
-> IO (WatchResults Error DecompError Symbol Ann)
forall e e' v a.
Var v =>
CodeLookup v IO a
-> PrettyPrintEnv
-> ProfileSpec
-> (Id -> IO (Maybe (Term v)))
-> Runtime e e' v
-> TypecheckedUnisonFile v a
-> IO (WatchResults e e' v a)
Runtime.evaluateWatches CodeLookup Symbol IO Ann
codeLookup PrettyPrintEnv
ppe ProfileSpec
prof Id -> IO (Maybe (Term Symbol ()))
watchCache Runtime Error DecompError Symbol
theRuntime TypecheckedUnisonFile Symbol Ann
unisonFile) Cli (WatchResults Error DecompError Symbol Ann)
-> (WatchResults Error DecompError Symbol Ann
    -> Cli
         (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 b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right ([(Symbol, Term Symbol ())]
nts, Response DecompError
resp, Map
  Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
map) -> do
        Bool
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
        [(Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)]
-> ((Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
    -> Cli ())
-> Cli ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map
  Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
-> [(Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)]
forall k a. Map k a -> [a]
Map.elems Map
  Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
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')
        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 (([(Symbol, Term Symbol ())],
 Map
   Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool))
-> Either
     Error
     ([(Symbol, Term Symbol ())],
      Map
        Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool))
forall a b. b -> Either a b
Right ([(Symbol, Term Symbol ())]
nts, Map
  Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
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)