module Unison.Codebase.Editor.HandleInput.AddRun
  ( handleAddRun,
  )
where

import Control.Lens (use)
import Control.Monad.Reader (ask)
import Data.Map.Strict qualified as Map
import Data.Text qualified as Text
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.NamesUtils qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.Input (Input)
import Unison.Codebase.Editor.Output (Output (NoLastRunResult, SaveTermNameConflict, SlurpOutput))
import Unison.Codebase.Editor.Slurp qualified as Slurp
import Unison.Codebase.Editor.SlurpComponent (SlurpComponent (..))
import Unison.Codebase.Editor.SlurpComponent qualified as SC
import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path qualified as Path
import Unison.CommandLine.InputPattern qualified as InputPattern
import Unison.CommandLine.InputPatterns qualified as InputPatterns
import Unison.Name (Name)
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann (..))
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.Symbol (Symbol)
import Unison.Syntax.Name qualified as Name
import Unison.UnisonFile (TypecheckedUnisonFile)
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.Var qualified as Var

handleAddRun :: Input -> Name -> Cli ()
handleAddRun :: Input -> Name -> Cli ()
handleAddRun Input
input Name
resultName = do
  let resultVar :: Symbol
resultVar = Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
resultName
  let resultSymbol :: Symbol
resultSymbol = Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Name
resultName
  (trm, typ, uf0) <-
    Getting
  (Maybe
     (Term Symbol Ann, Type Symbol Ann,
      TypecheckedUnisonFile Symbol Ann))
  LoopState
  (Maybe
     (Term Symbol Ann, Type Symbol Ann,
      TypecheckedUnisonFile Symbol Ann))
-> Cli
     (Maybe
        (Term Symbol Ann, Type Symbol Ann,
         TypecheckedUnisonFile Symbol Ann))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe
     (Term Symbol Ann, Type Symbol Ann,
      TypecheckedUnisonFile Symbol Ann))
  LoopState
  (Maybe
     (Term Symbol Ann, Type Symbol Ann,
      TypecheckedUnisonFile Symbol Ann))
#lastRunResult Cli
  (Maybe
     (Term Symbol Ann, Type Symbol Ann,
      TypecheckedUnisonFile Symbol Ann))
-> (Cli
      (Maybe
         (Term Symbol Ann, Type Symbol Ann,
          TypecheckedUnisonFile Symbol Ann))
    -> Cli
         (Term Symbol Ann, Type Symbol Ann,
          TypecheckedUnisonFile Symbol Ann))
-> Cli
     (Term Symbol Ann, Type Symbol Ann,
      TypecheckedUnisonFile Symbol Ann)
forall a b. a -> (a -> b) -> b
& Cli
  (Term Symbol Ann, Type Symbol Ann,
   TypecheckedUnisonFile Symbol Ann)
-> Cli
     (Maybe
        (Term Symbol Ann, Type Symbol Ann,
         TypecheckedUnisonFile Symbol Ann))
-> Cli
     (Term Symbol Ann, Type Symbol Ann,
      TypecheckedUnisonFile Symbol Ann)
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
      Output
-> Cli
     (Term Symbol Ann, Type Symbol Ann,
      TypecheckedUnisonFile Symbol Ann)
forall a. Output -> Cli a
Cli.returnEarly Output
NoLastRunResult
  whenJust (Map.lookup resultSymbol (UF.hashTermsId uf0)) \(Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
 Type Symbol Ann)
_ -> do
    Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Name -> Output
SaveTermNameConflict Name
resultName)
  let uf =
        Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [(FilePath, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> TypecheckedUnisonFile Symbol Ann
forall v a.
(Var v, HasCallStack) =>
Map v (TermReferenceId, DataDeclaration v a)
-> Map v (TermReferenceId, EffectDeclaration v a)
-> [[(v, a, Term v a, Type v a)]]
-> [(FilePath, [(v, a, Term v a, Type v a)])]
-> TypecheckedUnisonFile v a
UF.typecheckedUnisonFile
          (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol Ann
uf0)
          (TypecheckedUnisonFile Symbol Ann
-> Map Symbol (TermReferenceId, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (TermReferenceId, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile Symbol Ann
uf0)
          ([(Symbol
resultSymbol, Ann
External, Term Symbol Ann
trm, Type Symbol Ann
typ)] [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall a. a -> [a] -> [a]
: TypecheckedUnisonFile Symbol Ann
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
forall v a.
TypecheckedUnisonFile v a -> [[(v, a, Term v a, Type v a)]]
UF.topLevelComponents' TypecheckedUnisonFile Symbol Ann
uf0)
          (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
uf0)
  Cli.Env {codebase} <- ask
  currentNames <- Cli.currentNames
  let sr = TypecheckedUnisonFile Symbol Ann -> Symbol -> Names -> SlurpResult
Slurp.slurpFile TypecheckedUnisonFile Symbol Ann
uf Symbol
resultVar Names
currentNames
  let adds = SlurpResult -> SlurpComponent
SlurpResult.adds SlurpResult
sr
  Cli.runTransaction . Codebase.addDefsToCodebase codebase . SlurpResult.filterUnisonFile sr $ uf
  let description = (FilePath -> Text
Text.pack (InputPattern -> FilePath
InputPattern.patternName InputPattern
InputPatterns.saveExecuteResult) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
resultName)
  pp <- Cli.getCurrentProjectPath
  Cli.stepAt description (pp, doSlurpAdds adds uf)
  let namesWithDefinitionsFromFile = TypecheckedUnisonFile Symbol Ann -> Names -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names -> Names
UF.addNamesFromTypeCheckedUnisonFile TypecheckedUnisonFile Symbol Ann
uf Names
currentNames
  let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
namesWithDefinitionsFromFile) (Names -> Suffixifier
PPE.suffixifyByHash Names
namesWithDefinitionsFromFile)
  Cli.respond $ SlurpOutput input pped.suffixifiedPPE sr

doSlurpAdds ::
  forall m.
  (Monad m) =>
  SlurpComponent ->
  TypecheckedUnisonFile Symbol Ann ->
  (Branch0 m -> Branch0 m)
doSlurpAdds :: forall (m :: * -> *).
Monad m =>
SlurpComponent
-> TypecheckedUnisonFile Symbol Ann -> Branch0 m -> Branch0 m
doSlurpAdds SlurpComponent
slurp TypecheckedUnisonFile Symbol Ann
uf = [(Path, Branch0 m -> Branch0 m)] -> Branch0 m -> Branch0 m
forall (f :: * -> *) (m :: * -> *).
(Monad m, Foldable f) =>
f (Path, Branch0 m -> Branch0 m) -> Branch0 m -> Branch0 m
Branch.batchUpdates ([(Path, Branch0 m -> Branch0 m)]
typeActions [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
-> [(Path, Branch0 m -> Branch0 m)]
forall a. Semigroup a => a -> a -> a
<> [(Path, Branch0 m -> Branch0 m)]
termActions)
  where
    typeActions :: [(Path, Branch0 m -> Branch0 m)]
typeActions = (Symbol -> (Path, Branch0 m -> Branch0 m))
-> [Symbol] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> (Path, Branch0 m -> Branch0 m)
doType ([Symbol] -> [(Path, Branch0 m -> Branch0 m)])
-> (Set Symbol -> [Symbol])
-> Set Symbol
-> [(Path, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Symbol -> [(Path, Branch0 m -> Branch0 m)])
-> Set Symbol -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$ SlurpComponent -> Set Symbol
SC.types SlurpComponent
slurp
    termActions :: [(Path, Branch0 m -> Branch0 m)]
termActions =
      (Symbol -> (Path, Branch0 m -> Branch0 m))
-> [Symbol] -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> (Path, Branch0 m -> Branch0 m)
doTerm ([Symbol] -> [(Path, Branch0 m -> Branch0 m)])
-> (Set Symbol -> [Symbol])
-> Set Symbol
-> [(Path, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Symbol -> [Symbol]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Symbol -> [(Path, Branch0 m -> Branch0 m)])
-> Set Symbol -> [(Path, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$
        SlurpComponent -> Set Symbol
SC.terms SlurpComponent
slurp Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol -> TypecheckedUnisonFile Symbol Ann -> Set Symbol
forall v a. Ord v => Set v -> TypecheckedUnisonFile v a -> Set v
UF.constructorsForDecls (SlurpComponent -> Set Symbol
SC.types SlurpComponent
slurp) TypecheckedUnisonFile Symbol Ann
uf
    names :: Names
names = TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames TypecheckedUnisonFile Symbol Ann
uf
    doTerm :: Symbol -> (Path, Branch0 m -> Branch0 m)
    doTerm :: Symbol -> (Path, Branch0 m -> Branch0 m)
doTerm Symbol
v = case Set Referent -> [Referent]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Names -> Name -> Set Referent
Names.termsNamed Names
names (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)) of
      [] -> Symbol -> (Path, Branch0 m -> Branch0 m)
errorMissingVar Symbol
v
      [Referent
r] ->
        let split :: Split Path
split = Name -> Split Path
Path.splitFromName (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)
         in Split Path -> Referent -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName Split Path
split Referent
r
      [Referent]
wha ->
        FilePath -> (Path, Branch0 m -> Branch0 m)
forall a. HasCallStack => FilePath -> a
error (FilePath -> (Path, Branch0 m -> Branch0 m))
-> FilePath -> (Path, Branch0 m -> Branch0 m)
forall a b. (a -> b) -> a -> b
$
          FilePath
"Unison bug, typechecked file w/ multiple terms named "
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Symbol -> FilePath
forall v. Var v => v -> FilePath
Var.nameStr Symbol
v
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
": "
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [Referent] -> FilePath
forall a. Show a => a -> FilePath
show [Referent]
wha
    doType :: Symbol -> (Path, Branch0 m -> Branch0 m)
    doType :: Symbol -> (Path, Branch0 m -> Branch0 m)
doType Symbol
v = case Set TypeReference -> [TypeReference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Names -> Name -> Set TypeReference
Names.typesNamed Names
names (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)) of
      [] -> Symbol -> (Path, Branch0 m -> Branch0 m)
errorMissingVar Symbol
v
      [TypeReference
r] ->
        let split :: Split Path
split = Name -> Split Path
Path.splitFromName (Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v)
         in Split Path -> TypeReference -> (Path, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> TypeReference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTypeName Split Path
split TypeReference
r
      [TypeReference]
wha ->
        FilePath -> (Path, Branch0 m -> Branch0 m)
forall a. HasCallStack => FilePath -> a
error (FilePath -> (Path, Branch0 m -> Branch0 m))
-> FilePath -> (Path, Branch0 m -> Branch0 m)
forall a b. (a -> b) -> a -> b
$
          FilePath
"Unison bug, typechecked file w/ multiple types named "
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Symbol -> FilePath
forall v. Var v => v -> FilePath
Var.nameStr Symbol
v
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
": "
            FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [TypeReference] -> FilePath
forall a. Show a => a -> FilePath
show [TypeReference]
wha
    errorMissingVar :: Symbol -> (Path, Branch0 m -> Branch0 m)
errorMissingVar Symbol
v = FilePath -> (Path, Branch0 m -> Branch0 m)
forall a. HasCallStack => FilePath -> a
error (FilePath -> (Path, Branch0 m -> Branch0 m))
-> FilePath -> (Path, Branch0 m -> Branch0 m)
forall a b. (a -> b) -> a -> b
$ FilePath
"expected to find " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Symbol -> FilePath
forall a. Show a => a -> FilePath
show Symbol
v FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TypecheckedUnisonFile Symbol Ann -> FilePath
forall a. Show a => a -> FilePath
show TypecheckedUnisonFile Symbol Ann
uf