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
  (Term Symbol Ann
trm, Type Symbol Ann
typ, TypecheckedUnisonFile Symbol Ann
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
  Maybe
  (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
   Type Symbol Ann)
-> ((Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
     Type Symbol Ann)
    -> Cli ())
-> Cli ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Symbol
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
-> Maybe
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
resultSymbol (TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol
     (Ann, TermReferenceId, Maybe FilePath, Term Symbol Ann,
      Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, TermReferenceId, Maybe FilePath, Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile Symbol Ann
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 :: TypecheckedUnisonFile Symbol Ann
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 =>
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 IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Names
currentNames <- Cli Names
Cli.currentNames
  let sr :: SlurpResult
sr = TypecheckedUnisonFile Symbol Ann -> Symbol -> Names -> SlurpResult
Slurp.slurpFile TypecheckedUnisonFile Symbol Ann
uf Symbol
resultVar Names
currentNames
  let adds :: SlurpComponent
adds = SlurpResult -> SlurpComponent
SlurpResult.adds SlurpResult
sr
  Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction () -> Cli ())
-> (TypecheckedUnisonFile Symbol Ann -> Transaction ())
-> TypecheckedUnisonFile Symbol Ann
-> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> TypecheckedUnisonFile Symbol Ann -> Transaction ()
forall (m :: * -> *) v a.
(Var v, Show a) =>
Codebase m v a -> TypecheckedUnisonFile v a -> Transaction ()
Codebase.addDefsToCodebase Codebase IO Symbol Ann
codebase (TypecheckedUnisonFile Symbol Ann -> Transaction ())
-> (TypecheckedUnisonFile Symbol Ann
    -> TypecheckedUnisonFile Symbol Ann)
-> TypecheckedUnisonFile Symbol Ann
-> Transaction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlurpResult
-> TypecheckedUnisonFile Symbol Ann
-> TypecheckedUnisonFile Symbol Ann
SlurpResult.filterUnisonFile SlurpResult
sr (TypecheckedUnisonFile Symbol Ann -> Cli ())
-> TypecheckedUnisonFile Symbol Ann -> Cli ()
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
uf
  let description :: Text
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)
  ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
  Text -> (ProjectPath, Branch0 IO -> Branch0 IO) -> Cli ()
Cli.stepAt Text
description (ProjectPath
pp, SlurpComponent
-> TypecheckedUnisonFile Symbol Ann -> Branch0 IO -> Branch0 IO
forall (m :: * -> *).
Monad m =>
SlurpComponent
-> TypecheckedUnisonFile Symbol Ann -> Branch0 m -> Branch0 m
doSlurpAdds SlurpComponent
adds TypecheckedUnisonFile Symbol Ann
uf)
  let namesWithDefinitionsFromFile :: Names
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 :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
namesWithDefinitionsFromFile) (Names -> Suffixifier
PPE.suffixifyByHash Names
namesWithDefinitionsFromFile)
  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Input -> PrettyPrintEnv -> SlurpResult -> Output
SlurpOutput Input
input PrettyPrintEnvDecl
pped.suffixifiedPPE SlurpResult
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