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 (..))
import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Editor.SlurpResult (SlurpEntry (..), TermSlurp (..))
import Unison.Codebase.Execute qualified as Codebase
import Unison.Codebase.ProjectPath (ProjectPathG (..))
import Unison.Codebase.Runtime qualified as Runtime
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.DataDeclaration (DeclOrBuiltin)
import Unison.DataDeclaration qualified as DataDeclaration
import Unison.DataDeclaration qualified as DeclOrBuiltin (DeclOrBuiltin (..))
import Unison.FileParsers qualified as FileParsers
import Unison.Name (Name)
import Unison.Names (Names (..))
import Unison.Names qualified as Names
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 PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.PrettyPrintEnvDecl.Names 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.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.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 qualified as WK

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
PPE.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
maybeUpdateBranchParentCausalHash <-
    Transaction (Maybe CausalHash) -> Cli (Maybe CausalHash)
forall a. Transaction a -> Cli a
Cli.runTransaction do
      ProjectId -> ProjectBranchId -> Transaction Bool
Queries.projectBranchIsUpdateBranch ProjectPath
pp.project.projectId ProjectPath
pp.branch.branchId Transaction Bool
-> (Bool -> Transaction (Maybe CausalHash))
-> Transaction (Maybe CausalHash)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
False -> Maybe CausalHash -> Transaction (Maybe CausalHash)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CausalHash
forall a. Maybe a
Nothing
        Bool
True ->
          case ProjectPath
pp.branch.parentBranchId of
            Maybe ProjectBranchId
Nothing -> Maybe CausalHash -> Transaction (Maybe CausalHash)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CausalHash
forall a. Maybe a
Nothing -- impossible
            Just ProjectBranchId
updateBranchParentBranchId -> do
              CausalHashId
causalHashId <- HasCallStack =>
ProjectId -> ProjectBranchId -> Transaction CausalHashId
ProjectId -> ProjectBranchId -> Transaction CausalHashId
Queries.expectProjectBranchHead ProjectPath
pp.project.projectId ProjectBranchId
updateBranchParentBranchId
              CausalHash
causalHash <- CausalHashId -> Transaction CausalHash
Queries.expectCausalHash CausalHashId
causalHashId
              Maybe CausalHash -> Transaction (Maybe CausalHash)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CausalHash -> Maybe CausalHash
forall a. a -> Maybe a
Just CausalHash
causalHash)

  case Maybe CausalHash
maybeUpdateBranchParentCausalHash of
    Maybe CausalHash
Nothing -> do
      Defns
  (Map Name (TermSlurp Symbol Ann))
  (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
slurpEntries <-
        Transaction
  (Defns
     (Map Name (TermSlurp Symbol Ann))
     (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))))
-> Cli
     (Defns
        (Map Name (TermSlurp Symbol Ann))
        (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))))
forall a. Transaction a -> Cli a
Cli.runTransaction do
          Map Name (TermSlurp Symbol Ann)
terms <-
            Codebase IO Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Transaction (Map Name (TermSlurp Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Transaction (Map Name (TermSlurp Symbol Ann))
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 (SlurpEntry (DeclOrBuiltin Symbol Ann))
types <-
            Codebase IO Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
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 Symbol Ann))
  (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
-> Transaction
     (Defns
        (Map Name (TermSlurp Symbol Ann))
        (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Defns {Map Name (TermSlurp Symbol Ann)
terms :: Map Name (TermSlurp Symbol Ann)
$sel:terms:Defns :: Map Name (TermSlurp Symbol Ann)
terms, Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))
types :: Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))
$sel:types:Defns :: Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))
types}

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

      let oldPpe :: PrettyPrintEnv
oldPpe =
            PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.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 Symbol Ann))
     (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
-> Map Referent (NESet Name)
-> Output
Output.Typechecked PrettyPrintEnv
oldPpe PrettyPrintEnv
newPpe Defns
  (Map Name (TermSlurp Symbol Ann))
  (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
slurpEntries Map Referent (NESet Name)
aliases)
    Just CausalHash
updateBranchParentCausalHash -> do
      Branch IO
updateBranchParent <- 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
updateBranchParentCausalHash)
      let updateBranchParent0 :: Branch0 IO
updateBranchParent0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
updateBranchParent
      let updateBranchParentNames :: Names
updateBranchParentNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
updateBranchParent0
      let updateBranchParentLocalNames :: Names
updateBranchParentLocalNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
updateBranchParent0)
      let updateBranchLocalNames :: Names
updateBranchLocalNames = 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 Symbol Ann))
  (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
slurpEntries <-
        Transaction
  (Defns
     (Map Name (TermSlurp Symbol Ann))
     (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))))
-> Cli
     (Defns
        (Map Name (TermSlurp Symbol Ann))
        (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))))
forall a. Transaction a -> Cli a
Cli.runTransaction do
          Map Name (TermSlurp Symbol Ann)
terms <-
            Codebase IO Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Transaction (Map Name (TermSlurp Symbol Ann))
forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Transaction (Map Name (TermSlurp Symbol Ann))
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
updateBranchParentLocalNames.terms)
              (Relation Name Referent -> Map Name (Set Referent)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Names
updateBranchLocalNames.terms)
          Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))
types <-
            Codebase IO Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
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
updateBranchParentLocalNames.types)
              (Relation Name TypeReference -> Map Name (Set TypeReference)
forall a b. Relation a b -> Map a (Set b)
Relation.domain Names
updateBranchLocalNames.types)
          Defns
  (Map Name (TermSlurp Symbol Ann))
  (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
-> Transaction
     (Defns
        (Map Name (TermSlurp Symbol Ann))
        (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Defns {Map Name (TermSlurp Symbol Ann)
$sel:terms:Defns :: Map Name (TermSlurp Symbol Ann)
terms :: Map Name (TermSlurp Symbol Ann)
terms, Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))
$sel:types:Defns :: Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))
types :: Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann))
types}

      let aliases :: Map Referent (NESet Name)
          aliases :: Map Referent (NESet Name)
aliases =
            Relation Name Referent
-> Map Name (TermSlurp Symbol Ann) -> Map Referent (NESet Name)
getTermAliases Names
updateBranchParentNames.terms Defns
  (Map Name (TermSlurp Symbol Ann))
  (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
slurpEntries.terms

      let oldPpe :: PrettyPrintEnv
oldPpe =
            PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.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
updateBranchParentNames)
                (Names -> Suffixifier
PPE.suffixifyByHash Names
updateBranchParentNames)

      Output -> Cli ()
Cli.respond (PrettyPrintEnv
-> PrettyPrintEnv
-> Defns
     (Map Name (TermSlurp Symbol Ann))
     (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
-> Map Referent (NESet Name)
-> Output
Output.Typechecked PrettyPrintEnv
oldPpe PrettyPrintEnv
newPpe Defns
  (Map Name (TermSlurp Symbol Ann))
  (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
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
    FilePath -> Cli () -> Cli ()
forall (m :: * -> *) a. MonadIO m => FilePath -> m a -> m a
Timing.time FilePath
"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 EvalMode
Permissive 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 (Error -> Output
Output.EvaluationFailure 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 Symbol Ann))
slurpTerms :: forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Transaction (Map Name (TermSlurp Symbol Ann))
slurpTerms Codebase m Symbol Ann
codebase TypecheckedUnisonFile Symbol Ann
unisonFile Bool
isUpdate =
  WhenMissing Transaction Name (Set Referent) (TermSlurp Symbol Ann)
-> WhenMissing
     Transaction Name (Set Referent) (TermSlurp Symbol Ann)
-> WhenMatched
     Transaction
     Name
     (Set Referent)
     (Set Referent)
     (TermSlurp Symbol Ann)
-> Map Name (Set Referent)
-> Map Name (Set Referent)
-> Transaction (Map Name (TermSlurp Symbol Ann))
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 Symbol Ann)))
-> WhenMissing
     Transaction Name (Set Referent) (TermSlurp Symbol Ann)
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 Symbol Ann)
-> Transaction (Maybe (TermSlurp Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermSlurp Symbol Ann -> Maybe (TermSlurp Symbol Ann)
forall a. a -> Maybe a
Just (TypeReference -> Type Symbol Ann -> TermSlurp Symbol Ann
forall v a. TypeReference -> Type v a -> TermSlurp v a
TermSlurp'Delete TypeReference
ref Type Symbol Ann
ty))
            Referent.Con ConstructorReference
_ ConstructorType
_ -> Maybe (TermSlurp Symbol Ann)
-> Transaction (Maybe (TermSlurp Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TermSlurp Symbol Ann)
forall a. Maybe a
Nothing
        else WhenMissing Transaction Name (Set Referent) (TermSlurp Symbol Ann)
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
    )
    ( (Name
 -> Set Referent -> Transaction (Maybe (TermSlurp Symbol Ann)))
-> WhenMissing
     Transaction Name (Set Referent) (TermSlurp Symbol Ann)
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 Symbol Ann)
-> Transaction (Maybe (TermSlurp Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermSlurp Symbol Ann -> Maybe (TermSlurp Symbol Ann)
forall a. a -> Maybe a
Just (TypeReference -> Type Symbol Ann -> TermSlurp Symbol Ann
forall v a. TypeReference -> Type v a -> TermSlurp v a
TermSlurp'Add TypeReference
ref Type Symbol Ann
ty))
          Referent.Con ConstructorReference
_ ConstructorType
_ -> Maybe (TermSlurp Symbol Ann)
-> Transaction (Maybe (TermSlurp Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TermSlurp Symbol Ann)
forall a. Maybe a
Nothing
    )
    ( (Name
 -> Set Referent
 -> Set Referent
 -> Transaction (Maybe (TermSlurp Symbol Ann)))
-> WhenMatched
     Transaction
     Name
     (Set Referent)
     (Set Referent)
     (TermSlurp Symbol Ann)
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 Symbol Ann)
-> Transaction (Maybe (TermSlurp Symbol Ann))
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 Symbol Ann -> Maybe (TermSlurp Symbol Ann)
forall a. a -> Maybe a
Just TermSlurp Symbol Ann
forall v a. TermSlurp v a
TermSlurp'Unchanged
                        else Maybe (TermSlurp Symbol Ann)
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 Symbol Ann)
-> Transaction (Maybe (TermSlurp Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermSlurp Symbol Ann -> Maybe (TermSlurp Symbol Ann)
forall a. a -> Maybe a
Just (Referent
-> Type Symbol Ann
-> Referent
-> Type Symbol Ann
-> TermSlurp Symbol Ann
forall v a.
Referent -> Type v a -> Referent -> Type v a -> TermSlurp v a
TermSlurp'Update Referent
oldRef Type Symbol Ann
oldType 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 Symbol Ann)
-> Transaction (Maybe (TermSlurp Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermSlurp Symbol Ann -> Maybe (TermSlurp Symbol Ann)
forall a. a -> Maybe a
Just (Referent
-> Type Symbol Ann
-> Referent
-> Type Symbol Ann
-> TermSlurp Symbol Ann
forall v a.
Referent -> Type v a -> Referent -> Type v a -> TermSlurp v a
TermSlurp'Update Referent
oldRef Type Symbol Ann
oldType 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 Symbol Ann)
-> Transaction (Maybe (TermSlurp Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermSlurp Symbol Ann -> Maybe (TermSlurp Symbol Ann)
forall a. a -> Maybe a
Just (Referent
-> Type Symbol Ann
-> Referent
-> Type Symbol Ann
-> TermSlurp Symbol Ann
forall v a.
Referent -> Type v a -> Referent -> Type v a -> TermSlurp v a
TermSlurp'Update Referent
oldRef Type Symbol Ann
oldType Referent
newRef Type Symbol Ann
newType))
              (Referent.Con ConstructorReference
_ ConstructorType
_, Referent.Con ConstructorReference
_ ConstructorType
_) ->
                Maybe (TermSlurp Symbol Ann)
-> Transaction (Maybe (TermSlurp Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TermSlurp Symbol Ann)
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 -> 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

slurpTypes ::
  Codebase m Symbol Ann ->
  TypecheckedUnisonFile Symbol Ann ->
  Bool ->
  Map Name (Set TypeReference) ->
  Map Name (Set TypeReference) ->
  Sqlite.Transaction (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
slurpTypes :: forall (m :: * -> *).
Codebase m Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
-> Bool
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
slurpTypes Codebase m Symbol Ann
codebase TypecheckedUnisonFile Symbol Ann
unisonFile Bool
isUpdate =
  WhenMissing
  Transaction
  Name
  (Set TypeReference)
  (SlurpEntry (DeclOrBuiltin Symbol Ann))
-> WhenMissing
     Transaction
     Name
     (Set TypeReference)
     (SlurpEntry (DeclOrBuiltin Symbol Ann))
-> WhenMatched
     Transaction
     Name
     (Set TypeReference)
     (Set TypeReference)
     (SlurpEntry (DeclOrBuiltin Symbol Ann))
-> Map Name (Set TypeReference)
-> Map Name (Set TypeReference)
-> Transaction (Map Name (SlurpEntry (DeclOrBuiltin Symbol Ann)))
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 (SlurpEntry (DeclOrBuiltin Symbol Ann)))
-> WhenMissing
     Transaction
     Name
     (Set TypeReference)
     (SlurpEntry (DeclOrBuiltin Symbol Ann))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
Map.traverseMissing \Name
_ -> (DeclOrBuiltin Symbol Ann -> SlurpEntry (DeclOrBuiltin Symbol Ann))
-> Transaction (DeclOrBuiltin Symbol Ann)
-> Transaction (SlurpEntry (DeclOrBuiltin Symbol Ann))
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 -> SlurpEntry (DeclOrBuiltin Symbol Ann)
forall a. a -> SlurpEntry a
SlurpEntry'Delete (Transaction (DeclOrBuiltin Symbol Ann)
 -> Transaction (SlurpEntry (DeclOrBuiltin Symbol Ann)))
-> (Set TypeReference -> Transaction (DeclOrBuiltin Symbol Ann))
-> Set TypeReference
-> Transaction (SlurpEntry (DeclOrBuiltin Symbol Ann))
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)
  (SlurpEntry (DeclOrBuiltin Symbol Ann))
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing
    )
    ((Name
 -> Set TypeReference
 -> Transaction (SlurpEntry (DeclOrBuiltin Symbol Ann)))
-> WhenMissing
     Transaction
     Name
     (Set TypeReference)
     (SlurpEntry (DeclOrBuiltin Symbol Ann))
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> f y) -> WhenMissing f k x y
Map.traverseMissing \Name
name -> (DeclOrBuiltin Symbol Ann -> SlurpEntry (DeclOrBuiltin Symbol Ann))
-> Transaction (DeclOrBuiltin Symbol Ann)
-> Transaction (SlurpEntry (DeclOrBuiltin Symbol Ann))
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 -> SlurpEntry (DeclOrBuiltin Symbol Ann)
forall a. a -> SlurpEntry a
SlurpEntry'Add (Transaction (DeclOrBuiltin Symbol Ann)
 -> Transaction (SlurpEntry (DeclOrBuiltin Symbol Ann)))
-> (Set TypeReference -> Transaction (DeclOrBuiltin Symbol Ann))
-> Set TypeReference
-> Transaction (SlurpEntry (DeclOrBuiltin Symbol Ann))
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 (SlurpEntry (DeclOrBuiltin Symbol Ann))))
-> WhenMatched
     Transaction
     Name
     (Set TypeReference)
     (Set TypeReference)
     (SlurpEntry (DeclOrBuiltin Symbol Ann))
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 (SlurpEntry (DeclOrBuiltin Symbol Ann)
 -> Maybe (SlurpEntry (DeclOrBuiltin Symbol Ann)))
-> Transaction (SlurpEntry (DeclOrBuiltin Symbol Ann))
-> Transaction (Maybe (SlurpEntry (DeclOrBuiltin Symbol Ann)))
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SlurpEntry (DeclOrBuiltin Symbol Ann)
-> Maybe (SlurpEntry (DeclOrBuiltin Symbol Ann))
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
                SlurpEntry (DeclOrBuiltin Symbol Ann)
-> Transaction (SlurpEntry (DeclOrBuiltin Symbol Ann))
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DeclOrBuiltin Symbol Ann
-> DeclOrBuiltin Symbol Ann
-> SlurpEntry (DeclOrBuiltin Symbol Ann)
forall a. a -> a -> SlurpEntry a
SlurpEntry'Update DeclOrBuiltin Symbol Ann
oldDecl DeclOrBuiltin Symbol Ann
newDecl)
              else
                Maybe (SlurpEntry (DeclOrBuiltin Symbol Ann))
-> Transaction (Maybe (SlurpEntry (DeclOrBuiltin Symbol Ann)))
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 (SlurpEntry (DeclOrBuiltin Symbol Ann))
forall a. Maybe a
Nothing
                      Just (Id, Decl Symbol Ann)
_ -> SlurpEntry (DeclOrBuiltin Symbol Ann)
-> Maybe (SlurpEntry (DeclOrBuiltin Symbol Ann))
forall a. a -> Maybe a
Just SlurpEntry (DeclOrBuiltin Symbol Ann)
forall a. SlurpEntry a
SlurpEntry'Unchanged
                    else SlurpEntry (DeclOrBuiltin Symbol Ann)
-> Maybe (SlurpEntry (DeclOrBuiltin Symbol Ann))
forall a. a -> Maybe a
Just SlurpEntry (DeclOrBuiltin Symbol Ann)
forall a. SlurpEntry a
SlurpEntry'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 v a. Decl v a -> DeclOrBuiltin v a
DeclOrBuiltin.Decl (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 v a. ConstructorType -> DeclOrBuiltin v a
DeclOrBuiltin.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 v a. Decl v a -> DeclOrBuiltin v a
DeclOrBuiltin.Decl Decl Symbol Ann
decl)
          Maybe (Id, Decl Symbol Ann)
Nothing -> Decl Symbol Ann -> DeclOrBuiltin Symbol Ann
forall v a. Decl v a -> DeclOrBuiltin v a
DeclOrBuiltin.Decl (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 v a. ConstructorType -> DeclOrBuiltin v a
DeclOrBuiltin.Builtin (Text -> ConstructorType
Builtin.expectBuiltinConstructorType Text
builtin))

getTermAliases :: Relation Name Referent -> Map Name (TermSlurp Symbol Ann) -> Map Referent (NESet Name)
getTermAliases :: Relation Name Referent
-> Map Name (TermSlurp Symbol Ann) -> Map Referent (NESet Name)
getTermAliases Relation Name Referent
existingTerms Map Name (TermSlurp Symbol Ann)
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 Symbol Ann -> (Set Name, Set Referent))
-> (Set Name, Set Referent)
-> Map Name (TermSlurp Symbol Ann)
-> (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 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 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 Referent
old Type Symbol Ann
_ 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 Symbol Ann
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 Symbol Ann)
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
        Runtime.Error
        ( [(Symbol, Term Symbol ())],
          Map Symbol (Ann, WK.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 Symbol
theRuntime = case EvalMode
mode of
        EvalMode
Sandboxed -> Env
env.sandboxedRuntime
        EvalMode
Permissive -> Env
env.runtime

  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 Symbol Ann) -> Cli (WatchResults Symbol Ann)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CodeLookup Symbol IO Ann
-> PrettyPrintEnv
-> (Id -> IO (Maybe (Term Symbol ())))
-> Runtime Symbol
-> TypecheckedUnisonFile Symbol Ann
-> IO (WatchResults Symbol Ann)
forall v a.
Var v =>
CodeLookup v IO a
-> PrettyPrintEnv
-> (Id -> IO (Maybe (Term v)))
-> Runtime v
-> TypecheckedUnisonFile v a
-> IO (WatchResults v a)
Runtime.evaluateWatches CodeLookup Symbol IO Ann
codeLookup PrettyPrintEnv
ppe Id -> IO (Maybe (Term Symbol ()))
watchCache Runtime Symbol
theRuntime TypecheckedUnisonFile Symbol Ann
unisonFile) Cli (WatchResults Symbol Ann)
-> (WatchResults 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, [Error]
errs, Map
  Symbol (Ann, FilePath, Id, Term Symbol (), Term Symbol (), Bool)
map) -> do
        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
$ [Error] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Error]
errs) ([Error] -> Cli ()
RuntimeUtils.displayDecompileErrors [Error]
errs)
        [(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
&& [Error] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Error]
errs) 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)