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.Set qualified as Set
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.Editor.HandleInput.Update (doSlurpAdds)
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.SlurpResult qualified as SlurpResult
import Unison.CommandLine.InputPattern qualified as InputPattern
import Unison.CommandLine.InputPatterns qualified as InputPatterns
import Unison.Name (Name)
import Unison.Parser.Ann (Ann (External))
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl qualified as PPE
import Unison.PrettyPrintEnvDecl.Names 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

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
  TypecheckedUnisonFile Symbol Ann
uf <- Name -> Cli (TypecheckedUnisonFile Symbol Ann)
addSavedTermToUnisonFile Name
resultName
  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
-> Set Symbol -> SlurpOp -> Names -> SlurpResult
Slurp.slurpFile TypecheckedUnisonFile Symbol Ann
uf (Symbol -> Set Symbol
forall a. a -> Set a
Set.singleton Symbol
resultVar) SlurpOp
Slurp.AddOp 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)
  let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped
  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Input -> PrettyPrintEnv -> SlurpResult -> Output
SlurpOutput Input
input PrettyPrintEnv
suffixifiedPPE SlurpResult
sr

addSavedTermToUnisonFile :: Name -> Cli (TypecheckedUnisonFile Symbol Ann)
addSavedTermToUnisonFile :: Name -> Cli (TypecheckedUnisonFile Symbol Ann)
addSavedTermToUnisonFile Name
resultName = do
  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
uf) <-
    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
uf)) \(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)
  pure $
    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
uf)
      (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
uf)
      ([(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
uf)
      (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
uf)