{-# HLINT ignore "Use tuple-section" #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

module Unison.Codebase.Editor.HandleInput (loop) where

-- TODO: Don't import backend

import Control.Arrow ((&&&))
import Control.Error.Util qualified as ErrorUtil
import Control.Lens hiding (from)
import Control.Monad.Reader (ask)
import Control.Monad.State (StateT)
import Control.Monad.State qualified as State
import Data.Foldable qualified as Foldable
import Data.List qualified as List
import Data.List.Extra (nubOrd)
import Data.List.NonEmpty qualified as Nel
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Set.NonEmpty qualified as NESet
import Data.Text qualified as Text
import Data.Time (UTCTime)
import Data.Tuple.Extra (uncurry3)
import Text.Megaparsec qualified as Megaparsec
import U.Codebase.Branch.Diff qualified as V2Branch.Diff
import U.Codebase.Causal qualified as V2Causal
import U.Codebase.HashTags (CausalHash (..))
import U.Codebase.Reflog qualified as Reflog
import Unison.ABT qualified as ABT
import Unison.Builtin qualified as Builtin
import Unison.Builtin.Terms qualified as Builtin
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils (getCurrentProjectBranch)
import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.NameResolutionUtils (resolveHQToLabeledDependencies)
import Unison.Cli.NamesUtils qualified as Cli
import Unison.Cli.ProjectUtils qualified as ProjectUtils
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch (..), Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Merge qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Causal qualified as Causal
import Unison.Codebase.Editor.AuthorInfo (AuthorInfo (..))
import Unison.Codebase.Editor.AuthorInfo qualified as AuthorInfo
import Unison.Codebase.Editor.HandleInput.AddRun (handleAddRun)
import Unison.Codebase.Editor.HandleInput.AuthLogin (authLogin)
import Unison.Codebase.Editor.HandleInput.Branch (handleBranch)
import Unison.Codebase.Editor.HandleInput.BranchRename (handleBranchRename)
import Unison.Codebase.Editor.HandleInput.Branches (handleBranches)
import Unison.Codebase.Editor.HandleInput.CommitMerge (handleCommitMerge)
import Unison.Codebase.Editor.HandleInput.CommitUpgrade (handleCommitUpgrade)
import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition
import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges
import Unison.Codebase.Editor.HandleInput.DebugSynhashTerm (handleDebugSynhashTerm)
import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch)
import Unison.Codebase.Editor.HandleInput.DeleteNamespace (getEndangeredDependents, handleDeleteNamespace)
import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject)
import Unison.Codebase.Editor.HandleInput.Dependents (handleDependents)
import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
import Unison.Codebase.Editor.HandleInput.EditDependents (handleEditDependents)
import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI, handleTextFindI)
import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format
import Unison.Codebase.Editor.HandleInput.Global qualified as Global
import Unison.Codebase.Editor.HandleInput.InstallLib (handleInstallLib)
import Unison.Codebase.Editor.HandleInput.LSPDebug qualified as LSPDebug
import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), evalUnisonFile, handleLoad, loadUnisonFile)
import Unison.Codebase.Editor.HandleInput.Ls (handleLs)
import Unison.Codebase.Editor.HandleInput.Merge2 (handleMerge)
import Unison.Codebase.Editor.HandleInput.MoveAll (handleMoveAll)
import Unison.Codebase.Editor.HandleInput.MoveBranch (doMoveBranch)
import Unison.Codebase.Editor.HandleInput.MoveTerm (doMoveTerm)
import Unison.Codebase.Editor.HandleInput.MoveType (doMoveType)
import Unison.Codebase.Editor.HandleInput.NamespaceDependencies (handleNamespaceDependencies)
import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper)
import Unison.Codebase.Editor.HandleInput.ProjectClone (handleClone)
import Unison.Codebase.Editor.HandleInput.ProjectCreate (projectCreate)
import Unison.Codebase.Editor.HandleInput.ProjectRename (handleProjectRename)
import Unison.Codebase.Editor.HandleInput.ProjectSwitch (projectSwitch)
import Unison.Codebase.Editor.HandleInput.Projects (handleProjects)
import Unison.Codebase.Editor.HandleInput.Pull (handlePull, mergeBranchAndPropagateDefaultPatch)
import Unison.Codebase.Editor.HandleInput.Push (handlePushRemoteBranch)
import Unison.Codebase.Editor.HandleInput.Reflogs qualified as Reflogs
import Unison.Codebase.Editor.HandleInput.ReleaseDraft (handleReleaseDraft)
import Unison.Codebase.Editor.HandleInput.Run (handleRun)
import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils
import Unison.Codebase.Editor.HandleInput.ShowDefinition (handleShowDefinition)
import Unison.Codebase.Editor.HandleInput.TermResolution (resolveMainRef)
import Unison.Codebase.Editor.HandleInput.Tests qualified as Tests
import Unison.Codebase.Editor.HandleInput.Todo (handleTodo)
import Unison.Codebase.Editor.HandleInput.UI (openUI)
import Unison.Codebase.Editor.HandleInput.Update (doSlurpAdds, handleUpdate)
import Unison.Codebase.Editor.HandleInput.Update2 (handleUpdate2)
import Unison.Codebase.Editor.HandleInput.Upgrade (handleUpgrade)
import Unison.Codebase.Editor.Input
import Unison.Codebase.Editor.Output
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Editor.Output.DumpNamespace qualified as Output.DN
import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
import Unison.Codebase.Editor.Slurp qualified as Slurp
import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult
import Unison.Codebase.Editor.StructuredArgument qualified as SA
import Unison.Codebase.Execute qualified as Codebase
import Unison.Codebase.IntegrityCheck qualified as IntegrityCheck (integrityCheckFullCodebase)
import Unison.Codebase.Metadata qualified as Metadata
import Unison.Codebase.Path (Path, Path' (..))
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.Runtime qualified as Runtime
import Unison.Codebase.ShortCausalHash qualified as SCH
import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..))
import Unison.CommandLine.Completion qualified as Completion
import Unison.CommandLine.DisplayValues qualified as DisplayValues
import Unison.CommandLine.InputPattern qualified as IP
import Unison.CommandLine.InputPatterns qualified as IP
import Unison.CommandLine.InputPatterns qualified as InputPatterns
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.DataDeclaration qualified as DD
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.LabeledDependency (LabeledDependency)
import Unison.LabeledDependency qualified as LD
import Unison.LabeledDependency qualified as LabeledDependency
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Names (Names (Names))
import Unison.Names qualified as Names
import Unison.NamesWithHistory 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 hiding (biasTo, empty)
import Unison.PrettyPrintEnvDecl qualified as PPED
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Reference (Reference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Runtime.IOSource qualified as IOSource
import Unison.Server.Backend qualified as Backend
import Unison.Server.CodebaseServer qualified as Server
import Unison.Server.Doc.Markdown.Render qualified as Md
import Unison.Server.Doc.Markdown.Types qualified as Md
import Unison.Server.NameSearch.FromNames qualified as NameSearch
import Unison.Server.SearchResult (SearchResult)
import Unison.Server.SearchResult qualified as SR
import Unison.Share.Codeserver qualified as Codeserver
import Unison.ShortHash qualified as SH
import Unison.Symbol (Symbol)
import Unison.Syntax.HashQualified qualified as HQ (parseTextWith, toText)
import Unison.Syntax.Lexer.Unison qualified as L
import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar)
import Unison.Syntax.NameSegment qualified as NameSegment
import Unison.Syntax.Parser qualified as Parser
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Type.Names qualified as Type
import Unison.UnisonFile (TypecheckedUnisonFile)
import Unison.UnisonFile qualified as UF
import Unison.UnisonFile.Names qualified as UF
import Unison.Util.Find qualified as Find
import Unison.Util.List (nubOrdOn, uniqueBy)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Pretty qualified as P
import Unison.Util.Pretty qualified as Pretty
import Unison.Util.Relation qualified as R
import Unison.Util.Relation qualified as Relation
import Unison.Util.Set qualified as Set
import Unison.Util.Star2 qualified as Star2
import Unison.Var (Var)
import Unison.Var qualified as Var
import Unison.WatchKind qualified as WK
import UnliftIO.Directory qualified as Directory

------------------------------------------------------------------------------------------------------------------------
-- Main loop

loop :: Either Event Input -> Cli ()
loop :: Either Event Input -> Cli ()
loop Either Event Input
e = do
  case Either Event Input
e of
    Left (UnisonFileChanged Text
sourceName Text
text) -> String -> Cli () -> Cli ()
forall a. String -> Cli a -> Cli a
Cli.time String
"UnisonFileChanged" do
      -- We skip this update if it was programmatically generated
      Cli (Maybe (String, Bool))
Cli.getLatestFile Cli (Maybe (String, Bool))
-> (Maybe (String, 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
        Just (String
_, Bool
True) -> ((Maybe (String, Bool) -> Identity (Maybe (String, Bool)))
-> LoopState -> Identity LoopState
#latestFile ((Maybe (String, Bool) -> Identity (Maybe (String, Bool)))
 -> LoopState -> Identity LoopState)
-> ((Bool -> Identity Bool)
    -> Maybe (String, Bool) -> Identity (Maybe (String, Bool)))
-> (Bool -> Identity Bool)
-> LoopState
-> Identity LoopState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Bool) -> Identity (String, Bool))
-> Maybe (String, Bool) -> Identity (Maybe (String, Bool))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((String, Bool) -> Identity (String, Bool))
 -> Maybe (String, Bool) -> Identity (Maybe (String, Bool)))
-> ((Bool -> Identity Bool)
    -> (String, Bool) -> Identity (String, Bool))
-> (Bool -> Identity Bool)
-> Maybe (String, Bool)
-> Identity (Maybe (String, Bool))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool)
-> (String, Bool) -> Identity (String, Bool)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (String, Bool) (String, Bool) Bool Bool
_2) ((Bool -> Identity Bool) -> LoopState -> Identity LoopState)
-> Bool -> Cli ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
        Maybe (String, Bool)
_ -> Text -> Text -> Cli ()
loadUnisonFile Text
sourceName Text
text
    Right Input
input ->
      let previewResponse :: String -> SlurpResult -> TypecheckedUnisonFile Symbol Ann -> Cli ()
previewResponse String
sourceName SlurpResult
sr TypecheckedUnisonFile Symbol Ann
uf = do
            Names
names <- Cli Names
Cli.currentNames
            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
names
            let filePPED :: PrettyPrintEnvDecl
filePPED = 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
filePPED
            Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Text
-> PrettyPrintEnv
-> SlurpResult
-> TypecheckedUnisonFile Symbol Ann
-> Output
Typechecked (String -> Text
Text.pack String
sourceName) PrettyPrintEnv
suffixifiedPPE SlurpResult
sr TypecheckedUnisonFile Symbol Ann
uf
       in String -> Cli () -> Cli ()
forall a. String -> Cli a -> Cli a
Cli.time String
"InputPattern" case Input
input of
            Input
ApiI -> do
              ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
              Cli.Env {Maybe BaseUrl
serverBaseUrl :: Maybe BaseUrl
$sel:serverBaseUrl:Env :: Env -> Maybe BaseUrl
serverBaseUrl} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              Maybe BaseUrl -> (BaseUrl -> Cli ()) -> Cli ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe BaseUrl
serverBaseUrl \BaseUrl
baseUrl ->
                Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$
                  Error -> Output
PrintMessage (Error -> Output) -> Error -> Output
forall a b. (a -> b) -> a -> b
$
                    [Error] -> Error
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
                      [ Error
"The API information is as follows:",
                        Error
forall s. IsString s => Pretty s
P.newline,
                        Width -> Error -> Error
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Error -> Error
P.hiBlue (Error
"UI: " Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> Text -> Error
forall s. IsString s => Text -> Pretty s
Pretty.text (Service -> BaseUrl -> Text
Server.urlFor (ProjectAndBranch ProjectName ProjectBranchName
-> Absolute -> Maybe DefinitionReference -> Service
Server.ProjectBranchUI (ProjectPathG ProjectName ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall p b. ProjectPathG p b -> ProjectAndBranch p b
PP.toProjectAndBranch (ProjectPathG ProjectName ProjectBranchName
 -> ProjectAndBranch ProjectName ProjectBranchName)
-> (ProjectPath -> ProjectPathG ProjectName ProjectBranchName)
-> ProjectPath
-> ProjectAndBranch ProjectName ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPath -> ProjectPathG ProjectName ProjectBranchName
PP.toNames (ProjectPath -> ProjectAndBranch ProjectName ProjectBranchName)
-> ProjectPath -> ProjectAndBranch ProjectName ProjectBranchName
forall a b. (a -> b) -> a -> b
$ ProjectPath
pp) Absolute
Path.absoluteEmpty Maybe DefinitionReference
forall a. Maybe a
Nothing) BaseUrl
baseUrl))),
                        Error
forall s. IsString s => Pretty s
P.newline,
                        Width -> Error -> Error
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Error -> Error
P.hiBlue (Error
"API: " Error -> Error -> Error
forall a. Semigroup a => a -> a -> a
<> Text -> Error
forall s. IsString s => Text -> Pretty s
Pretty.text (Service -> BaseUrl -> Text
Server.urlFor Service
Server.Api BaseUrl
baseUrl)))
                      ]
            CreateMessage Error
pretty ->
              Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Error -> Output
PrintMessage Error
pretty
            Input
ShowRootReflogI -> do
              let numEntriesToShow :: Int
numEntriesToShow = Int
500
              (Int
schLength, [Entry CausalHash Text]
entries) <-
                Transaction (Int, [Entry CausalHash Text])
-> Cli (Int, [Entry CausalHash Text])
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction (Int, [Entry CausalHash Text])
 -> Cli (Int, [Entry CausalHash Text]))
-> Transaction (Int, [Entry CausalHash Text])
-> Cli (Int, [Entry CausalHash Text])
forall a b. (a -> b) -> a -> b
$
                  (,) (Int -> [Entry CausalHash Text] -> (Int, [Entry CausalHash Text]))
-> Transaction Int
-> Transaction
     ([Entry CausalHash Text] -> (Int, [Entry CausalHash Text]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transaction Int
Codebase.branchHashLength Transaction
  ([Entry CausalHash Text] -> (Int, [Entry CausalHash Text]))
-> Transaction [Entry CausalHash Text]
-> Transaction (Int, [Entry CausalHash Text])
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Transaction [Entry CausalHash Text]
Codebase.getDeprecatedRootReflog Int
numEntriesToShow
              let moreEntriesToLoad :: Bool
moreEntriesToLoad = [Entry CausalHash Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entry CausalHash Text]
entries Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numEntriesToShow
              let expandedEntries :: [(Maybe UTCTime, CausalHash, Text)]
expandedEntries = (([Entry CausalHash Text], Maybe CausalHash, Bool)
 -> Maybe
      ((Maybe UTCTime, CausalHash, Text),
       ([Entry CausalHash Text], Maybe CausalHash, Bool)))
-> ([Entry CausalHash Text], Maybe CausalHash, Bool)
-> [(Maybe UTCTime, CausalHash, Text)]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr ([Entry CausalHash Text], Maybe CausalHash, Bool)
-> Maybe
     ((Maybe UTCTime, CausalHash, Text),
      ([Entry CausalHash Text], Maybe CausalHash, Bool))
expandEntries ([Entry CausalHash Text]
entries, Maybe CausalHash
forall a. Maybe a
Nothing, Bool
moreEntriesToLoad)
              let ([(Maybe UTCTime, ShortCausalHash, Text)]
shortEntries, [StructuredArgument]
numberedEntries) =
                    [((Maybe UTCTime, ShortCausalHash, Text), StructuredArgument)]
-> ([(Maybe UTCTime, ShortCausalHash, Text)], [StructuredArgument])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((Maybe UTCTime, ShortCausalHash, Text), StructuredArgument)]
 -> ([(Maybe UTCTime, ShortCausalHash, Text)],
     [StructuredArgument]))
-> [((Maybe UTCTime, ShortCausalHash, Text), StructuredArgument)]
-> ([(Maybe UTCTime, ShortCausalHash, Text)], [StructuredArgument])
forall a b. (a -> b) -> a -> b
$
                      [(Maybe UTCTime, CausalHash, Text)]
expandedEntries [(Maybe UTCTime, CausalHash, Text)]
-> ((Maybe UTCTime, CausalHash, Text)
    -> ((Maybe UTCTime, ShortCausalHash, Text), StructuredArgument))
-> [((Maybe UTCTime, ShortCausalHash, Text), StructuredArgument)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Maybe UTCTime
time, CausalHash
hash, Text
reason) ->
                        let (ShortCausalHash
exp, StructuredArgument
sa) = (Int -> CausalHash -> ShortCausalHash
SCH.fromHash Int
schLength (CausalHash -> ShortCausalHash)
-> (CausalHash -> StructuredArgument)
-> CausalHash
-> (ShortCausalHash, StructuredArgument)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CausalHash -> StructuredArgument
SA.Namespace) CausalHash
hash
                         in ((Maybe UTCTime
time, ShortCausalHash
exp, Text
reason), StructuredArgument
sa)
              [StructuredArgument] -> Cli ()
Cli.setNumberedArgs [StructuredArgument]
numberedEntries
              Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ [(Maybe UTCTime, ShortCausalHash, Text)] -> Output
ShowReflog [(Maybe UTCTime, ShortCausalHash, Text)]
shortEntries
              where
                expandEntries ::
                  ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) ->
                  Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool))
                expandEntries :: ([Entry CausalHash Text], Maybe CausalHash, Bool)
-> Maybe
     ((Maybe UTCTime, CausalHash, Text),
      ([Entry CausalHash Text], Maybe CausalHash, Bool))
expandEntries ([], Just CausalHash
expectedHash, Bool
moreEntriesToLoad) =
                  if Bool
moreEntriesToLoad
                    then Maybe
  ((Maybe UTCTime, CausalHash, Text),
   ([Entry CausalHash Text], Maybe CausalHash, Bool))
forall a. Maybe a
Nothing
                    else ((Maybe UTCTime, CausalHash, Text),
 ([Entry CausalHash Text], Maybe CausalHash, Bool))
-> Maybe
     ((Maybe UTCTime, CausalHash, Text),
      ([Entry CausalHash Text], Maybe CausalHash, Bool))
forall a. a -> Maybe a
Just ((Maybe UTCTime
forall a. Maybe a
Nothing, CausalHash
expectedHash, Text
"history starts here"), ([], Maybe CausalHash
forall a. Maybe a
Nothing, Bool
moreEntriesToLoad))
                expandEntries ([], Maybe CausalHash
Nothing, Bool
_moreEntriesToLoad) = Maybe
  ((Maybe UTCTime, CausalHash, Text),
   ([Entry CausalHash Text], Maybe CausalHash, Bool))
forall a. Maybe a
Nothing
                expandEntries (entries :: [Entry CausalHash Text]
entries@(Reflog.Entry {UTCTime
time :: UTCTime
$sel:time:Entry :: forall causal text. Entry causal text -> UTCTime
time, CausalHash
fromRootCausalHash :: CausalHash
$sel:fromRootCausalHash:Entry :: forall causal text. Entry causal text -> causal
fromRootCausalHash, CausalHash
toRootCausalHash :: CausalHash
$sel:toRootCausalHash:Entry :: forall causal text. Entry causal text -> causal
toRootCausalHash, Text
reason :: Text
$sel:reason:Entry :: forall causal text. Entry causal text -> text
reason} : [Entry CausalHash Text]
rest), Maybe CausalHash
mayExpectedHash, Bool
moreEntriesToLoad) =
                  ((Maybe UTCTime, CausalHash, Text),
 ([Entry CausalHash Text], Maybe CausalHash, Bool))
-> Maybe
     ((Maybe UTCTime, CausalHash, Text),
      ([Entry CausalHash Text], Maybe CausalHash, Bool))
forall a. a -> Maybe a
Just (((Maybe UTCTime, CausalHash, Text),
  ([Entry CausalHash Text], Maybe CausalHash, Bool))
 -> Maybe
      ((Maybe UTCTime, CausalHash, Text),
       ([Entry CausalHash Text], Maybe CausalHash, Bool)))
-> ((Maybe UTCTime, CausalHash, Text),
    ([Entry CausalHash Text], Maybe CausalHash, Bool))
-> Maybe
     ((Maybe UTCTime, CausalHash, Text),
      ([Entry CausalHash Text], Maybe CausalHash, Bool))
forall a b. (a -> b) -> a -> b
$
                    case Maybe CausalHash
mayExpectedHash of
                      Just CausalHash
expectedHash
                        | CausalHash
expectedHash CausalHash -> CausalHash -> Bool
forall a. Eq a => a -> a -> Bool
== CausalHash
toRootCausalHash -> ((UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
time, CausalHash
toRootCausalHash, Text
reason), ([Entry CausalHash Text]
rest, CausalHash -> Maybe CausalHash
forall a. a -> Maybe a
Just CausalHash
fromRootCausalHash, Bool
moreEntriesToLoad))
                        -- Historical discontinuity, insert a synthetic entry
                        | Bool
otherwise -> ((Maybe UTCTime
forall a. Maybe a
Nothing, CausalHash
toRootCausalHash, Text
"(external change)"), ([Entry CausalHash Text]
entries, Maybe CausalHash
forall a. Maybe a
Nothing, Bool
moreEntriesToLoad))
                      -- No expectation, either because this is the most recent entry or
                      -- because we're recovering from a discontinuity
                      Maybe CausalHash
Nothing -> ((UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
time, CausalHash
toRootCausalHash, Text
reason), ([Entry CausalHash Text]
rest, CausalHash -> Maybe CausalHash
forall a. a -> Maybe a
Just CausalHash
fromRootCausalHash, Bool
moreEntriesToLoad))
            ShowProjectBranchReflogI Maybe UnresolvedProjectBranch
mayProjBranch -> do
              Maybe UnresolvedProjectBranch -> Cli ()
Reflogs.showProjectBranchReflog Maybe UnresolvedProjectBranch
mayProjBranch
            Input
ShowGlobalReflogI -> do
              Cli ()
Reflogs.showGlobalReflog
            ShowProjectReflogI Maybe ProjectName
mayProj -> do
              Maybe ProjectName -> Cli ()
Reflogs.showProjectReflog Maybe ProjectName
mayProj
            ResetI BranchId2
newRoot Maybe UnresolvedProjectBranch
mtarget -> do
              Branch IO
newRoot <- BranchId2 -> Cli (Branch IO)
resolveBranchId2 BranchId2
newRoot
              ProjectPath
target <-
                case Maybe UnresolvedProjectBranch
mtarget of
                  Maybe UnresolvedProjectBranch
Nothing -> Cli ProjectPath
Cli.getCurrentProjectPath
                  Just UnresolvedProjectBranch
unresolvedProjectAndBranch -> do
                    ProjectAndBranch Project ProjectBranch
targetProjectAndBranch <- ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli (ProjectAndBranch Project ProjectBranch)
ProjectUtils.resolveProjectBranch ((ProjectBranchName -> Maybe ProjectBranchName)
-> UnresolvedProjectBranch
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
forall b c a.
(b -> c) -> ProjectAndBranch a b -> ProjectAndBranch a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ProjectBranchName -> Maybe ProjectBranchName
forall a. a -> Maybe a
Just UnresolvedProjectBranch
unresolvedProjectAndBranch)
                    pure $ ProjectAndBranch Project ProjectBranch -> ProjectPath
PP.projectBranchRoot ProjectAndBranch Project ProjectBranch
targetProjectAndBranch
              Text
description <- Input -> Cli Text
inputDescription Input
input
              Bool
_ <- Text -> ProjectPath -> (Branch IO -> Branch IO) -> Cli Bool
Cli.updateAt Text
description ProjectPath
target (Branch IO -> Branch IO -> Branch IO
forall a b. a -> b -> a
const Branch IO
newRoot)
              Output -> Cli ()
Cli.respond Output
Success
            ForkLocalBranchI BranchId2
src0 BranchRelativePath
dest0 -> do
              (Branch IO
srcb, WhichBranchEmpty
branchEmpty) <-
                case BranchId2
src0 of
                  Left ShortCausalHash
hash -> (,ShortCausalHash -> WhichBranchEmpty
WhichBranchEmptyHash ShortCausalHash
hash) (Branch IO -> (Branch IO, WhichBranchEmpty))
-> Cli (Branch IO) -> Cli (Branch IO, WhichBranchEmpty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShortCausalHash -> Cli (Branch IO)
Cli.resolveShortCausalHash ShortCausalHash
hash
                  Right BranchRelativePath
path' -> do
                    ProjectPath
srcPP <- BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
path'
                    Branch IO
srcb <- ProjectPath -> Cli (Branch IO)
Cli.getBranchFromProjectPath ProjectPath
srcPP
                    pure (Branch IO
srcb, ProjectPath -> WhichBranchEmpty
WhichBranchEmptyPath ProjectPath
srcPP)
              Text
description <- Input -> Cli Text
inputDescription Input
input
              ProjectPath
dest <- BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
dest0
              Bool
ok <- Text -> ProjectPath -> (Branch IO -> Cli (Branch IO)) -> Cli Bool
Cli.updateAtM Text
description ProjectPath
dest (Cli (Branch IO) -> Branch IO -> Cli (Branch IO)
forall a b. a -> b -> a
const (Cli (Branch IO) -> Branch IO -> Cli (Branch IO))
-> Cli (Branch IO) -> Branch IO -> Cli (Branch IO)
forall a b. (a -> b) -> a -> b
$ Branch IO -> Cli (Branch IO)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Branch IO
srcb)
              Output -> Cli ()
Cli.respond
                if Bool
ok
                  then Output
Success
                  else WhichBranchEmpty -> Output
BranchEmpty WhichBranchEmpty
branchEmpty
            MergeI UnresolvedProjectBranch
branch -> UnresolvedProjectBranch -> Cli ()
handleMerge UnresolvedProjectBranch
branch
            Input
MergeCommitI -> Cli ()
handleCommitMerge
            MergeLocalBranchI BranchRelativePath
unresolvedSrc Maybe BranchRelativePath
mayUnresolvedDest MergeMode
mergeMode -> do
              Text
description <- Input -> Cli Text
inputDescription Input
input
              ProjectPath
srcPP <- BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
unresolvedSrc
              (ProjectPath
destPP, BranchRelativePath
destBRP) <- case Maybe BranchRelativePath
mayUnresolvedDest of
                Maybe BranchRelativePath
Nothing -> Cli ProjectPath
Cli.getCurrentProjectPath Cli ProjectPath
-> (ProjectPath -> (ProjectPath, BranchRelativePath))
-> Cli (ProjectPath, BranchRelativePath)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ProjectPath
pp -> (ProjectPath
pp, ProjectName -> ProjectBranchName -> Absolute -> BranchRelativePath
QualifiedBranchPath (ProjectPath
pp ProjectPath
-> Getting ProjectName ProjectPath ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. (Project -> Const ProjectName Project)
-> ProjectPath -> Const ProjectName ProjectPath
#project ((Project -> Const ProjectName Project)
 -> ProjectPath -> Const ProjectName ProjectPath)
-> ((ProjectName -> Const ProjectName ProjectName)
    -> Project -> Const ProjectName Project)
-> Getting ProjectName ProjectPath ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectName -> Const ProjectName ProjectName)
-> Project -> Const ProjectName Project
#name) (ProjectPath
pp ProjectPath
-> Getting ProjectBranchName ProjectPath ProjectBranchName
-> ProjectBranchName
forall s a. s -> Getting a s a -> a
^. (ProjectBranch -> Const ProjectBranchName ProjectBranch)
-> ProjectPath -> Const ProjectBranchName ProjectPath
#branch ((ProjectBranch -> Const ProjectBranchName ProjectBranch)
 -> ProjectPath -> Const ProjectBranchName ProjectPath)
-> ((ProjectBranchName
     -> Const ProjectBranchName ProjectBranchName)
    -> ProjectBranch -> Const ProjectBranchName ProjectBranch)
-> Getting ProjectBranchName ProjectPath ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectBranchName -> Const ProjectBranchName ProjectBranchName)
-> ProjectBranch -> Const ProjectBranchName ProjectBranch
#name) (ProjectPath
pp ProjectPath -> Getting Absolute ProjectPath Absolute -> Absolute
forall s a. s -> Getting a s a -> a
^. Getting Absolute ProjectPath Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_))
                Just BranchRelativePath
unresolvedDest -> do
                  BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
unresolvedDest Cli ProjectPath
-> (ProjectPath -> (ProjectPath, BranchRelativePath))
-> Cli (ProjectPath, BranchRelativePath)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ProjectPath
pp -> (ProjectPath
pp, BranchRelativePath
unresolvedDest)
              Branch IO
srcBranch <- ProjectBranch -> Cli (Branch IO)
Cli.getProjectBranchRoot ProjectPath
srcPP.branch
              let err :: Maybe Output
err = Output -> Maybe Output
forall a. a -> Maybe a
Just (Output -> Maybe Output) -> Output -> Maybe Output
forall a b. (a -> b) -> a -> b
$ BranchRelativePath -> BranchRelativePath -> Output
MergeAlreadyUpToDate BranchRelativePath
unresolvedSrc BranchRelativePath
destBRP
              MergeMode
-> Text
-> Maybe Output
-> Branch IO
-> Maybe
     (Either ProjectPath (ProjectAndBranch Project ProjectBranch))
-> ProjectPath
-> Cli ()
mergeBranchAndPropagateDefaultPatch MergeMode
mergeMode Text
description Maybe Output
err Branch IO
srcBranch (Either ProjectPath (ProjectAndBranch Project ProjectBranch)
-> Maybe
     (Either ProjectPath (ProjectAndBranch Project ProjectBranch))
forall a. a -> Maybe a
Just (Either ProjectPath (ProjectAndBranch Project ProjectBranch)
 -> Maybe
      (Either ProjectPath (ProjectAndBranch Project ProjectBranch)))
-> Either ProjectPath (ProjectAndBranch Project ProjectBranch)
-> Maybe
     (Either ProjectPath (ProjectAndBranch Project ProjectBranch))
forall a b. (a -> b) -> a -> b
$ ProjectPath
-> Either ProjectPath (ProjectAndBranch Project ProjectBranch)
forall a b. a -> Either a b
Left ProjectPath
destPP) ProjectPath
destPP
            PreviewMergeLocalBranchI BranchRelativePath
unresolvedSrc Maybe BranchRelativePath
mayUnresolvedDest -> do
              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
              ProjectPath
srcPP <- BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
unresolvedSrc
              ProjectPath
destPP <- case Maybe BranchRelativePath
mayUnresolvedDest of
                Maybe BranchRelativePath
Nothing -> Cli ProjectPath
Cli.getCurrentProjectPath
                Just BranchRelativePath
unresolvedDest -> do
                  BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
unresolvedDest
              Branch IO
srcBranch <- ProjectBranch -> Cli (Branch IO)
Cli.getProjectBranchRoot ProjectPath
srcPP.branch
              Branch IO
destBranch <- ProjectBranch -> Cli (Branch IO)
Cli.getProjectBranchRoot ProjectPath
destPP.branch
              Branch IO
merged <- IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Branch IO -> Branch IO -> IO (Maybe (Branch IO)))
-> MergeMode -> Branch IO -> Branch IO -> IO (Branch IO)
forall (m :: * -> *).
Monad m =>
(Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch m -> Branch m -> m (Branch m)
Branch.merge'' (Codebase IO Symbol Ann
-> Branch IO -> Branch IO -> IO (Maybe (Branch IO))
forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> Branch m -> Branch m -> m (Maybe (Branch m))
Codebase.lca Codebase IO Symbol Ann
codebase) MergeMode
Branch.RegularMerge Branch IO
srcBranch Branch IO
destBranch)
              if Branch IO
merged Branch IO -> Branch IO -> Bool
forall a. Eq a => a -> a -> Bool
== Branch IO
destBranch
                then Output -> Cli ()
Cli.respond (ProjectPath -> ProjectPath -> Output
PreviewMergeAlreadyUpToDate ProjectPath
srcPP ProjectPath
destPP)
                else do
                  (PrettyPrintEnv
ppe, BranchDiffOutput Symbol Ann
diff) <- Branch0 IO
-> Branch0 IO -> Cli (PrettyPrintEnv, BranchDiffOutput Symbol Ann)
diffHelper (Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
destBranch) (Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
merged)
                  NumberedOutput -> Cli ()
Cli.respondNumbered (Either ProjectPath (ProjectAndBranch Project ProjectBranch)
-> ProjectPath
-> PrettyPrintEnv
-> BranchDiffOutput Symbol Ann
-> NumberedOutput
ShowDiffAfterMergePreview (ProjectPath
-> Either ProjectPath (ProjectAndBranch Project ProjectBranch)
forall a b. a -> Either a b
Left ProjectPath
destPP) ProjectPath
destPP PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diff)
            DiffNamespaceI BranchId2
before BranchId2
after -> do
              Either ShortCausalHash ProjectPath
beforeLoc <- (BranchRelativePath -> Cli ProjectPath)
-> BranchId2 -> Cli (Either ShortCausalHash ProjectPath)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either ShortCausalHash a -> f (Either ShortCausalHash b)
traverse BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchId2
before
              Branch0 IO
beforeBranch0 <- Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch IO -> Branch0 IO) -> Cli (Branch IO) -> Cli (Branch0 IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BranchId2 -> Cli (Branch IO)
resolveBranchId2 BranchId2
before
              Either ShortCausalHash ProjectPath
afterLoc <- (BranchRelativePath -> Cli ProjectPath)
-> BranchId2 -> Cli (Either ShortCausalHash ProjectPath)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either ShortCausalHash a -> f (Either ShortCausalHash b)
traverse BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchId2
after
              Branch0 IO
afterBranch0 <- Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch IO -> Branch0 IO) -> Cli (Branch IO) -> Cli (Branch0 IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BranchId2 -> Cli (Branch IO)
resolveBranchId2 BranchId2
after
              case (Branch0 IO -> Bool
forall (m :: * -> *). Branch0 m -> Bool
Branch.isEmpty0 Branch0 IO
beforeBranch0, Branch0 IO -> Bool
forall (m :: * -> *). Branch0 m -> Bool
Branch.isEmpty0 Branch0 IO
afterBranch0) of
                (Bool
True, Bool
True) -> Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli ())
-> (NonEmpty (Either ShortCausalHash ProjectPath) -> Output)
-> NonEmpty (Either ShortCausalHash ProjectPath)
-> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Either ShortCausalHash ProjectPath) -> Output
NamespaceEmpty (NonEmpty (Either ShortCausalHash ProjectPath) -> Cli ())
-> NonEmpty (Either ShortCausalHash ProjectPath) -> Cli ()
forall a b. (a -> b) -> a -> b
$ (Either ShortCausalHash ProjectPath
beforeLoc Either ShortCausalHash ProjectPath
-> [Either ShortCausalHash ProjectPath]
-> NonEmpty (Either ShortCausalHash ProjectPath)
forall a. a -> [a] -> NonEmpty a
Nel.:| [Either ShortCausalHash ProjectPath
afterLoc])
                (Bool
True, Bool
False) -> Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli ())
-> (NonEmpty (Either ShortCausalHash ProjectPath) -> Output)
-> NonEmpty (Either ShortCausalHash ProjectPath)
-> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Either ShortCausalHash ProjectPath) -> Output
NamespaceEmpty (NonEmpty (Either ShortCausalHash ProjectPath) -> Cli ())
-> NonEmpty (Either ShortCausalHash ProjectPath) -> Cli ()
forall a b. (a -> b) -> a -> b
$ (Either ShortCausalHash ProjectPath
beforeLoc Either ShortCausalHash ProjectPath
-> [Either ShortCausalHash ProjectPath]
-> NonEmpty (Either ShortCausalHash ProjectPath)
forall a. a -> [a] -> NonEmpty a
Nel.:| [])
                (Bool
False, Bool
True) -> Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli ())
-> (NonEmpty (Either ShortCausalHash ProjectPath) -> Output)
-> NonEmpty (Either ShortCausalHash ProjectPath)
-> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Either ShortCausalHash ProjectPath) -> Output
NamespaceEmpty (NonEmpty (Either ShortCausalHash ProjectPath) -> Cli ())
-> NonEmpty (Either ShortCausalHash ProjectPath) -> Cli ()
forall a b. (a -> b) -> a -> b
$ (Either ShortCausalHash ProjectPath
afterLoc Either ShortCausalHash ProjectPath
-> [Either ShortCausalHash ProjectPath]
-> NonEmpty (Either ShortCausalHash ProjectPath)
forall a. a -> [a] -> NonEmpty a
Nel.:| [])
                (Bool
False, Bool
False) -> () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              (PrettyPrintEnv
ppe, BranchDiffOutput Symbol Ann
diff) <- Branch0 IO
-> Branch0 IO -> Cli (PrettyPrintEnv, BranchDiffOutput Symbol Ann)
diffHelper Branch0 IO
beforeBranch0 Branch0 IO
afterBranch0
              NumberedOutput -> Cli ()
Cli.respondNumbered (Either ShortCausalHash ProjectPath
-> Either ShortCausalHash ProjectPath
-> PrettyPrintEnv
-> BranchDiffOutput Symbol Ann
-> NumberedOutput
ShowDiffNamespace Either ShortCausalHash ProjectPath
beforeLoc Either ShortCausalHash ProjectPath
afterLoc PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diff)
            MoveBranchI Path'
src' Path'
dest' -> do
              Bool
hasConfirmed <- Input -> Cli Bool
confirmedCommand Input
input
              Text
description <- Input -> Cli Text
inputDescription Input
input
              Text -> Bool -> Path' -> Path' -> Cli ()
doMoveBranch Text
description Bool
hasConfirmed Path'
src' Path'
dest'
            SwitchBranchI Path'
path' -> do
              ProjectPath
path <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
path'
              Bool
branchExists <- Path' -> Cli Bool
Cli.branchExistsAtPath' Path'
path'
              Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
branchExists) (Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Absolute -> Output
CreatedNewBranch (ProjectPath
path ProjectPath -> Getting Absolute ProjectPath Absolute -> Absolute
forall s a. s -> Getting a s a -> a
^. Getting Absolute ProjectPath Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_))
              Absolute -> Cli ()
Cli.cd (ProjectPath
path ProjectPath -> Getting Absolute ProjectPath Absolute -> Absolute
forall s a. s -> Getting a s a -> a
^. Getting Absolute ProjectPath Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_)
            Input
UpI -> do
              Absolute
path0 <- Cli Absolute
Cli.getCurrentPath
              Maybe (Absolute, NameSegment)
-> ((Absolute, NameSegment) -> Cli ()) -> Cli ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Absolute -> Maybe (Absolute, NameSegment)
forall s a. Snoc s s a a => s -> Maybe (s, a)
unsnoc Absolute
path0) \(Absolute
path, NameSegment
_) ->
                Absolute -> Cli ()
Cli.cd Absolute
path
            Input
PopBranchI -> do
              Bool
success <- Cli Bool
Cli.popd
              Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
success) (Output -> Cli ()
Cli.respond Output
StartOfCurrentPathHistory)
            HistoryI Maybe Int
resultsCap Maybe Int
diffCap BranchId
from -> do
              Branch IO
branch <-
                case BranchId
from of
                  BranchAtSCH ShortCausalHash
hash -> ShortCausalHash -> Cli (Branch IO)
Cli.resolveShortCausalHash ShortCausalHash
hash
                  BranchAtPath Path'
path' -> do
                    ProjectPath
pp <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
path'
                    ProjectPath -> Cli (Branch IO)
Cli.getBranchFromProjectPath ProjectPath
pp
                  BranchAtProjectPath ProjectPath
pp -> ProjectPath -> Cli (Branch IO)
Cli.getBranchFromProjectPath ProjectPath
pp
              Int
schLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.branchHashLength
              NumberedOutput
history <- IO NumberedOutput -> Cli NumberedOutput
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int
-> Int -> Branch IO -> [(CausalHash, Diff)] -> IO NumberedOutput
doHistory Int
schLength Int
0 Branch IO
branch [])
              NumberedOutput -> Cli ()
Cli.respondNumbered NumberedOutput
history
              where
                doHistory :: Int -> Int -> Branch IO -> [(CausalHash, Names.Diff)] -> IO NumberedOutput
                doHistory :: Int
-> Int -> Branch IO -> [(CausalHash, Diff)] -> IO NumberedOutput
doHistory Int
schLength !Int
n Branch IO
b [(CausalHash, Diff)]
acc =
                  if Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Int
resultsCap
                    then NumberedOutput -> IO NumberedOutput
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int
-> Int -> [(CausalHash, Diff)] -> HistoryTail -> NumberedOutput
History Maybe Int
diffCap Int
schLength [(CausalHash, Diff)]
acc (CausalHash -> Int -> HistoryTail
PageEnd (Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
b) Int
n))
                    else case Branch IO -> UnwrappedBranch IO
forall (m :: * -> *). Branch m -> UnwrappedBranch m
Branch._history Branch IO
b of
                      Causal.One {} -> NumberedOutput -> IO NumberedOutput
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int
-> Int -> [(CausalHash, Diff)] -> HistoryTail -> NumberedOutput
History Maybe Int
diffCap Int
schLength [(CausalHash, Diff)]
acc (CausalHash -> HistoryTail
EndOfLog (CausalHash -> HistoryTail) -> CausalHash -> HistoryTail
forall a b. (a -> b) -> a -> b
$ Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
b))
                      Causal.Merge CausalHash
_ HashFor (Branch0 IO)
_ Branch0 IO
_ Map CausalHash (IO (UnwrappedBranch IO))
tails ->
                        NumberedOutput -> IO NumberedOutput
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int
-> Int -> [(CausalHash, Diff)] -> HistoryTail -> NumberedOutput
History Maybe Int
diffCap Int
schLength [(CausalHash, Diff)]
acc (CausalHash -> [CausalHash] -> HistoryTail
MergeTail (Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
b) ([CausalHash] -> HistoryTail) -> [CausalHash] -> HistoryTail
forall a b. (a -> b) -> a -> b
$ Map CausalHash (IO (UnwrappedBranch IO)) -> [CausalHash]
forall k a. Map k a -> [k]
Map.keys Map CausalHash (IO (UnwrappedBranch IO))
tails))
                      Causal.Cons CausalHash
_ HashFor (Branch0 IO)
_ Branch0 IO
_ (CausalHash, IO (UnwrappedBranch IO))
tail -> do
                        Branch IO
b' <- (UnwrappedBranch IO -> Branch IO)
-> IO (UnwrappedBranch IO) -> IO (Branch IO)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnwrappedBranch IO -> Branch IO
forall (m :: * -> *). UnwrappedBranch m -> Branch m
Branch.Branch (IO (UnwrappedBranch IO) -> IO (Branch IO))
-> IO (UnwrappedBranch IO) -> IO (Branch IO)
forall a b. (a -> b) -> a -> b
$ (CausalHash, IO (UnwrappedBranch IO)) -> IO (UnwrappedBranch IO)
forall a b. (a, b) -> b
snd (CausalHash, IO (UnwrappedBranch IO))
tail
                        let elem :: (CausalHash, Diff)
elem = (Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
b, Branch IO -> Branch IO -> Diff
forall (m :: * -> *). Branch m -> Branch m -> Diff
Branch.namesDiff Branch IO
b' Branch IO
b)
                        Int
-> Int -> Branch IO -> [(CausalHash, Diff)] -> IO NumberedOutput
doHistory Int
schLength (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Branch IO
b' ((CausalHash, Diff)
elem (CausalHash, Diff) -> [(CausalHash, Diff)] -> [(CausalHash, Diff)]
forall a. a -> [a] -> [a]
: [(CausalHash, Diff)]
acc)
            Input
UndoI -> do
              Branch IO
rootBranch <- Cli (Branch IO)
Cli.getCurrentProjectRoot
              (Branch0 IO
_, Branch IO
prev) <-
                IO (Maybe (Branch0 IO, Branch IO))
-> Cli (Maybe (Branch0 IO, Branch IO))
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Branch IO -> IO (Maybe (Branch0 IO, Branch IO))
forall (m :: * -> *).
Applicative m =>
Branch m -> m (Maybe (Branch0 m, Branch m))
Branch.uncons Branch IO
rootBranch) Cli (Maybe (Branch0 IO, Branch IO))
-> (Cli (Maybe (Branch0 IO, Branch IO))
    -> Cli (Branch0 IO, Branch IO))
-> Cli (Branch0 IO, Branch IO)
forall a b. a -> (a -> b) -> b
& Cli (Branch0 IO, Branch IO)
-> Cli (Maybe (Branch0 IO, Branch IO))
-> Cli (Branch0 IO, Branch IO)
forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothingM do
                  Output -> Cli (Branch0 IO, Branch IO)
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli (Branch0 IO, Branch IO))
-> (UndoFailureReason -> Output)
-> UndoFailureReason
-> Cli (Branch0 IO, Branch IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UndoFailureReason -> Output
CantUndo (UndoFailureReason -> Cli (Branch0 IO, Branch IO))
-> UndoFailureReason -> Cli (Branch0 IO, Branch IO)
forall a b. (a -> b) -> a -> b
$
                    if Branch IO -> Bool
forall (m :: * -> *). Branch m -> Bool
Branch.isOne Branch IO
rootBranch
                      then UndoFailureReason
CantUndoPastStart
                      else UndoFailureReason
CantUndoPastMerge
              Text
description <- Input -> Cli Text
inputDescription Input
input
              ProjectBranch
pb <- Cli ProjectBranch
getCurrentProjectBranch
              ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli ()
Cli.updateProjectBranchRoot_ ProjectBranch
pb Text
description (Branch IO -> Branch IO -> Branch IO
forall a b. a -> b -> a
const Branch IO
prev)
              (PrettyPrintEnv
ppe, BranchDiffOutput Symbol Ann
diff) <- Branch0 IO
-> Branch0 IO -> Cli (PrettyPrintEnv, BranchDiffOutput Symbol Ann)
diffHelper (Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
prev) (Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
rootBranch)
              NumberedOutput -> Cli ()
Cli.respondNumbered (PrettyPrintEnv -> BranchDiffOutput Symbol Ann -> NumberedOutput
Output.ShowDiffAfterUndo PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diff)
            UiI Path'
path' -> Path' -> Cli ()
openUI Path'
path'
            DocToMarkdownI Name
docName -> do
              Names
names <- Cli Names
Cli.currentNames
              let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
              Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase, Runtime Symbol
runtime :: Runtime Symbol
$sel:runtime:Env :: Env -> Runtime Symbol
runtime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              [Reference]
docRefs <- Transaction [Reference] -> Cli [Reference]
forall a. Transaction a -> Cli a
Cli.runTransaction do
                Int
hqLength <- Transaction Int
Codebase.hashLength
                let nameSearch :: NameSearch Transaction
nameSearch = Int -> Names -> NameSearch Transaction
forall (m :: * -> *). Applicative m => Int -> Names -> NameSearch m
NameSearch.makeNameSearch Int
hqLength Names
names
                Codebase IO Symbol Ann
-> NameSearch Transaction
-> SearchType
-> Name
-> Transaction [Reference]
Backend.docsForDefinitionName Codebase IO Symbol Ann
codebase NameSearch Transaction
nameSearch SearchType
Names.IncludeSuffixes Name
docName
              [Text]
mdText <- IO [Text] -> Cli [Text]
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> Cli [Text]) -> IO [Text] -> Cli [Text]
forall a b. (a -> b) -> a -> b
$ do
                [Reference] -> (Reference -> IO Text) -> IO [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Reference]
docRefs \Reference
docRef -> do
                  Identity (Text
_, Text
_, Doc
doc, [Error]
_evalErrs) <- PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> Identity Reference
-> IO (Identity (Text, Text, Doc, [Error]))
forall (t :: * -> *).
Traversable t =>
PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> t Reference
-> IO (t (Text, Text, Doc, [Error]))
Backend.renderDocRefs PrettyPrintEnvDecl
pped (Int -> Width
Pretty.Width Int
80) Codebase IO Symbol Ann
codebase Runtime Symbol
runtime (Reference -> Identity Reference
forall a. a -> Identity a
Identity Reference
docRef)
                  Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> ([Markdown] -> Text) -> [Markdown] -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markdown] -> Text
Md.toText ([Markdown] -> IO Text) -> [Markdown] -> IO Text
forall a b. (a -> b) -> a -> b
$ Doc -> [Markdown]
Md.toMarkdown Doc
doc
              Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Text -> Output
Output.MarkdownOut (Text -> [Text] -> Text
Text.intercalate Text
"\n---\n" [Text]
mdText)
            DocsToHtmlI BranchRelativePath
namespacePath' String
sourceDirectory -> do
              Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase, Runtime Symbol
sandboxedRuntime :: Runtime Symbol
$sel:sandboxedRuntime:Env :: Env -> Runtime Symbol
sandboxedRuntime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              ProjectPath
projPath <- BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
namespacePath'
              Branch IO
branch <- ProjectPath -> Cli (Branch IO)
Cli.getBranchFromProjectPath ProjectPath
projPath
              [Error]
_evalErrs <- IO [Error] -> Cli [Error]
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Error] -> Cli [Error]) -> IO [Error] -> Cli [Error]
forall a b. (a -> b) -> a -> b
$ (Runtime Symbol
-> Codebase IO Symbol Ann -> Branch IO -> String -> IO [Error]
Backend.docsInBranchToHtmlFiles Runtime Symbol
sandboxedRuntime Codebase IO Symbol Ann
codebase Branch IO
branch String
sourceDirectory)
              pure ()
            AliasTermI Bool
force HashOrHQSplit'
src' Split'
dest' -> do
              Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              Either ShortHash (ProjectPath, HQSegment)
src <- LensLike
  Cli
  HashOrHQSplit'
  (Either ShortHash (ProjectPath, HQSegment))
  HQSplit'
  (ProjectPath, HQSegment)
-> LensLike
     Cli
     HashOrHQSplit'
     (Either ShortHash (ProjectPath, HQSegment))
     HQSplit'
     (ProjectPath, HQSegment)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Cli
  HashOrHQSplit'
  (Either ShortHash (ProjectPath, HQSegment))
  HQSplit'
  (ProjectPath, HQSegment)
forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right HQSplit' -> Cli (ProjectPath, HQSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' HashOrHQSplit'
src'
              Set Referent
srcTerms <-
                (ShortHash -> Cli (Set Referent))
-> ((ProjectPath, HQSegment) -> Cli (Set Referent))
-> Either ShortHash (ProjectPath, HQSegment)
-> Cli (Set Referent)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                  (Transaction (Set Referent) -> Cli (Set Referent)
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction (Set Referent) -> Cli (Set Referent))
-> (ShortHash -> Transaction (Set Referent))
-> ShortHash
-> Cli (Set Referent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann -> ShortHash -> Transaction (Set Referent)
forall (m :: * -> *) v a.
Codebase m v a -> ShortHash -> Transaction (Set Referent)
Backend.termReferentsByShortHash Codebase IO Symbol Ann
codebase)
                  (ProjectPath, HQSegment) -> Cli (Set Referent)
Cli.getTermsAt
                  Either ShortHash (ProjectPath, HQSegment)
src
              Referent
srcTerm <-
                Set Referent -> Maybe Referent
forall a. Set a -> Maybe a
Set.asSingleton Set Referent
srcTerms Maybe Referent -> (Maybe Referent -> Cli Referent) -> Cli Referent
forall a b. a -> (a -> b) -> b
& Cli Referent -> Maybe Referent -> Cli Referent
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing do
                  Output -> Cli Referent
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli Referent) -> Cli Output -> Cli Referent
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case (Set Referent -> Bool
forall a. Set a -> Bool
Set.null Set Referent
srcTerms, HashOrHQSplit'
src') of
                    (Bool
True, Left ShortHash
hash) -> Output -> Cli Output
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShortHash -> Output
TermNotFound' ShortHash
hash)
                    (Bool
True, Right HQSplit'
name) -> Output -> Cli Output
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Output
TermNotFound HQSplit'
name)
                    (Bool
False, Left ShortHash
hash) -> Output -> Cli Output
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShortHash -> Set Referent -> Output
HashAmbiguous ShortHash
hash Set Referent
srcTerms)
                    (Bool
False, Right HQSplit'
name) -> do
                      Int
hqLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.hashLength
                      pure (Int -> HQSplit' -> Set Referent -> Set Reference -> Output
DeleteNameAmbiguous Int
hqLength HQSplit'
name Set Referent
srcTerms Set Reference
forall a. Set a
Set.empty)
              (ProjectPath, NameSegment)
dest <- Split' -> Cli (ProjectPath, NameSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' Split'
dest'
              Set Referent
destTerms <- (ProjectPath, HQSegment) -> Cli (Set Referent)
Cli.getTermsAt (NameSegment -> HQSegment
forall n. n -> HashQualified n
HQ'.NameOnly (NameSegment -> HQSegment)
-> (ProjectPath, NameSegment) -> (ProjectPath, HQSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProjectPath, NameSegment)
dest)
              Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
force Bool -> Bool -> Bool
&& Bool -> Bool
not (Set Referent -> Bool
forall a. Set a -> Bool
Set.null Set Referent
destTerms)) do
                Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Split' -> Set Referent -> Output
TermAlreadyExists Split'
dest' Set Referent
destTerms)
              Text
description <- Input -> Cli Text
inputDescription Input
input
              Text -> (ProjectPath, Branch0 IO -> Branch0 IO) -> Cli ()
Cli.stepAt Text
description ((ProjectPath, NameSegment)
-> Referent -> (ProjectPath, Branch0 IO -> Branch0 IO)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName (ProjectPath, NameSegment)
dest Referent
srcTerm)
              Output -> Cli ()
Cli.respond Output
Success
            AliasTypeI Bool
force HashOrHQSplit'
src' Split'
dest' -> do
              Either ShortHash (ProjectPath, HQSegment)
src <- LensLike
  Cli
  HashOrHQSplit'
  (Either ShortHash (ProjectPath, HQSegment))
  HQSplit'
  (ProjectPath, HQSegment)
-> LensLike
     Cli
     HashOrHQSplit'
     (Either ShortHash (ProjectPath, HQSegment))
     HQSplit'
     (ProjectPath, HQSegment)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike
  Cli
  HashOrHQSplit'
  (Either ShortHash (ProjectPath, HQSegment))
  HQSplit'
  (ProjectPath, HQSegment)
forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right HQSplit' -> Cli (ProjectPath, HQSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' HashOrHQSplit'
src'
              Set Reference
srcTypes <-
                (ShortHash -> Cli (Set Reference))
-> ((ProjectPath, HQSegment) -> Cli (Set Reference))
-> Either ShortHash (ProjectPath, HQSegment)
-> Cli (Set Reference)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                  (Transaction (Set Reference) -> Cli (Set Reference)
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction (Set Reference) -> Cli (Set Reference))
-> (ShortHash -> Transaction (Set Reference))
-> ShortHash
-> Cli (Set Reference)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortHash -> Transaction (Set Reference)
Backend.typeReferencesByShortHash)
                  (ProjectPath, HQSegment) -> Cli (Set Reference)
Cli.getTypesAt
                  Either ShortHash (ProjectPath, HQSegment)
src
              Reference
srcType <-
                Set Reference -> Maybe Reference
forall a. Set a -> Maybe a
Set.asSingleton Set Reference
srcTypes Maybe Reference
-> (Maybe Reference -> Cli Reference) -> Cli Reference
forall a b. a -> (a -> b) -> b
& Cli Reference -> Maybe Reference -> Cli Reference
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing do
                  Output -> Cli Reference
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli Reference) -> Cli Output -> Cli Reference
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case (Set Reference -> Bool
forall a. Set a -> Bool
Set.null Set Reference
srcTypes, HashOrHQSplit'
src') of
                    (Bool
True, Left ShortHash
hash) -> Output -> Cli Output
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShortHash -> Output
TypeNotFound' ShortHash
hash)
                    (Bool
True, Right HQSplit'
name) -> Output -> Cli Output
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Output
TypeNotFound HQSplit'
name)
                    (Bool
False, Left ShortHash
hash) -> Output -> Cli Output
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShortHash -> Set Referent -> Output
HashAmbiguous ShortHash
hash ((Reference -> Referent) -> Set Reference -> Set Referent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> Referent
Referent.Ref Set Reference
srcTypes))
                    (Bool
False, Right HQSplit'
name) -> do
                      Int
hqLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.hashLength
                      pure (Int -> HQSplit' -> Set Referent -> Set Reference -> Output
DeleteNameAmbiguous Int
hqLength HQSplit'
name Set Referent
forall a. Set a
Set.empty Set Reference
srcTypes)
              (ProjectPath, NameSegment)
dest <- Split' -> Cli (ProjectPath, NameSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' Split'
dest'
              Set Reference
destTypes <- (ProjectPath, HQSegment) -> Cli (Set Reference)
Cli.getTypesAt (NameSegment -> HQSegment
forall n. n -> HashQualified n
HQ'.NameOnly (NameSegment -> HQSegment)
-> (ProjectPath, NameSegment) -> (ProjectPath, HQSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProjectPath, NameSegment)
dest)
              Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
force Bool -> Bool -> Bool
&& Bool -> Bool
not (Set Reference -> Bool
forall a. Set a -> Bool
Set.null Set Reference
destTypes)) do
                Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Split' -> Set Reference -> Output
TypeAlreadyExists Split'
dest' Set Reference
destTypes)
              Text
description <- Input -> Cli Text
inputDescription Input
input
              Text -> (ProjectPath, Branch0 IO -> Branch0 IO) -> Cli ()
Cli.stepAt Text
description ((ProjectPath, NameSegment)
-> Reference -> (ProjectPath, Branch0 IO -> Branch0 IO)
forall p (m :: * -> *).
(p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTypeName (ProjectPath, NameSegment)
dest Reference
srcType)
              Output -> Cli ()
Cli.respond Output
Success

            -- this implementation will happily produce name conflicts,
            -- but will surface them in a normal diff at the end of the operation.
            AliasManyI [HQSplit]
srcs Path'
dest' -> do
              Branch0 IO
root0 <- Cli (Branch0 IO)
Cli.getCurrentProjectRoot0
              Branch0 IO
currentBranch0 <- Cli (Branch0 IO)
Cli.getCurrentBranch0
              ProjectPath
destPP <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
dest'
              Branch0 IO
old <- ProjectPath -> Cli (Branch0 IO)
Cli.getBranch0FromProjectPath ProjectPath
destPP
              Text
description <- Input -> Cli Text
inputDescription Input
input
              let ([HQSplit]
unknown, [(Absolute, Branch0 IO -> Branch0 IO)]
actions) = (([HQSplit], [(Absolute, Branch0 IO -> Branch0 IO)])
 -> HQSplit -> ([HQSplit], [(Absolute, Branch0 IO -> Branch0 IO)]))
-> ([HQSplit], [(Absolute, Branch0 IO -> Branch0 IO)])
-> [HQSplit]
-> ([HQSplit], [(Absolute, Branch0 IO -> Branch0 IO)])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Branch0 IO
-> Branch0 IO
-> Absolute
-> ([HQSplit], [(Absolute, Branch0 IO -> Branch0 IO)])
-> HQSplit
-> ([HQSplit], [(Absolute, Branch0 IO -> Branch0 IO)])
forall (m :: * -> *).
Branch0 IO
-> Branch0 IO
-> Absolute
-> ([HQSplit], [(Absolute, Branch0 m -> Branch0 m)])
-> HQSplit
-> ([HQSplit], [(Absolute, Branch0 m -> Branch0 m)])
go Branch0 IO
root0 Branch0 IO
currentBranch0 (ProjectPath -> Absolute
forall proj branch. ProjectPathG proj branch -> Absolute
PP.absPath ProjectPath
destPP)) ([HQSplit], [(Absolute, Branch0 IO -> Branch0 IO)])
forall a. Monoid a => a
mempty [HQSplit]
srcs
              ProjectBranch
-> Text -> [(Absolute, Branch0 IO -> Branch0 IO)] -> Cli ()
Cli.stepManyAt ProjectPath
destPP.branch Text
description [(Absolute, Branch0 IO -> Branch0 IO)]
actions
              Branch0 IO
new <- ProjectPath -> Cli (Branch0 IO)
Cli.getBranch0FromProjectPath ProjectPath
destPP
              (PrettyPrintEnv
ppe, BranchDiffOutput Symbol Ann
diff) <- Branch0 IO
-> Branch0 IO -> Cli (PrettyPrintEnv, BranchDiffOutput Symbol Ann)
diffHelper Branch0 IO
old Branch0 IO
new
              NumberedOutput -> Cli ()
Cli.respondNumbered (Path'
-> Absolute
-> PrettyPrintEnv
-> BranchDiffOutput Symbol Ann
-> NumberedOutput
ShowDiffAfterModifyBranch Path'
dest' (ProjectPath
destPP.absPath) PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diff)
              Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([HQSplit] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HQSplit]
unknown)) do
                Output -> Cli ()
Cli.respond (Output -> Cli ()) -> ([HQSplit] -> Output) -> [HQSplit] -> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HashQualified Name] -> Output
SearchTermsNotFound ([HashQualified Name] -> Output)
-> ([HQSplit] -> [HashQualified Name]) -> [HQSplit] -> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HQSplit -> HashQualified Name)
-> [HQSplit] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HQSplit -> HashQualified Name
fixupOutput ([HQSplit] -> Cli ()) -> [HQSplit] -> Cli ()
forall a b. (a -> b) -> a -> b
$ [HQSplit]
unknown
              where
                -- a list of missing sources (if any) and the actions that do the work
                go ::
                  Branch0 IO ->
                  Branch0 IO ->
                  Path.Absolute ->
                  ([Path.HQSplit], [(Path.Absolute, Branch0 m -> Branch0 m)]) ->
                  Path.HQSplit ->
                  ([Path.HQSplit], [(Path.Absolute, Branch0 m -> Branch0 m)])
                go :: forall (m :: * -> *).
Branch0 IO
-> Branch0 IO
-> Absolute
-> ([HQSplit], [(Absolute, Branch0 m -> Branch0 m)])
-> HQSplit
-> ([HQSplit], [(Absolute, Branch0 m -> Branch0 m)])
go Branch0 IO
root0 Branch0 IO
currentBranch0 Absolute
dest ([HQSplit]
missingSrcs, [(Absolute, Branch0 m -> Branch0 m)]
actions) HQSplit
hqsrc =
                  let proposedDest :: Path.AbsSplit
                      proposedDest :: (Absolute, NameSegment)
proposedDest = (HQSegment -> NameSegment)
-> HQSplitAbsolute -> (Absolute, NameSegment)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second HQSegment -> NameSegment
forall n. HashQualified n -> n
HQ'.toName HQSplitAbsolute
hqProposedDest
                      hqProposedDest :: Path.HQSplitAbsolute
                      hqProposedDest :: HQSplitAbsolute
hqProposedDest = Absolute -> HQSplit -> HQSplitAbsolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
dest HQSplit
hqsrc
                      -- `Nothing` if src doesn't exist
                      doType :: Maybe [(Path.Absolute, Branch0 m -> Branch0 m)]
                      doType :: forall (m :: * -> *). Maybe [(Absolute, Branch0 m -> Branch0 m)]
doType = case ( HQSplit -> Branch0 IO -> Set Reference
forall (m :: * -> *). HQSplit -> Branch0 m -> Set Reference
BranchUtil.getType HQSplit
hqsrc Branch0 IO
currentBranch0,
                                      HQSplit -> Branch0 IO -> Set Reference
forall (m :: * -> *). HQSplit -> Branch0 m -> Set Reference
BranchUtil.getType ((Absolute -> Path) -> HQSplitAbsolute -> HQSplit
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Absolute -> Path
Path.unabsolute HQSplitAbsolute
hqProposedDest) Branch0 IO
root0
                                    ) of
                        (Set Reference -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null -> Bool
True, Set Reference
_) -> Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall a. Maybe a
Nothing -- missing src
                        (Set Reference
rsrcs, Set Reference
existing) ->
                          -- happy path
                          [(Absolute, Branch0 m -> Branch0 m)]
-> Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall a. a -> Maybe a
Just ([(Absolute, Branch0 m -> Branch0 m)]
 -> Maybe [(Absolute, Branch0 m -> Branch0 m)])
-> (Set Reference -> [(Absolute, Branch0 m -> Branch0 m)])
-> Set Reference
-> Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> (Absolute, Branch0 m -> Branch0 m))
-> [Reference] -> [(Absolute, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map Reference -> (Absolute, Branch0 m -> Branch0 m)
forall (m :: * -> *).
Reference -> (Absolute, Branch0 m -> Branch0 m)
addAlias ([Reference] -> [(Absolute, Branch0 m -> Branch0 m)])
-> (Set Reference -> [Reference])
-> Set Reference
-> [(Absolute, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Reference -> [Reference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Reference -> Maybe [(Absolute, Branch0 m -> Branch0 m)])
-> Set Reference -> Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$ Set Reference -> Set Reference -> Set Reference
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Reference
rsrcs Set Reference
existing
                          where
                            addAlias :: Reference -> (Path.Absolute, Branch0 m -> Branch0 m)
                            addAlias :: forall (m :: * -> *).
Reference -> (Absolute, Branch0 m -> Branch0 m)
addAlias Reference
r = (Absolute, NameSegment)
-> Reference -> (Absolute, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTypeName (Absolute, NameSegment)
proposedDest Reference
r
                      doTerm :: Maybe [(Path.Absolute, Branch0 m -> Branch0 m)]
                      doTerm :: forall (m :: * -> *). Maybe [(Absolute, Branch0 m -> Branch0 m)]
doTerm = case ( HQSplit -> Branch0 IO -> Set Referent
forall (m :: * -> *). HQSplit -> Branch0 m -> Set Referent
BranchUtil.getTerm HQSplit
hqsrc Branch0 IO
currentBranch0,
                                      HQSplit -> Branch0 IO -> Set Referent
forall (m :: * -> *). HQSplit -> Branch0 m -> Set Referent
BranchUtil.getTerm ((Absolute -> Path) -> HQSplitAbsolute -> HQSplit
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Absolute -> Path
Path.unabsolute HQSplitAbsolute
hqProposedDest) Branch0 IO
root0
                                    ) of
                        (Set Referent -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null -> Bool
True, Set Referent
_) -> Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall a. Maybe a
Nothing -- missing src
                        (Set Referent
rsrcs, Set Referent
existing) ->
                          [(Absolute, Branch0 m -> Branch0 m)]
-> Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall a. a -> Maybe a
Just ([(Absolute, Branch0 m -> Branch0 m)]
 -> Maybe [(Absolute, Branch0 m -> Branch0 m)])
-> (Set Referent -> [(Absolute, Branch0 m -> Branch0 m)])
-> Set Referent
-> Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent -> (Absolute, Branch0 m -> Branch0 m))
-> [Referent] -> [(Absolute, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> [a] -> [b]
map Referent -> (Absolute, Branch0 m -> Branch0 m)
forall {m :: * -> *}.
Referent -> (Absolute, Branch0 m -> Branch0 m)
addAlias ([Referent] -> [(Absolute, Branch0 m -> Branch0 m)])
-> (Set Referent -> [Referent])
-> Set Referent
-> [(Absolute, Branch0 m -> Branch0 m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Referent -> [Referent]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set Referent -> Maybe [(Absolute, Branch0 m -> Branch0 m)])
-> Set Referent -> Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$ Set Referent -> Set Referent -> Set Referent
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Referent
rsrcs Set Referent
existing
                          where
                            addAlias :: Referent -> (Absolute, Branch0 m -> Branch0 m)
addAlias Referent
r = (Absolute, NameSegment)
-> Referent -> (Absolute, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName (Absolute, NameSegment)
proposedDest Referent
r
                   in case (Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall (m :: * -> *). Maybe [(Absolute, Branch0 m -> Branch0 m)]
doType, Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall (m :: * -> *). Maybe [(Absolute, Branch0 m -> Branch0 m)]
doTerm) of
                        (Maybe [(Absolute, Branch0 m -> Branch0 m)]
Nothing, Maybe [(Absolute, Branch0 m -> Branch0 m)]
Nothing) -> ([HQSplit]
missingSrcs [HQSplit] -> HQSplit -> [HQSplit]
forall a b. Snoc a a b b => a -> b -> a
:> HQSplit
hqsrc, [(Absolute, Branch0 m -> Branch0 m)]
actions)
                        (Just [(Absolute, Branch0 m -> Branch0 m)]
as, Maybe [(Absolute, Branch0 m -> Branch0 m)]
Nothing) -> ([HQSplit]
missingSrcs, [(Absolute, Branch0 m -> Branch0 m)]
actions [(Absolute, Branch0 m -> Branch0 m)]
-> [(Absolute, Branch0 m -> Branch0 m)]
-> [(Absolute, Branch0 m -> Branch0 m)]
forall a. [a] -> [a] -> [a]
++ [(Absolute, Branch0 m -> Branch0 m)]
as)
                        (Maybe [(Absolute, Branch0 m -> Branch0 m)]
Nothing, Just [(Absolute, Branch0 m -> Branch0 m)]
as) -> ([HQSplit]
missingSrcs, [(Absolute, Branch0 m -> Branch0 m)]
actions [(Absolute, Branch0 m -> Branch0 m)]
-> [(Absolute, Branch0 m -> Branch0 m)]
-> [(Absolute, Branch0 m -> Branch0 m)]
forall a. [a] -> [a] -> [a]
++ [(Absolute, Branch0 m -> Branch0 m)]
as)
                        (Just [(Absolute, Branch0 m -> Branch0 m)]
as1, Just [(Absolute, Branch0 m -> Branch0 m)]
as2) -> ([HQSplit]
missingSrcs, [(Absolute, Branch0 m -> Branch0 m)]
actions [(Absolute, Branch0 m -> Branch0 m)]
-> [(Absolute, Branch0 m -> Branch0 m)]
-> [(Absolute, Branch0 m -> Branch0 m)]
forall a. [a] -> [a] -> [a]
++ [(Absolute, Branch0 m -> Branch0 m)]
as1 [(Absolute, Branch0 m -> Branch0 m)]
-> [(Absolute, Branch0 m -> Branch0 m)]
-> [(Absolute, Branch0 m -> Branch0 m)]
forall a. [a] -> [a] -> [a]
++ [(Absolute, Branch0 m -> Branch0 m)]
as2)

                fixupOutput :: Path.HQSplit -> HQ.HashQualified Name
                fixupOutput :: HQSplit -> HashQualified Name
fixupOutput = HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (HashQualified Name -> HashQualified Name)
-> (HQSplit -> HashQualified Name) -> HQSplit -> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HQSplit -> HashQualified Name
Path.nameFromHQSplit
            NamesI Bool
global HashQualified Name
query -> do
              Int
hqLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.hashLength
              let searchNames :: Names
-> Cli
     ([(Referent, [HashQualified Name])],
      [(Reference, [HashQualified Name])])
searchNames Names
names = do
                    let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
                        unsuffixifiedPPE :: PrettyPrintEnv
unsuffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.unsuffixifiedPPE PrettyPrintEnvDecl
pped
                        terms :: Set Referent
terms = SearchType -> HashQualified Name -> Names -> Set Referent
Names.lookupHQTerm SearchType
Names.IncludeSuffixes HashQualified Name
query Names
names
                        types :: Set Reference
types = SearchType -> HashQualified Name -> Names -> Set Reference
Names.lookupHQType SearchType
Names.IncludeSuffixes HashQualified Name
query Names
names
                        terms' :: [(Referent, [HQ'.HashQualified Name])]
                        terms' :: [(Referent, [HashQualified Name])]
terms' = (Referent -> (Referent, [HashQualified Name]))
-> [Referent] -> [(Referent, [HashQualified Name])]
forall a b. (a -> b) -> [a] -> [b]
map (\Referent
r -> (Referent
r, PrettyPrintEnv -> Referent -> [HashQualified Name]
PPE.allTermNames PrettyPrintEnv
unsuffixifiedPPE Referent
r)) (Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
terms)
                        types' :: [(Reference, [HQ'.HashQualified Name])]
                        types' :: [(Reference, [HashQualified Name])]
types' = (Reference -> (Reference, [HashQualified Name]))
-> [Reference] -> [(Reference, [HashQualified Name])]
forall a b. (a -> b) -> [a] -> [b]
map (\Reference
r -> (Reference
r, PrettyPrintEnv -> Reference -> [HashQualified Name]
PPE.allTypeNames PrettyPrintEnv
unsuffixifiedPPE Reference
r)) (Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList Set Reference
types)
                    ([(Referent, [HashQualified Name])],
 [(Reference, [HashQualified Name])])
-> Cli
     ([(Referent, [HashQualified Name])],
      [(Reference, [HashQualified Name])])
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Referent, [HashQualified Name])]
terms', [(Reference, [HashQualified Name])]
types')
              if Bool
global
                then do
                  ((ProjectAndBranch ProjectName ProjectBranchName,
  ProjectAndBranch ProjectId ProjectBranchId)
 -> Branch IO -> Cli ())
-> Cli ()
forall r.
Monoid r =>
((ProjectAndBranch ProjectName ProjectBranchName,
  ProjectAndBranch ProjectId ProjectBranchId)
 -> Branch IO -> Cli r)
-> Cli r
Global.forAllProjectBranches \(ProjectAndBranch ProjectName ProjectBranchName
projBranchNames, ProjectAndBranch ProjectId ProjectBranchId
_ids) Branch IO
branch -> do
                    let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Names)
-> (Branch IO -> Branch0 IO) -> Branch IO -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch IO -> Names) -> Branch IO -> Names
forall a b. (a -> b) -> a -> b
$ Branch IO
branch
                    ([(Referent, [HashQualified Name])]
terms, [(Reference, [HashQualified Name])]
types) <- Names
-> Cli
     ([(Referent, [HashQualified Name])],
      [(Reference, [HashQualified Name])])
searchNames Names
names
                    Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([(Referent, [HashQualified Name])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Referent, [HashQualified Name])]
terms) Bool -> Bool -> Bool
|| Bool -> Bool
not ([(Reference, [HashQualified Name])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Reference, [HashQualified Name])]
types)) do
                      Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ ProjectAndBranch ProjectName ProjectBranchName
-> Int
-> [(Reference, [HashQualified Name])]
-> [(Referent, [HashQualified Name])]
-> Output
GlobalListNames ProjectAndBranch ProjectName ProjectBranchName
projBranchNames Int
hqLength [(Reference, [HashQualified Name])]
types [(Referent, [HashQualified Name])]
terms
                else do
                  Names
names <- Cli Names
Cli.currentNames
                  ([(Referent, [HashQualified Name])]
terms, [(Reference, [HashQualified Name])]
types) <- Names
-> Cli
     ([(Referent, [HashQualified Name])],
      [(Reference, [HashQualified Name])])
searchNames Names
names
                  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Int
-> [(Reference, [HashQualified Name])]
-> [(Referent, [HashQualified Name])]
-> Output
ListNames Int
hqLength [(Reference, [HashQualified Name])]
types [(Referent, [HashQualified Name])]
terms
            DocsI NonEmpty Name
srcs -> do
              NonEmpty Name -> (Name -> Cli ()) -> Cli ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NonEmpty Name
srcs Name -> Cli ()
docsI
            CreateAuthorI NameSegment
authorNameSegment Text
authorFullName -> do
              Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              Branch IO
initialBranch <- Cli (Branch IO)
Cli.getCurrentBranch
              AuthorInfo
                guid :: (Id, Term Symbol Ann, Type Symbol Ann)
guid@(Id
guidRef, Term Symbol Ann
_, Type Symbol Ann
_)
                author :: (Id, Term Symbol Ann, Type Symbol Ann)
author@(Id
authorRef, Term Symbol Ann
_, Type Symbol Ann
_)
                copyrightHolder :: (Id, Term Symbol Ann, Type Symbol Ann)
copyrightHolder@(Id
copyrightHolderRef, Term Symbol Ann
_, Type Symbol Ann
_) <-
                Ann -> Text -> Cli (AuthorInfo Symbol Ann)
forall (m :: * -> *) v a.
(MonadIO m, Var v) =>
a -> Text -> m (AuthorInfo v a)
AuthorInfo.createAuthorInfo Ann
Ann.External Text
authorFullName
              Text
description <- Input -> Cli Text
inputDescription Input
input
              -- add the new definitions to the codebase and to the namespace
              Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction (((Id, Term Symbol Ann, Type Symbol Ann) -> Transaction ())
-> [(Id, Term Symbol Ann, Type Symbol Ann)] -> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Id -> Term Symbol Ann -> Type Symbol Ann -> Transaction ())
-> (Id, Term Symbol Ann, Type Symbol Ann) -> Transaction ()
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 (Codebase IO Symbol Ann
-> Id -> Term Symbol Ann -> Type Symbol Ann -> Transaction ()
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Term v a -> Type v a -> Transaction ()
Codebase.putTerm Codebase IO Symbol Ann
codebase)) [(Id, Term Symbol Ann, Type Symbol Ann)
guid, (Id, Term Symbol Ann, Type Symbol Ann)
author, (Id, Term Symbol Ann, Type Symbol Ann)
copyrightHolder])
              (ProjectPath, NameSegment)
authorPath <- Split' -> Cli (ProjectPath, NameSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' Split'
authorPath'
              (ProjectPath, NameSegment)
copyrightHolderPath <- Split' -> Cli (ProjectPath, NameSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' (Split'
base Split' -> NameSegment -> Split'
forall a b. Snoc a a b b => a -> b -> a
|> NameSegment
NameSegment.copyrightHoldersSegment Split' -> NameSegment -> Split'
forall a b. Snoc a a b b => a -> b -> a
|> NameSegment
authorNameSegment)
              (ProjectPath, NameSegment)
guidPath <- Split' -> Cli (ProjectPath, NameSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' (Split'
authorPath' Split' -> NameSegment -> Split'
forall a b. Snoc a a b b => a -> b -> a
|> NameSegment
NameSegment.guidSegment)
              ProjectBranch
pb <- Cli ProjectBranch
Cli.getCurrentProjectBranch
              ProjectBranch
-> Text -> [(Absolute, Branch0 IO -> Branch0 IO)] -> Cli ()
Cli.stepManyAt
                ProjectBranch
pb
                Text
description
                [ (Absolute, NameSegment)
-> Referent -> (Absolute, Branch0 IO -> Branch0 IO)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName ((ProjectPath -> Absolute)
-> (ProjectPath, NameSegment) -> (Absolute, NameSegment)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ProjectPath -> Absolute
forall proj branch. ProjectPathG proj branch -> Absolute
PP.absPath (ProjectPath, NameSegment)
authorPath) (Id -> Referent
d Id
authorRef),
                  (Absolute, NameSegment)
-> Referent -> (Absolute, Branch0 IO -> Branch0 IO)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName ((ProjectPath -> Absolute)
-> (ProjectPath, NameSegment) -> (Absolute, NameSegment)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ProjectPath -> Absolute
forall proj branch. ProjectPathG proj branch -> Absolute
PP.absPath (ProjectPath, NameSegment)
copyrightHolderPath) (Id -> Referent
d Id
copyrightHolderRef),
                  (Absolute, NameSegment)
-> Referent -> (Absolute, Branch0 IO -> Branch0 IO)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName ((ProjectPath -> Absolute)
-> (ProjectPath, NameSegment) -> (Absolute, NameSegment)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ProjectPath -> Absolute
forall proj branch. ProjectPathG proj branch -> Absolute
PP.absPath (ProjectPath, NameSegment)
guidPath) (Id -> Referent
d Id
guidRef)
                ]
              Absolute
currentPath <- Cli Absolute
Cli.getCurrentPath
              Branch0 IO
finalBranch <- Cli (Branch0 IO)
Cli.getCurrentBranch0
              (PrettyPrintEnv
ppe, BranchDiffOutput Symbol Ann
diff) <- Branch0 IO
-> Branch0 IO -> Cli (PrettyPrintEnv, BranchDiffOutput Symbol Ann)
diffHelper (Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
initialBranch) Branch0 IO
finalBranch
              NumberedOutput -> Cli ()
Cli.respondNumbered (NumberedOutput -> Cli ()) -> NumberedOutput -> Cli ()
forall a b. (a -> b) -> a -> b
$
                NameSegment
-> Path'
-> Absolute
-> PrettyPrintEnv
-> BranchDiffOutput Symbol Ann
-> NumberedOutput
ShowDiffAfterCreateAuthor
                  NameSegment
authorNameSegment
                  (Split' -> Path'
Path.unsplit' Split'
base)
                  Absolute
currentPath
                  PrettyPrintEnv
ppe
                  BranchDiffOutput Symbol Ann
diff
              where
                d :: Reference.Id -> Referent
                d :: Id -> Referent
d = Reference -> Referent
Referent.Ref (Reference -> Referent) -> (Id -> Reference) -> Id -> Referent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Reference
forall h t. Id' h -> Reference' t h
Reference.DerivedId
                Split'
base :: Path.Split' = (Path'
Path.relativeEmpty', NameSegment
NameSegment.metadataSegment)
                authorPath' :: Split'
authorPath' = Split'
base Split' -> NameSegment -> Split'
forall a b. Snoc a a b b => a -> b -> a
|> NameSegment
NameSegment.authorsSegment Split' -> NameSegment -> Split'
forall a b. Snoc a a b b => a -> b -> a
|> NameSegment
authorNameSegment
            MoveTermI HQSplit'
src' Split'
dest' -> HQSplit' -> Split' -> Text -> Cli ()
doMoveTerm HQSplit'
src' Split'
dest' (Text -> Cli ()) -> Cli Text -> Cli ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Input -> Cli Text
inputDescription Input
input
            MoveTypeI HQSplit'
src' Split'
dest' -> HQSplit' -> Split' -> Text -> Cli ()
doMoveType HQSplit'
src' Split'
dest' (Text -> Cli ()) -> Cli Text -> Cli ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Input -> Cli Text
inputDescription Input
input
            MoveAllI Path'
src' Path'
dest' -> do
              Bool
hasConfirmed <- Input -> Cli Bool
confirmedCommand Input
input
              Text
desc <- Input -> Cli Text
inputDescription Input
input
              Bool -> Path' -> Path' -> Text -> Cli ()
handleMoveAll Bool
hasConfirmed Path'
src' Path'
dest' Text
desc
            DeleteI DeleteTarget
dtarget -> do
              ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
              let getTerms :: HQSplitAbsolute -> Cli (Set Referent)
getTerms (Absolute
absPath, HQSegment
seg) = (ProjectPath, HQSegment) -> Cli (Set Referent)
Cli.getTermsAt (ASetter ProjectPath ProjectPath Absolute Absolute
-> Absolute -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ProjectPath ProjectPath Absolute Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ Absolute
absPath ProjectPath
pp, HQSegment
seg)
              let getTypes :: HQSplitAbsolute -> Cli (Set Reference)
getTypes (Absolute
absPath, HQSegment
seg) = (ProjectPath, HQSegment) -> Cli (Set Reference)
Cli.getTypesAt (ASetter ProjectPath ProjectPath Absolute Absolute
-> Absolute -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ProjectPath ProjectPath Absolute Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ Absolute
absPath ProjectPath
pp, HQSegment
seg)
              case DeleteTarget
dtarget of
                DeleteTarget'TermOrType DeleteOutput
doutput [HQSplit']
hqs -> do
                  Input
-> DeleteOutput
-> (HQSplitAbsolute -> Cli (Set Referent))
-> (HQSplitAbsolute -> Cli (Set Reference))
-> [HQSplit']
-> Cli ()
delete Input
input DeleteOutput
doutput HQSplitAbsolute -> Cli (Set Referent)
getTerms HQSplitAbsolute -> Cli (Set Reference)
getTypes [HQSplit']
hqs
                DeleteTarget'Type DeleteOutput
doutput [HQSplit']
hqs -> Input
-> DeleteOutput
-> (HQSplitAbsolute -> Cli (Set Referent))
-> (HQSplitAbsolute -> Cli (Set Reference))
-> [HQSplit']
-> Cli ()
delete Input
input DeleteOutput
doutput (Cli (Set Referent) -> HQSplitAbsolute -> Cli (Set Referent)
forall a b. a -> b -> a
const (Set Referent -> Cli (Set Referent)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Referent
forall a. Set a
Set.empty)) HQSplitAbsolute -> Cli (Set Reference)
getTypes [HQSplit']
hqs
                DeleteTarget'Term DeleteOutput
doutput [HQSplit']
hqs -> Input
-> DeleteOutput
-> (HQSplitAbsolute -> Cli (Set Referent))
-> (HQSplitAbsolute -> Cli (Set Reference))
-> [HQSplit']
-> Cli ()
delete Input
input DeleteOutput
doutput HQSplitAbsolute -> Cli (Set Referent)
getTerms (Cli (Set Reference) -> HQSplitAbsolute -> Cli (Set Reference)
forall a b. a -> b -> a
const (Set Reference -> Cli (Set Reference)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Reference
forall a. Set a
Set.empty)) [HQSplit']
hqs
                DeleteTarget'Namespace Insistence
insistence Maybe Split
path -> Input -> Insistence -> Maybe Split -> Cli ()
handleDeleteNamespace Input
input Insistence
insistence Maybe Split
path
                DeleteTarget'ProjectBranch UnresolvedProjectBranch
name -> UnresolvedProjectBranch -> Cli ()
handleDeleteBranch UnresolvedProjectBranch
name
                DeleteTarget'Project ProjectName
name -> ProjectName -> Cli ()
handleDeleteProject ProjectName
name
            DisplayI OutputLocation
outputLoc NonEmpty (HashQualified Name)
namesToDisplay -> do
              (HashQualified Name -> Cli ())
-> NonEmpty (HashQualified Name) -> Cli ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (OutputLocation -> HashQualified Name -> Cli ()
displayI OutputLocation
outputLoc) NonEmpty (HashQualified Name)
namesToDisplay
            ShowDefinitionI OutputLocation
outputLoc ShowDefinitionScope
showDefinitionScope NonEmpty (HashQualified Name)
query -> OutputLocation
-> ShowDefinitionScope -> NonEmpty (HashQualified Name) -> Cli ()
handleShowDefinition OutputLocation
outputLoc ShowDefinitionScope
showDefinitionScope NonEmpty (HashQualified Name)
query
            EditNamespaceI [Path]
paths -> OutputLocation -> [Path] -> Cli ()
handleEditNamespace (RelativeToFold -> OutputLocation
LatestFileLocation RelativeToFold
AboveFold) [Path]
paths
            FindShallowI Path'
pathArg -> Path' -> Cli ()
handleLs Path'
pathArg
            FindI Bool
isVerbose FindScope
fscope [String]
ws -> Bool -> FindScope -> [String] -> Input -> Cli ()
handleFindI Bool
isVerbose FindScope
fscope [String]
ws Input
input
            StructuredFindI FindScope
_fscope HashQualified Name
ws -> HashQualified Name -> Cli ()
handleStructuredFindI HashQualified Name
ws
            StructuredFindReplaceI HashQualified Name
ws -> HashQualified Name -> Cli ()
handleStructuredFindReplaceI HashQualified Name
ws
            TextFindI Bool
allowLib [String]
ws -> Bool -> [String] -> Cli ()
handleTextFindI Bool
allowLib [String]
ws
            LoadI Maybe String
maybePath -> Maybe String -> Cli ()
handleLoad Maybe String
maybePath
            Input
ClearI -> Output -> Cli ()
Cli.respond Output
ClearScreen
            AddI Set Name
requestedNames -> do
              Text
description <- Input -> Cli Text
inputDescription Input
input
              let vars :: Set Symbol
vars = (Name -> Symbol) -> Set Name -> Set Symbol
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Set Name
requestedNames
              TypecheckedUnisonFile Symbol Ann
uf <- Cli (TypecheckedUnisonFile Symbol Ann)
Cli.expectLatestTypecheckedFile
              Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              Names
currentNames <- Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Names) -> Cli (Branch0 IO) -> Cli Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli (Branch0 IO)
Cli.getCurrentBranch0
              let sr :: SlurpResult
sr = TypecheckedUnisonFile Symbol Ann
-> Set Symbol -> SlurpOp -> Names -> SlurpResult
Slurp.slurpFile TypecheckedUnisonFile Symbol Ann
uf Set Symbol
vars 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
              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 pped :: PrettyPrintEnvDecl
pped =
                    let names :: Names
names = TypecheckedUnisonFile Symbol Ann -> Names -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names -> Names
UF.addNamesFromTypeCheckedUnisonFile TypecheckedUnisonFile Symbol Ann
uf Names
currentNames
                     in Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
              let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.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
            SaveExecuteResultI Name
resultName -> Input -> Name -> Cli ()
handleAddRun Input
input Name
resultName
            PreviewAddI Set Name
requestedNames -> do
              (String
sourceName, Bool
_) <- Cli (String, Bool)
Cli.expectLatestFile
              TypecheckedUnisonFile Symbol Ann
uf <- Cli (TypecheckedUnisonFile Symbol Ann)
Cli.expectLatestTypecheckedFile
              let vars :: Set Symbol
vars = (Name -> Symbol) -> Set Name -> Set Symbol
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Set Name
requestedNames
              Names
currentNames <- Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Names) -> Cli (Branch0 IO) -> Cli Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli (Branch0 IO)
Cli.getCurrentBranch0
              let sr :: SlurpResult
sr = TypecheckedUnisonFile Symbol Ann
-> Set Symbol -> SlurpOp -> Names -> SlurpResult
Slurp.slurpFile TypecheckedUnisonFile Symbol Ann
uf Set Symbol
vars SlurpOp
Slurp.AddOp Names
currentNames
              String -> SlurpResult -> TypecheckedUnisonFile Symbol Ann -> Cli ()
previewResponse String
sourceName SlurpResult
sr TypecheckedUnisonFile Symbol Ann
uf
            UpdateI OptionalPatch
optionalPatch Set Name
requestedNames -> Input -> OptionalPatch -> Set Name -> Cli ()
handleUpdate Input
input OptionalPatch
optionalPatch Set Name
requestedNames
            Input
Update2I -> Cli ()
handleUpdate2
            PreviewUpdateI Set Name
requestedNames -> do
              (String
sourceName, Bool
_) <- Cli (String, Bool)
Cli.expectLatestFile
              TypecheckedUnisonFile Symbol Ann
uf <- Cli (TypecheckedUnisonFile Symbol Ann)
Cli.expectLatestTypecheckedFile
              let vars :: Set Symbol
vars = (Name -> Symbol) -> Set Name -> Set Symbol
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Set Name
requestedNames
              Names
currentNames <- Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Names) -> Cli (Branch0 IO) -> Cli Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli (Branch0 IO)
Cli.getCurrentBranch0
              let sr :: SlurpResult
sr = TypecheckedUnisonFile Symbol Ann
-> Set Symbol -> SlurpOp -> Names -> SlurpResult
Slurp.slurpFile TypecheckedUnisonFile Symbol Ann
uf Set Symbol
vars SlurpOp
Slurp.UpdateOp Names
currentNames
              String -> SlurpResult -> TypecheckedUnisonFile Symbol Ann -> Cli ()
previewResponse String
sourceName SlurpResult
sr TypecheckedUnisonFile Symbol Ann
uf
            Input
TodoI -> Cli ()
handleTodo
            TestI Bool
native TestInput
testInput -> Bool -> TestInput -> Cli ()
Tests.handleTest Bool
native TestInput
testInput
            ExecuteI HashQualified Name
main [String]
args -> Bool -> HashQualified Name -> [String] -> Cli ()
handleRun Bool
False HashQualified Name
main [String]
args
            MakeStandaloneI String
output HashQualified Name
main ->
              Bool -> Bool -> String -> HashQualified Name -> Cli ()
doCompile Bool
False Bool
False String
output HashQualified Name
main
            CompileSchemeI Bool
prof Text
output HashQualified Name
main ->
              Bool -> Bool -> String -> HashQualified Name -> Cli ()
doCompile Bool
prof Bool
True (Text -> String
Text.unpack Text
output) HashQualified Name
main
            ExecuteSchemeI HashQualified Name
main [String]
args -> Bool -> HashQualified Name -> [String] -> Cli ()
handleRun Bool
True HashQualified Name
main [String]
args
            IOTestI Bool
native HashQualified Name
main -> Bool -> HashQualified Name -> Cli ()
Tests.handleIOTest Bool
native HashQualified Name
main
            IOTestAllI Bool
native -> Bool -> Cli ()
Tests.handleAllIOTests Bool
native
            -- UpdateBuiltinsI -> do
            --   stepAt updateBuiltins
            --   checkTodo

            MergeBuiltinsI Maybe Path
opath -> do
              Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              Text
description <- Input -> Cli Text
inputDescription Input
input
              -- these were added once, but maybe they've changed and need to be
              -- added again.
              let uf :: TypecheckedUnisonFile Symbol Ann
uf =
                    Map Symbol (Id, DataDeclaration Symbol Ann)
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> TypecheckedUnisonFile Symbol Ann
forall v a.
Var v =>
Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a)
-> [[(v, a, Term v a, Type v a)]]
-> [(String, [(v, a, Term v a, Type v a)])]
-> TypecheckedUnisonFile v a
UF.typecheckedUnisonFile
                      ([(Symbol, (Id, DataDeclaration Symbol Ann))]
-> Map Symbol (Id, DataDeclaration Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Symbol, (Id, DataDeclaration Symbol Ann))]
Builtin.builtinDataDecls)
                      ([(Symbol, (Id, EffectDeclaration Symbol Ann))]
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Symbol, (Id, EffectDeclaration Symbol Ann))]
Builtin.builtinEffectDecls)
                      [Ann -> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
forall a. a -> [(Symbol, a, Term Symbol a, Type Symbol a)]
Builtin.builtinTermsSrc Ann
Intrinsic]
                      [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
forall a. Monoid a => a
mempty
              Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction (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
uf)
              -- add the names; note, there are more names than definitions
              -- due to builtin terms; so we don't just reuse `uf` above.
              let srcb :: Branch IO
srcb = Names -> Branch IO
forall (m :: * -> *). Monad m => Names -> Branch m
BranchUtil.fromNames Names
Builtin.names
              Absolute
currentPath <- Cli Absolute
Cli.getCurrentPath
              let destPath :: Absolute
destPath = case Maybe Path
opath of
                    Just Path
path -> Absolute -> Relative -> Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
currentPath (Path -> Relative
Path.Relative Path
path)
                    Maybe Path
Nothing -> Absolute
currentPath Absolute -> NameSegment -> Absolute
forall a b. Snoc a a b b => a -> b -> a
`snoc` NameSegment
NameSegment.builtinSegment
              ProjectPath
pp <- ASetter ProjectPath ProjectPath Absolute Absolute
-> Absolute -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ProjectPath ProjectPath Absolute Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ Absolute
destPath (ProjectPath -> ProjectPath) -> Cli ProjectPath -> Cli ProjectPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli ProjectPath
Cli.getCurrentProjectPath
              Bool
_ <- Text -> ProjectPath -> (Branch IO -> Cli (Branch IO)) -> Cli Bool
Cli.updateAtM Text
description ProjectPath
pp \Branch IO
destb ->
                IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Branch IO -> Branch IO -> IO (Maybe (Branch IO)))
-> MergeMode -> Branch IO -> Branch IO -> IO (Branch IO)
forall (m :: * -> *).
Monad m =>
(Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch m -> Branch m -> m (Branch m)
Branch.merge'' (Codebase IO Symbol Ann
-> Branch IO -> Branch IO -> IO (Maybe (Branch IO))
forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> Branch m -> Branch m -> m (Maybe (Branch m))
Codebase.lca Codebase IO Symbol Ann
codebase) MergeMode
Branch.RegularMerge Branch IO
srcb Branch IO
destb)
              Output -> Cli ()
Cli.respond Output
Success
            MergeIOBuiltinsI Maybe Path
opath -> do
              Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              Text
description <- Input -> Cli Text
inputDescription Input
input
              -- these were added once, but maybe they've changed and need to be
              -- added again.
              let uf :: TypecheckedUnisonFile Symbol Ann
uf =
                    Map Symbol (Id, DataDeclaration Symbol Ann)
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
-> [[(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]]
-> [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
-> TypecheckedUnisonFile Symbol Ann
forall v a.
Var v =>
Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a)
-> [[(v, a, Term v a, Type v a)]]
-> [(String, [(v, a, Term v a, Type v a)])]
-> TypecheckedUnisonFile v a
UF.typecheckedUnisonFile
                      ([(Symbol, (Id, DataDeclaration Symbol Ann))]
-> Map Symbol (Id, DataDeclaration Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Symbol, (Id, DataDeclaration Symbol Ann))]
Builtin.builtinDataDecls)
                      ([(Symbol, (Id, EffectDeclaration Symbol Ann))]
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Symbol, (Id, EffectDeclaration Symbol Ann))]
Builtin.builtinEffectDecls)
                      [Ann -> [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)]
forall a. a -> [(Symbol, a, Term Symbol a, Type Symbol a)]
Builtin.builtinTermsSrc Ann
Intrinsic]
                      [(String, [(Symbol, Ann, Term Symbol Ann, Type Symbol Ann)])]
forall a. Monoid a => a
mempty
              Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction do
                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
uf
                -- these have not necessarily been added yet
                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
IOSource.typecheckedFile'

              -- add the names; note, there are more names than definitions
              -- due to builtin terms; so we don't just reuse `uf` above.
              let names0 :: Names
names0 = Names
Builtin.names Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames TypecheckedUnisonFile Symbol Ann
IOSource.typecheckedFile'
              let srcb :: Branch IO
srcb = Names -> Branch IO
forall (m :: * -> *). Monad m => Names -> Branch m
BranchUtil.fromNames Names
names0
              Absolute
currentPath <- Cli Absolute
Cli.getCurrentPath
              let destPath :: Absolute
destPath = case Maybe Path
opath of
                    Just Path
path -> Absolute -> Relative -> Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
currentPath (Path -> Relative
Path.Relative Path
path)
                    Maybe Path
Nothing -> Absolute
currentPath Absolute -> NameSegment -> Absolute
forall a b. Snoc a a b b => a -> b -> a
`snoc` NameSegment
NameSegment.builtinSegment
              ProjectPath
pp <- ASetter ProjectPath ProjectPath Absolute Absolute
-> Absolute -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ProjectPath ProjectPath Absolute Absolute
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ Absolute
destPath (ProjectPath -> ProjectPath) -> Cli ProjectPath -> Cli ProjectPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli ProjectPath
Cli.getCurrentProjectPath
              Bool
_ <- Text -> ProjectPath -> (Branch IO -> Cli (Branch IO)) -> Cli Bool
Cli.updateAtM Text
description ProjectPath
pp \Branch IO
destb ->
                IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Branch IO -> Branch IO -> IO (Maybe (Branch IO)))
-> MergeMode -> Branch IO -> Branch IO -> IO (Branch IO)
forall (m :: * -> *).
Monad m =>
(Branch m -> Branch m -> m (Maybe (Branch m)))
-> MergeMode -> Branch m -> Branch m -> m (Branch m)
Branch.merge'' (Codebase IO Symbol Ann
-> Branch IO -> Branch IO -> IO (Maybe (Branch IO))
forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> Branch m -> Branch m -> m (Maybe (Branch m))
Codebase.lca Codebase IO Symbol Ann
codebase) MergeMode
Branch.RegularMerge Branch IO
srcb Branch IO
destb)
              Output -> Cli ()
Cli.respond Output
Success
            PullI PullSourceTarget
sourceTarget PullMode
pullMode -> PullSourceTarget -> PullMode -> Cli ()
handlePull PullSourceTarget
sourceTarget PullMode
pullMode
            PushRemoteBranchI PushRemoteBranchInput
pushRemoteBranchInput -> PushRemoteBranchInput -> Cli ()
handlePushRemoteBranch PushRemoteBranchInput
pushRemoteBranchInput
            ListDependentsI HashQualified Name
hq -> HashQualified Name -> Cli ()
handleDependents HashQualified Name
hq
            ListDependenciesI HashQualified Name
hq -> HashQualified Name -> Cli ()
handleDependencies HashQualified Name
hq
            NamespaceDependenciesI Maybe Path'
path -> Maybe Path' -> Cli ()
handleNamespaceDependencies Maybe Path'
path
            Input
DebugNumberedArgsI -> do
              Int
schLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.branchHashLength
              [StructuredArgument]
numArgs <- Getting [StructuredArgument] LoopState [StructuredArgument]
-> Cli [StructuredArgument]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting [StructuredArgument] LoopState [StructuredArgument]
#numberedArgs
              Output -> Cli ()
Cli.respond (Int -> [StructuredArgument] -> Output
DumpNumberedArgs Int
schLength [StructuredArgument]
numArgs)
            Input
DebugTypecheckedUnisonFileI -> do
              Int
hqLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.hashLength
              TypecheckedUnisonFile Symbol Ann
uf <- Cli (TypecheckedUnisonFile Symbol Ann)
Cli.expectLatestTypecheckedFile
              let datas, effects, terms :: [(Name, Reference.Id)]
                  datas :: [(Name, Id)]
datas = [(Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v, Id
r) | (Symbol
v, (Id
r, DataDeclaration Symbol Ann
_d)) <- Map Symbol (Id, DataDeclaration Symbol Ann)
-> [(Symbol, (Id, DataDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Symbol (Id, DataDeclaration Symbol Ann)
 -> [(Symbol, (Id, DataDeclaration Symbol Ann))])
-> Map Symbol (Id, DataDeclaration Symbol Ann)
-> [(Symbol, (Id, DataDeclaration Symbol Ann))]
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> Map Symbol (Id, DataDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a -> Map v (Id, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile Symbol Ann
uf]
                  effects :: [(Name, Id)]
effects = [(Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v, Id
r) | (Symbol
v, (Id
r, EffectDeclaration Symbol Ann
_e)) <- Map Symbol (Id, EffectDeclaration Symbol Ann)
-> [(Symbol, (Id, EffectDeclaration Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Symbol (Id, EffectDeclaration Symbol Ann)
 -> [(Symbol, (Id, EffectDeclaration Symbol Ann))])
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
-> [(Symbol, (Id, EffectDeclaration Symbol Ann))]
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> Map Symbol (Id, EffectDeclaration Symbol Ann)
forall v a.
TypecheckedUnisonFile v a -> Map v (Id, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile Symbol Ann
uf]
                  terms :: [(Name, Id)]
terms = [(Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Symbol
v, Id
r) | (Symbol
v, (Ann
_, Id
r, Maybe String
_wk, Term Symbol Ann
_tm, Type Symbol Ann
_tp)) <- Map
  Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> [(Symbol,
     (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map
   Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
 -> [(Symbol,
      (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann))])
-> Map
     Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
-> [(Symbol,
     (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann))]
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile Symbol Ann
-> Map
     Symbol (Ann, Id, Maybe String, Term Symbol Ann, Type Symbol Ann)
forall v a.
TypecheckedUnisonFile v a
-> Map v (a, Id, Maybe String, Term v a, Type v a)
UF.hashTermsId TypecheckedUnisonFile Symbol Ann
uf]
              Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Int -> [(Name, Id)] -> [(Name, Id)] -> [(Name, Id)] -> Output
DumpUnisonFileHashes Int
hqLength [(Name, Id)]
datas [(Name, Id)]
effects [(Name, Id)]
terms
            DebugTabCompletionI [String]
inputs -> do
              Cli.Env {AuthenticatedHttpClient
authHTTPClient :: AuthenticatedHttpClient
$sel:authHTTPClient:Env :: Env -> AuthenticatedHttpClient
authHTTPClient, Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
              let completionFunc :: CompletionFunc IO
completionFunc = Map String InputPattern
-> Codebase IO Symbol Ann
-> AuthenticatedHttpClient
-> ProjectPath
-> CompletionFunc IO
forall (m :: * -> *) v a.
MonadIO m =>
Map String InputPattern
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> CompletionFunc m
Completion.haskelineTabComplete Map String InputPattern
IP.patternMap Codebase IO Symbol Ann
codebase AuthenticatedHttpClient
authHTTPClient ProjectPath
pp
              (String
_, [Completion]
completions) <- IO (String, [Completion]) -> Cli (String, [Completion])
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (String, [Completion]) -> Cli (String, [Completion]))
-> IO (String, [Completion]) -> Cli (String, [Completion])
forall a b. (a -> b) -> a -> b
$ CompletionFunc IO
completionFunc (String -> String
forall a. [a] -> [a]
reverse ([String] -> String
unwords [String]
inputs), String
"")
              Output -> Cli ()
Cli.respond ([Completion] -> Output
DisplayDebugCompletions [Completion]
completions)
            DebugLSPNameCompletionI Text
prefix -> do
              Text -> Cli ()
LSPDebug.debugLspNameCompletion Text
prefix
            DebugFuzzyOptionsI String
command [String]
args -> do
              Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              Branch0 IO
currentBranch <- Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.withoutTransitiveLibs (Branch0 IO -> Branch0 IO) -> Cli (Branch0 IO) -> Cli (Branch0 IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli (Branch0 IO)
Cli.getCurrentBranch0
              case String -> Map String InputPattern -> Maybe InputPattern
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
command Map String InputPattern
InputPatterns.patternMap of
                Just (IP.InputPattern {$sel:args:InputPattern :: InputPattern -> [(Text, IsOptional, ArgumentType)]
args = [(Text, IsOptional, ArgumentType)]
argTypes}) -> do
                  [(Text, IsOptional, ArgumentType)]
-> [String] -> [((Text, IsOptional, ArgumentType), String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Text, IsOptional, ArgumentType)]
argTypes [String]
args [((Text, IsOptional, ArgumentType), String)]
-> ([((Text, IsOptional, ArgumentType), String)] -> Cli ())
-> Cli ()
forall a b. a -> (a -> b) -> b
& (((Text, IsOptional, ArgumentType), String) -> Cli ())
-> [((Text, IsOptional, ArgumentType), String)] -> Cli ()
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
Monoid.foldMapM \case
                    ((Text
argName, IsOptional
_, IP.ArgumentType {$sel:fzfResolver:ArgumentType :: ArgumentType -> Maybe FZFResolver
fzfResolver = Just IP.FZFResolver {OptionFetcher
getOptions :: OptionFetcher
$sel:getOptions:FZFResolver :: FZFResolver -> OptionFetcher
getOptions}}), String
"_") -> do
                      ProjectPath
pp <- Cli ProjectPath
Cli.getCurrentProjectPath
                      [Text]
results <- IO [Text] -> Cli [Text]
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> Cli [Text]) -> IO [Text] -> Cli [Text]
forall a b. (a -> b) -> a -> b
$ OptionFetcher
getOptions Codebase IO Symbol Ann
codebase ProjectPath
pp Branch0 IO
currentBranch
                      Output -> Cli ()
Cli.respond (Text -> [String] -> Output
DebugDisplayFuzzyOptions Text
argName (Text -> String
Text.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
results))
                    ((Text
_, IsOptional
_, IP.ArgumentType {$sel:fzfResolver:ArgumentType :: ArgumentType -> Maybe FZFResolver
fzfResolver = Maybe FZFResolver
Nothing}), String
"_") -> do
                      Output -> Cli ()
Cli.respond Output
DebugFuzzyOptionsNoResolver
                    ((Text, IsOptional, ArgumentType), String)
_ -> () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Maybe InputPattern
Nothing -> do
                  Output -> Cli ()
Cli.respond Output
DebugFuzzyOptionsNoResolver
            Input
DebugFormatI -> do
              Env
env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
              Cli (Maybe ()) -> Cli ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Cli (Maybe ()) -> Cli ()) -> Cli (Maybe ()) -> Cli ()
forall a b. (a -> b) -> a -> b
$ MaybeT Cli () -> Cli (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
                (String
filePath, Bool
_) <- Cli (Maybe (String, Bool)) -> MaybeT Cli (String, Bool)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT Cli (Maybe (String, Bool))
Cli.getLatestFile
                Maybe (UnisonFile Symbol Ann)
pf <- Cli (Maybe (UnisonFile Symbol Ann))
-> MaybeT Cli (Maybe (UnisonFile Symbol Ann))
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Cli (Maybe (UnisonFile Symbol Ann))
Cli.getLatestParsedFile
                Maybe (TypecheckedUnisonFile Symbol Ann)
tf <- Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> MaybeT Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
Cli.getLatestTypecheckedFile
                Names
names <- Cli Names -> MaybeT Cli Names
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Cli Names
Cli.currentNames
                let buildPPED :: Maybe (UnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Cli PrettyPrintEnvDecl
buildPPED Maybe (UnisonFile Symbol Ann)
uf Maybe (TypecheckedUnisonFile Symbol Ann)
tf =
                      let names' :: Names
names' = (Names -> Maybe Names -> Names
forall a. a -> Maybe a -> a
fromMaybe Names
forall a. Monoid a => a
mempty (Maybe Names -> Names) -> Maybe Names -> Names
forall a b. (a -> b) -> a -> b
$ (TypecheckedUnisonFile Symbol Ann -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names
UF.typecheckedToNames (TypecheckedUnisonFile Symbol Ann -> Names)
-> Maybe (TypecheckedUnisonFile Symbol Ann) -> Maybe Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TypecheckedUnisonFile Symbol Ann)
tf) Maybe Names -> Maybe Names -> Maybe Names
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UnisonFile Symbol Ann -> Names
forall v a. Var v => UnisonFile v a -> Names
UF.toNames (UnisonFile Symbol Ann -> Names)
-> Maybe (UnisonFile Symbol Ann) -> Maybe Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (UnisonFile Symbol Ann)
uf)) Names -> Names -> Names
`Names.shadowing` Names
names
                       in PrettyPrintEnvDecl -> Cli PrettyPrintEnvDecl
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names') (Names -> Suffixifier
PPE.suffixifyByHashName Names
names'))
                let formatWidth :: Int
formatWidth = Int
80
                Absolute
currentPath <- Cli Absolute -> MaybeT Cli Absolute
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Cli Absolute -> MaybeT Cli Absolute)
-> Cli Absolute -> MaybeT Cli Absolute
forall a b. (a -> b) -> a -> b
$ Cli Absolute
Cli.getCurrentPath
                [TextReplacement]
updates <- Cli (Maybe [TextReplacement]) -> MaybeT Cli [TextReplacement]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Cli (Maybe [TextReplacement]) -> MaybeT Cli [TextReplacement])
-> Cli (Maybe [TextReplacement]) -> MaybeT Cli [TextReplacement]
forall a b. (a -> b) -> a -> b
$ (Maybe (UnisonFile Symbol Ann)
 -> Maybe (TypecheckedUnisonFile Symbol Ann)
 -> Cli PrettyPrintEnvDecl)
-> Int
-> Absolute
-> Maybe (UnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Maybe (Set Range)
-> Cli (Maybe [TextReplacement])
forall (m :: * -> *).
Monad m =>
(Maybe (UnisonFile Symbol Ann)
 -> Maybe (TypecheckedUnisonFile Symbol Ann)
 -> m PrettyPrintEnvDecl)
-> Int
-> Absolute
-> Maybe (UnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Maybe (Set Range)
-> m (Maybe [TextReplacement])
Format.formatFile Maybe (UnisonFile Symbol Ann)
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Cli PrettyPrintEnvDecl
buildPPED Int
formatWidth Absolute
currentPath Maybe (UnisonFile Symbol Ann)
pf Maybe (TypecheckedUnisonFile Symbol Ann)
tf Maybe (Set Range)
forall a. Maybe a
Nothing
                Text
source <-
                  IO LoadSourceResult -> MaybeT Cli LoadSourceResult
forall a. IO a -> MaybeT Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Env
env.loadSource (String -> Text
Text.pack String
filePath)) MaybeT Cli LoadSourceResult
-> (LoadSourceResult -> MaybeT Cli Text) -> MaybeT Cli Text
forall a b. MaybeT Cli a -> (a -> MaybeT Cli b) -> MaybeT Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    LoadSourceResult
Cli.InvalidSourceNameError -> Cli Text -> MaybeT Cli Text
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Cli Text -> MaybeT Cli Text) -> Cli Text -> MaybeT Cli Text
forall a b. (a -> b) -> a -> b
$ Output -> Cli Text
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli Text) -> Output -> Cli Text
forall a b. (a -> b) -> a -> b
$ String -> Output
Output.InvalidSourceName String
filePath
                    LoadSourceResult
Cli.LoadError -> Cli Text -> MaybeT Cli Text
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Cli Text -> MaybeT Cli Text) -> Cli Text -> MaybeT Cli Text
forall a b. (a -> b) -> a -> b
$ Output -> Cli Text
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli Text) -> Output -> Cli Text
forall a b. (a -> b) -> a -> b
$ String -> Output
Output.SourceLoadFailed String
filePath
                    Cli.LoadSuccess Text
contents -> Text -> MaybeT Cli Text
forall a. a -> MaybeT Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
contents
                let updatedSource :: Text
updatedSource = [TextReplacement] -> Text -> Text
Format.applyTextReplacements [TextReplacement]
updates Text
source
                IO () -> MaybeT Cli ()
forall a. IO a -> MaybeT Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT Cli ()) -> IO () -> MaybeT Cli ()
forall a b. (a -> b) -> a -> b
$ Env
env.writeSource (String -> Text
Text.pack String
filePath) Text
updatedSource Bool
True
            Input
DebugDumpNamespacesI -> do
              let seen :: a -> m Bool
seen a
h = (Set a -> Bool) -> m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
h)
                  set :: a -> m ()
set a
h = (Set a -> Set a) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
h)
                  getCausal :: Branch m -> (CausalHash, f (UnwrappedBranch m))
getCausal Branch m
b = (Branch m -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch m
b, UnwrappedBranch m -> f (UnwrappedBranch m)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnwrappedBranch m -> f (UnwrappedBranch m))
-> UnwrappedBranch m -> f (UnwrappedBranch m)
forall a b. (a -> b) -> a -> b
$ Branch m -> UnwrappedBranch m
forall (m :: * -> *). Branch m -> UnwrappedBranch m
Branch._history Branch m
b)
                  goCausal :: forall m. (Monad m) => [(CausalHash, m (Branch.UnwrappedBranch m))] -> StateT (Set CausalHash) m ()
                  goCausal :: forall (m :: * -> *).
Monad m =>
[(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
goCausal [] = () -> StateT (Set CausalHash) m ()
forall a. a -> StateT (Set CausalHash) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  goCausal ((CausalHash
h, m (UnwrappedBranch m)
mc) : [(CausalHash, m (UnwrappedBranch m))]
queue) = do
                    StateT (Set CausalHash) m Bool
-> StateT (Set CausalHash) m ()
-> StateT (Set CausalHash) m ()
-> StateT (Set CausalHash) m ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (CausalHash -> StateT (Set CausalHash) m Bool
forall {a} {m :: * -> *}.
(MonadState (Set a) m, Ord a) =>
a -> m Bool
seen CausalHash
h) ([(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
forall (m :: * -> *).
Monad m =>
[(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
goCausal [(CausalHash, m (UnwrappedBranch m))]
queue) do
                      m (UnwrappedBranch m)
-> StateT (Set CausalHash) m (UnwrappedBranch m)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Set CausalHash) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (UnwrappedBranch m)
mc StateT (Set CausalHash) m (UnwrappedBranch m)
-> (UnwrappedBranch m -> StateT (Set CausalHash) m ())
-> StateT (Set CausalHash) m ()
forall a b.
StateT (Set CausalHash) m a
-> (a -> StateT (Set CausalHash) m b)
-> StateT (Set CausalHash) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Causal.One CausalHash
h HashFor (Branch0 m)
_bh Branch0 m
b -> CausalHash
-> Branch0 m
-> [CausalHash]
-> [(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
forall (m :: * -> *).
Monad m =>
CausalHash
-> Branch0 m
-> [CausalHash]
-> [(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
goBranch CausalHash
h Branch0 m
b [CausalHash]
forall a. Monoid a => a
mempty [(CausalHash, m (UnwrappedBranch m))]
queue
                        Causal.Cons CausalHash
h HashFor (Branch0 m)
_bh Branch0 m
b (CausalHash, m (UnwrappedBranch m))
tail -> CausalHash
-> Branch0 m
-> [CausalHash]
-> [(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
forall (m :: * -> *).
Monad m =>
CausalHash
-> Branch0 m
-> [CausalHash]
-> [(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
goBranch CausalHash
h Branch0 m
b [(CausalHash, m (UnwrappedBranch m)) -> CausalHash
forall a b. (a, b) -> a
fst (CausalHash, m (UnwrappedBranch m))
tail] ((CausalHash, m (UnwrappedBranch m))
tail (CausalHash, m (UnwrappedBranch m))
-> [(CausalHash, m (UnwrappedBranch m))]
-> [(CausalHash, m (UnwrappedBranch m))]
forall a. a -> [a] -> [a]
: [(CausalHash, m (UnwrappedBranch m))]
queue)
                        Causal.Merge CausalHash
h HashFor (Branch0 m)
_bh Branch0 m
b (Map CausalHash (m (UnwrappedBranch m))
-> [(CausalHash, m (UnwrappedBranch m))]
forall k a. Map k a -> [(k, a)]
Map.toList -> [(CausalHash, m (UnwrappedBranch m))]
tails) -> CausalHash
-> Branch0 m
-> [CausalHash]
-> [(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
forall (m :: * -> *).
Monad m =>
CausalHash
-> Branch0 m
-> [CausalHash]
-> [(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
goBranch CausalHash
h Branch0 m
b (((CausalHash, m (UnwrappedBranch m)) -> CausalHash)
-> [(CausalHash, m (UnwrappedBranch m))] -> [CausalHash]
forall a b. (a -> b) -> [a] -> [b]
map (CausalHash, m (UnwrappedBranch m)) -> CausalHash
forall a b. (a, b) -> a
fst [(CausalHash, m (UnwrappedBranch m))]
tails) ([(CausalHash, m (UnwrappedBranch m))]
tails [(CausalHash, m (UnwrappedBranch m))]
-> [(CausalHash, m (UnwrappedBranch m))]
-> [(CausalHash, m (UnwrappedBranch m))]
forall a. [a] -> [a] -> [a]
++ [(CausalHash, m (UnwrappedBranch m))]
queue)
                  goBranch :: forall m. (Monad m) => CausalHash -> Branch0 m -> [CausalHash] -> [(CausalHash, m (Branch.UnwrappedBranch m))] -> StateT (Set CausalHash) m ()
                  goBranch :: forall (m :: * -> *).
Monad m =>
CausalHash
-> Branch0 m
-> [CausalHash]
-> [(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
goBranch CausalHash
h Branch0 m
b ([CausalHash] -> Set CausalHash
forall a. Ord a => [a] -> Set a
Set.fromList -> Set CausalHash
causalParents) [(CausalHash, m (UnwrappedBranch m))]
queue =
                    let ignoreMetadata :: (Ord r, Ord n) => Metadata.Star r n -> r -> (r, Set n)
                        ignoreMetadata :: forall r n. (Ord r, Ord n) => Star r n -> r -> (r, Set n)
ignoreMetadata Star r n
s r
r =
                          (r
r, r -> Relation r n -> Set n
forall a b. Ord a => a -> Relation a b -> Set b
R.lookupDom r
r (Relation r n -> Set n) -> Relation r n -> Set n
forall a b. (a -> b) -> a -> b
$ Star r n -> Relation r n
forall fact d1 d2. Star2 fact d1 d2 -> Relation fact d1
Star2.d1 Star r n
s)
                        terms :: Map Referent (Set NameSegment)
terms = [(Referent, Set NameSegment)] -> Map Referent (Set NameSegment)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Referent, Set NameSegment)] -> Map Referent (Set NameSegment))
-> (Set Referent -> [(Referent, Set NameSegment)])
-> Set Referent
-> Map Referent (Set NameSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Referent -> (Referent, Set NameSegment))
-> [Referent] -> [(Referent, Set NameSegment)]
forall a b. (a -> b) -> [a] -> [b]
map (Star Referent NameSegment
-> Referent -> (Referent, Set NameSegment)
forall r n. (Ord r, Ord n) => Star r n -> r -> (r, Set n)
ignoreMetadata (Branch0 m
b Branch0 m
-> Getting
     (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
-> Star Referent NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.terms)) ([Referent] -> [(Referent, Set NameSegment)])
-> (Set Referent -> [Referent])
-> Set Referent
-> [(Referent, Set NameSegment)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Referent -> [Referent]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Set Referent -> Map Referent (Set NameSegment))
-> Set Referent -> Map Referent (Set NameSegment)
forall a b. (a -> b) -> a -> b
$ Star Referent NameSegment -> Set Referent
forall fact d1 d2. Star2 fact d1 d2 -> Set fact
Star2.fact (Branch0 m
b Branch0 m
-> Getting
     (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
-> Star Referent NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Referent NameSegment) (Branch0 m) (Star Referent NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Referent NameSegment -> f (Star Referent NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.terms)
                        types :: Map Reference (Set NameSegment)
types = [(Reference, Set NameSegment)] -> Map Reference (Set NameSegment)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, Set NameSegment)] -> Map Reference (Set NameSegment))
-> (Set Reference -> [(Reference, Set NameSegment)])
-> Set Reference
-> Map Reference (Set NameSegment)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> (Reference, Set NameSegment))
-> [Reference] -> [(Reference, Set NameSegment)]
forall a b. (a -> b) -> [a] -> [b]
map (Star Reference NameSegment
-> Reference -> (Reference, Set NameSegment)
forall r n. (Ord r, Ord n) => Star r n -> r -> (r, Set n)
ignoreMetadata (Branch0 m
b Branch0 m
-> Getting
     (Star Reference NameSegment)
     (Branch0 m)
     (Star Reference NameSegment)
-> Star Reference NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Reference NameSegment)
  (Branch0 m)
  (Star Reference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Reference NameSegment -> f (Star Reference NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.types)) ([Reference] -> [(Reference, Set NameSegment)])
-> (Set Reference -> [Reference])
-> Set Reference
-> [(Reference, Set NameSegment)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Reference -> [Reference]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Set Reference -> Map Reference (Set NameSegment))
-> Set Reference -> Map Reference (Set NameSegment)
forall a b. (a -> b) -> a -> b
$ Star Reference NameSegment -> Set Reference
forall fact d1 d2. Star2 fact d1 d2 -> Set fact
Star2.fact (Branch0 m
b Branch0 m
-> Getting
     (Star Reference NameSegment)
     (Branch0 m)
     (Star Reference NameSegment)
-> Star Reference NameSegment
forall s a. s -> Getting a s a -> a
^. Getting
  (Star Reference NameSegment)
  (Branch0 m)
  (Star Reference NameSegment)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Star Reference NameSegment -> f (Star Reference NameSegment))
-> Branch0 m -> f (Branch0 m)
Branch.types)
                        patches :: Map NameSegment PatchHash
patches = ((PatchHash, m Patch) -> PatchHash)
-> Map NameSegment (PatchHash, m Patch)
-> Map NameSegment PatchHash
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatchHash, m Patch) -> PatchHash
forall a b. (a, b) -> a
fst (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (PatchHash, m Patch))
     (Branch0 m)
     (Map NameSegment (PatchHash, m Patch))
-> Map NameSegment (PatchHash, m Patch)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (PatchHash, m Patch))
  (Branch0 m)
  (Map NameSegment (PatchHash, m Patch))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (PatchHash, m Patch)
 -> f (Map NameSegment (PatchHash, m Patch)))
-> Branch0 m -> f (Branch0 m)
Branch.edits)
                        children :: Map NameSegment CausalHash
children = (Branch m -> CausalHash)
-> Map NameSegment (Branch m) -> Map NameSegment CausalHash
forall a b. (a -> b) -> Map NameSegment a -> Map NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Branch m -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 m)
  (Map NameSegment (Branch m))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children)
                     in do
                          let d :: DumpNamespace
d = Map Referent (Set NameSegment)
-> Map Reference (Set NameSegment)
-> Map NameSegment PatchHash
-> Map NameSegment CausalHash
-> Set CausalHash
-> DumpNamespace
Output.DN.DumpNamespace Map Referent (Set NameSegment)
terms Map Reference (Set NameSegment)
types Map NameSegment PatchHash
patches Map NameSegment CausalHash
children Set CausalHash
causalParents
                          -- the alternate implementation that doesn't rely on `traceM` blows up
                          String -> StateT (Set CausalHash) m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM (String -> StateT (Set CausalHash) m ())
-> String -> StateT (Set CausalHash) m ()
forall a b. (a -> b) -> a -> b
$ Width -> Error -> String
P.toPlain Width
200 ((CausalHash, DumpNamespace) -> Error
forall {s} {a}.
(Item s ~ Char, IsString s, ListLike s Char, Show a) =>
(a, DumpNamespace) -> Pretty s
prettyDump (CausalHash
h, DumpNamespace
d))
                          CausalHash -> StateT (Set CausalHash) m ()
forall {a} {m :: * -> *}.
(MonadState (Set a) m, Ord a) =>
a -> m ()
set CausalHash
h
                          [(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
forall (m :: * -> *).
Monad m =>
[(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
goCausal ((Branch m -> (CausalHash, m (UnwrappedBranch m)))
-> [Branch m] -> [(CausalHash, m (UnwrappedBranch m))]
forall a b. (a -> b) -> [a] -> [b]
map Branch m -> (CausalHash, m (UnwrappedBranch m))
forall {f :: * -> *} {m :: * -> *}.
Applicative f =>
Branch m -> (CausalHash, f (UnwrappedBranch m))
getCausal (Map NameSegment (Branch m) -> [Branch m]
forall a. Map NameSegment a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Branch0 m
b Branch0 m
-> Getting
     (Map NameSegment (Branch m))
     (Branch0 m)
     (Map NameSegment (Branch m))
-> Map NameSegment (Branch m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NameSegment (Branch m))
  (Branch0 m)
  (Map NameSegment (Branch m))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children)) [(CausalHash, m (UnwrappedBranch m))]
-> [(CausalHash, m (UnwrappedBranch m))]
-> [(CausalHash, m (UnwrappedBranch m))]
forall a. [a] -> [a] -> [a]
++ [(CausalHash, m (UnwrappedBranch m))]
queue)
                  prettyDump :: (a, DumpNamespace) -> Pretty s
prettyDump (a
h, Output.DN.DumpNamespace Map Referent (Set NameSegment)
terms Map Reference (Set NameSegment)
types Map NameSegment PatchHash
patches Map NameSegment CausalHash
children Set CausalHash
causalParents) =
                    s -> Pretty s
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit s
"Namespace "
                      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> a -> Pretty s
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown a
h
                      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline
                      Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> ( Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$
                             [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.linesNonEmpty
                               [ Bool -> Pretty s -> Pretty s
forall a. Monoid a => Bool -> a -> a
Monoid.unlessM (Set CausalHash -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set CausalHash
causalParents) (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ s -> Pretty s
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit s
"Causal Parents:" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ((CausalHash -> Pretty s) -> [CausalHash] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
map CausalHash -> Pretty s
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown ([CausalHash] -> [Pretty s]) -> [CausalHash] -> [Pretty s]
forall a b. (a -> b) -> a -> b
$ Set CausalHash -> [CausalHash]
forall a. Set a -> [a]
Set.toList Set CausalHash
causalParents)),
                                 Bool -> Pretty s -> Pretty s
forall a. Monoid a => Bool -> a -> a
Monoid.unlessM (Map Referent (Set NameSegment) -> Bool
forall a. Map Referent a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Referent (Set NameSegment)
terms) (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ s -> Pretty s
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit s
"Terms:" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (((Referent, Set NameSegment) -> Pretty s)
-> [(Referent, Set NameSegment)] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
map ((Referent -> Text) -> (Referent, Set NameSegment) -> Pretty s
forall {s} {t :: * -> *} {t}.
(Item s ~ Char, Foldable t, IsString s, ListLike s Char) =>
(t -> Text) -> (t, t NameSegment) -> Pretty s
prettyDefn Referent -> Text
Referent.toText) ([(Referent, Set NameSegment)] -> [Pretty s])
-> [(Referent, Set NameSegment)] -> [Pretty s]
forall a b. (a -> b) -> a -> b
$ Map Referent (Set NameSegment) -> [(Referent, Set NameSegment)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Referent (Set NameSegment)
terms)),
                                 Bool -> Pretty s -> Pretty s
forall a. Monoid a => Bool -> a -> a
Monoid.unlessM (Map Reference (Set NameSegment) -> Bool
forall a. Map Reference a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Reference (Set NameSegment)
types) (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ s -> Pretty s
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit s
"Types:" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (((Reference, Set NameSegment) -> Pretty s)
-> [(Reference, Set NameSegment)] -> [Pretty s]
forall a b. (a -> b) -> [a] -> [b]
map ((Reference -> Text) -> (Reference, Set NameSegment) -> Pretty s
forall {s} {t :: * -> *} {t}.
(Item s ~ Char, Foldable t, IsString s, ListLike s Char) =>
(t -> Text) -> (t, t NameSegment) -> Pretty s
prettyDefn Reference -> Text
Reference.toText) ([(Reference, Set NameSegment)] -> [Pretty s])
-> [(Reference, Set NameSegment)] -> [Pretty s]
forall a b. (a -> b) -> a -> b
$ Map Reference (Set NameSegment) -> [(Reference, Set NameSegment)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Reference (Set NameSegment)
types)),
                                 Bool -> Pretty s -> Pretty s
forall a. Monoid a => Bool -> a -> a
Monoid.unlessM (Map NameSegment PatchHash -> Bool
forall a. Map NameSegment a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map NameSegment PatchHash
patches) (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ s -> Pretty s
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit s
"Patches:" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([(Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 (((NameSegment, PatchHash) -> (Pretty s, Pretty s))
-> [(NameSegment, PatchHash)] -> [(Pretty s, Pretty s)]
forall a b. (a -> b) -> [a] -> [b]
map ((NameSegment -> Pretty s)
-> (PatchHash -> Pretty s)
-> (NameSegment, PatchHash)
-> (Pretty s, Pretty s)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> Pretty s
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty s)
-> (NameSegment -> Text) -> NameSegment -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toEscapedText) PatchHash -> Pretty s
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown) ([(NameSegment, PatchHash)] -> [(Pretty s, Pretty s)])
-> [(NameSegment, PatchHash)] -> [(Pretty s, Pretty s)]
forall a b. (a -> b) -> a -> b
$ Map NameSegment PatchHash -> [(NameSegment, PatchHash)]
forall k a. Map k a -> [(k, a)]
Map.toList Map NameSegment PatchHash
patches)),
                                 Bool -> Pretty s -> Pretty s
forall a. Monoid a => Bool -> a -> a
Monoid.unlessM (Map NameSegment CausalHash -> Bool
forall a. Map NameSegment a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map NameSegment CausalHash
children) (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ s -> Pretty s
forall s. (IsString s, ListLike s Char) => s -> Pretty s
P.lit s
"Children:" Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 ([(Pretty s, Pretty s)] -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 (((NameSegment, CausalHash) -> (Pretty s, Pretty s))
-> [(NameSegment, CausalHash)] -> [(Pretty s, Pretty s)]
forall a b. (a -> b) -> [a] -> [b]
map ((NameSegment -> Pretty s)
-> (CausalHash -> Pretty s)
-> (NameSegment, CausalHash)
-> (Pretty s, Pretty s)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> Pretty s
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty s)
-> (NameSegment -> Text) -> NameSegment -> Pretty s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toEscapedText) CausalHash -> Pretty s
forall a s. (Show a, IsString s) => a -> Pretty s
P.shown) ([(NameSegment, CausalHash)] -> [(Pretty s, Pretty s)])
-> [(NameSegment, CausalHash)] -> [(Pretty s, Pretty s)]
forall a b. (a -> b) -> a -> b
$ Map NameSegment CausalHash -> [(NameSegment, CausalHash)]
forall k a. Map k a -> [(k, a)]
Map.toList Map NameSegment CausalHash
children))
                               ]
                         )
                    where
                      prettyRef :: (t -> Text) -> t -> Pretty s
prettyRef t -> Text
renderR t
r = Width -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$ Text -> Pretty s
forall s. IsString s => Text -> Pretty s
P.text (t -> Text
renderR t
r)
                      prettyDefn :: (t -> Text) -> (t, t NameSegment) -> Pretty s
prettyDefn t -> Text
renderR (t
r, t NameSegment -> [NameSegment]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList -> [NameSegment]
names) =
                        [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines (Text -> Pretty s
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty s) -> [Text] -> [Pretty s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if [NameSegment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NameSegment]
names then [Text
"<unnamed>"] else NameSegment -> Text
NameSegment.toEscapedText (NameSegment -> Text) -> [NameSegment] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NameSegment]
names) Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
forall s. IsString s => Pretty s
P.newline Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> (t -> Text) -> t -> Pretty s
forall {s} {t}.
(Item s ~ Char, ListLike s Char, IsString s) =>
(t -> Text) -> t -> Pretty s
prettyRef t -> Text
renderR t
r
              Branch IO
projectRoot <- Cli (Branch IO)
Cli.getCurrentProjectRoot
              Cli (Set CausalHash) -> Cli ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Cli (Set CausalHash) -> Cli ())
-> (StateT (Set CausalHash) IO () -> Cli (Set CausalHash))
-> StateT (Set CausalHash) IO ()
-> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Set CausalHash) -> Cli (Set CausalHash)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Set CausalHash) -> Cli (Set CausalHash))
-> (StateT (Set CausalHash) IO () -> IO (Set CausalHash))
-> StateT (Set CausalHash) IO ()
-> Cli (Set CausalHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (Set CausalHash) IO ()
 -> Set CausalHash -> IO (Set CausalHash))
-> Set CausalHash
-> StateT (Set CausalHash) IO ()
-> IO (Set CausalHash)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Set CausalHash) IO ()
-> Set CausalHash -> IO (Set CausalHash)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
State.execStateT Set CausalHash
forall a. Monoid a => a
mempty (StateT (Set CausalHash) IO () -> Cli ())
-> StateT (Set CausalHash) IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$ [(CausalHash, IO (UnwrappedBranch IO))]
-> StateT (Set CausalHash) IO ()
forall (m :: * -> *).
Monad m =>
[(CausalHash, m (UnwrappedBranch m))]
-> StateT (Set CausalHash) m ()
goCausal [Branch IO -> (CausalHash, IO (UnwrappedBranch IO))
forall {f :: * -> *} {m :: * -> *}.
Applicative f =>
Branch m -> (CausalHash, f (UnwrappedBranch m))
getCausal Branch IO
projectRoot]
            Input
DebugDumpNamespaceSimpleI -> do
              Branch0 IO
projectRootBranch0 <- Cli (Branch0 IO)
Cli.getCurrentProjectRoot0
              [(Reference, Name)] -> ((Reference, Name) -> Cli ()) -> Cli ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Relation Reference Name -> [(Reference, Name)]
forall a b. Relation a b -> [(a, b)]
Relation.toList (Relation Reference Name -> [(Reference, Name)])
-> (Branch0 IO -> Relation Reference Name)
-> Branch0 IO
-> [(Reference, Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 IO -> Relation Reference Name
forall (m :: * -> *). Branch0 m -> Relation Reference Name
Branch.deepTypes (Branch0 IO -> [(Reference, Name)])
-> Branch0 IO -> [(Reference, Name)]
forall a b. (a -> b) -> a -> b
$ Branch0 IO
projectRootBranch0) \(Reference
r, Name
name) ->
                String -> Cli ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM (String -> Cli ()) -> String -> Cli ()
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Show a => a -> String
show Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",Type," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack (Reference -> Text
Reference.toText Reference
r)
              [(Referent, Name)] -> ((Referent, Name) -> Cli ()) -> Cli ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Relation Referent Name -> [(Referent, Name)]
forall a b. Relation a b -> [(a, b)]
Relation.toList (Relation Referent Name -> [(Referent, Name)])
-> (Branch0 IO -> Relation Referent Name)
-> Branch0 IO
-> [(Referent, Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 IO -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
Branch.deepTerms (Branch0 IO -> [(Referent, Name)])
-> Branch0 IO -> [(Referent, Name)]
forall a b. (a -> b) -> a -> b
$ Branch0 IO
projectRootBranch0) \(Referent
r, Name
name) ->
                String -> Cli ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM (String -> Cli ()) -> String -> Cli ()
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Show a => a -> String
show Name
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",Term," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack (Referent -> Text
Referent.toText Referent
r)
            DebugTermI Bool
isVerbose HashQualified Name
hqName -> Bool -> HashQualified Name -> Cli ()
DebugDefinition.debugTerm Bool
isVerbose HashQualified Name
hqName
            Input
DebugLSPFoldRangesI -> do
              Cli ()
DebugFoldRanges.debugFoldRanges
            DebugTypeI HashQualified Name
hqName -> HashQualified Name -> Cli ()
DebugDefinition.debugDecl HashQualified Name
hqName
            DebugClearWatchI {} ->
              Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction ()
Codebase.clearWatches
            DebugDoctorI {} -> do
              IntegrityResult
r <- Transaction IntegrityResult -> Cli IntegrityResult
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction IntegrityResult
IntegrityCheck.integrityCheckFullCodebase
              Output -> Cli ()
Cli.respond (IntegrityResult -> Output
IntegrityCheck IntegrityResult
r)
            DebugNameDiffI ShortCausalHash
fromSCH ShortCausalHash
toSCH -> do
              (Int
schLen, Set CausalHash
fromCHs, Set CausalHash
toCHs) <-
                Transaction (Int, Set CausalHash, Set CausalHash)
-> Cli (Int, Set CausalHash, Set CausalHash)
forall a. Transaction a -> Cli a
Cli.runTransaction do
                  Int
schLen <- Transaction Int
Codebase.branchHashLength
                  Set CausalHash
fromCHs <- ShortCausalHash -> Transaction (Set CausalHash)
Codebase.causalHashesByPrefix ShortCausalHash
fromSCH
                  Set CausalHash
toCHs <- ShortCausalHash -> Transaction (Set CausalHash)
Codebase.causalHashesByPrefix ShortCausalHash
toSCH
                  pure (Int
schLen, Set CausalHash
fromCHs, Set CausalHash
toCHs)
              (CausalHash
fromCH, CausalHash
toCH) <- case (Set CausalHash -> [CausalHash]
forall a. Set a -> [a]
Set.toList Set CausalHash
fromCHs, Set CausalHash -> [CausalHash]
forall a. Set a -> [a]
Set.toList Set CausalHash
toCHs) of
                ((CausalHash
_ : CausalHash
_ : [CausalHash]
_), [CausalHash]
_) -> Output -> Cli (CausalHash, CausalHash)
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli (CausalHash, CausalHash))
-> Output -> Cli (CausalHash, CausalHash)
forall a b. (a -> b) -> a -> b
$ ShortCausalHash -> Set ShortCausalHash -> Output
Output.BranchHashAmbiguous ShortCausalHash
fromSCH ((CausalHash -> ShortCausalHash)
-> Set CausalHash -> Set ShortCausalHash
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Int -> CausalHash -> ShortCausalHash
SCH.fromHash Int
schLen) Set CausalHash
fromCHs)
                ([], [CausalHash]
_) -> Output -> Cli (CausalHash, CausalHash)
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli (CausalHash, CausalHash))
-> Output -> Cli (CausalHash, CausalHash)
forall a b. (a -> b) -> a -> b
$ ShortCausalHash -> Output
Output.NoBranchWithHash ShortCausalHash
fromSCH
                ([CausalHash]
_, []) -> Output -> Cli (CausalHash, CausalHash)
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli (CausalHash, CausalHash))
-> Output -> Cli (CausalHash, CausalHash)
forall a b. (a -> b) -> a -> b
$ ShortCausalHash -> Output
Output.NoBranchWithHash ShortCausalHash
toSCH
                ([CausalHash]
_, (CausalHash
_ : CausalHash
_ : [CausalHash]
_)) -> Output -> Cli (CausalHash, CausalHash)
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli (CausalHash, CausalHash))
-> Output -> Cli (CausalHash, CausalHash)
forall a b. (a -> b) -> a -> b
$ ShortCausalHash -> Set ShortCausalHash -> Output
Output.BranchHashAmbiguous ShortCausalHash
toSCH ((CausalHash -> ShortCausalHash)
-> Set CausalHash -> Set ShortCausalHash
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Int -> CausalHash -> ShortCausalHash
SCH.fromHash Int
schLen) Set CausalHash
toCHs)
                ([CausalHash
fromCH], [CausalHash
toCH]) -> (CausalHash, CausalHash) -> Cli (CausalHash, CausalHash)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CausalHash
fromCH, CausalHash
toCH)
              Output
output <-
                Transaction Output -> Cli Output
forall a. Transaction a -> Cli a
Cli.runTransaction do
                  Branch Transaction
fromBranch <- CausalHash -> Transaction (CausalBranch Transaction)
Codebase.expectCausalBranchByCausalHash CausalHash
fromCH Transaction (CausalBranch Transaction)
-> (CausalBranch Transaction -> Transaction (Branch Transaction))
-> Transaction (Branch Transaction)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
V2Causal.value
                  Branch Transaction
toBranch <- CausalHash -> Transaction (CausalBranch Transaction)
Codebase.expectCausalBranchByCausalHash CausalHash
toCH Transaction (CausalBranch Transaction)
-> (CausalBranch Transaction -> Transaction (Branch Transaction))
-> Transaction (Branch Transaction)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
V2Causal.value
                  TreeDiff Transaction
treeDiff <- Branch Transaction
-> Branch Transaction -> Transaction (TreeDiff Transaction)
V2Branch.Diff.diffBranches Branch Transaction
fromBranch Branch Transaction
toBranch
                  NameChanges
nameChanges <- Maybe Name -> TreeDiff Transaction -> Transaction NameChanges
forall (m :: * -> *).
Monad m =>
Maybe Name -> TreeDiff m -> m NameChanges
V2Branch.Diff.allNameChanges Maybe Name
forall a. Maybe a
Nothing TreeDiff Transaction
treeDiff
                  pure (NameChanges -> Output
DisplayDebugNameDiff NameChanges
nameChanges)
              Output -> Cli ()
Cli.respond Output
output
            Input
UpdateBuiltinsI -> Output -> Cli ()
Cli.respond Output
NotImplemented
            Input
QuitI -> Cli ()
forall a. Cli a
Cli.haltRepl
            Input
AuthLoginI -> Cli UserInfo -> Cli ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Cli UserInfo -> Cli ()) -> Cli UserInfo -> Cli ()
forall a b. (a -> b) -> a -> b
$ CodeserverURI -> Cli UserInfo
authLogin (ShareCodeserver -> CodeserverURI
Codeserver.resolveCodeserver ShareCodeserver
RemoteRepo.DefaultCodeserver)
            Input
VersionI -> do
              Cli.Env {Text
ucmVersion :: Text
$sel:ucmVersion:Env :: Env -> Text
ucmVersion} <- 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
PrintVersion Text
ucmVersion
            ProjectRenameI ProjectName
name -> ProjectName -> Cli ()
handleProjectRename ProjectName
name
            ProjectSwitchI ProjectAndBranchNames
name -> ProjectAndBranchNames -> Cli ()
projectSwitch ProjectAndBranchNames
name
            ProjectCreateI Bool
tryDownloadingBase Maybe ProjectName
name -> Cli (ProjectAndBranch ProjectId ProjectBranchId) -> Cli ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Cli (ProjectAndBranch ProjectId ProjectBranchId) -> Cli ())
-> Cli (ProjectAndBranch ProjectId ProjectBranchId) -> Cli ()
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe ProjectName
-> Cli (ProjectAndBranch ProjectId ProjectBranchId)
projectCreate Bool
tryDownloadingBase Maybe ProjectName
name
            Input
ProjectsI -> Cli ()
handleProjects
            BranchI BranchSourceI
source UnresolvedProjectBranch
name -> BranchSourceI -> UnresolvedProjectBranch -> Cli ()
handleBranch BranchSourceI
source UnresolvedProjectBranch
name
            BranchRenameI ProjectBranchName
name -> ProjectBranchName -> Cli ()
handleBranchRename ProjectBranchName
name
            BranchesI Maybe ProjectName
name -> Maybe ProjectName -> Cli ()
handleBranches Maybe ProjectName
name
            CloneI ProjectAndBranchNames
remoteNames Maybe ProjectAndBranchNames
localNames -> ProjectAndBranchNames -> Maybe ProjectAndBranchNames -> Cli ()
handleClone ProjectAndBranchNames
remoteNames Maybe ProjectAndBranchNames
localNames
            ReleaseDraftI Semver
semver -> Semver -> Cli ()
handleReleaseDraft Semver
semver
            UpgradeI NameSegment
old NameSegment
new -> NameSegment -> NameSegment -> Cli ()
handleUpgrade NameSegment
old NameSegment
new
            Input
UpgradeCommitI -> Cli ()
handleCommitUpgrade
            LibInstallI Bool
remind ProjectAndBranch
  ProjectName (Maybe ProjectBranchNameOrLatestRelease)
libdep -> Bool
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
-> Cli ()
handleInstallLib Bool
remind ProjectAndBranch
  ProjectName (Maybe ProjectBranchNameOrLatestRelease)
libdep
            DebugSynhashTermI Name
name -> Name -> Cli ()
handleDebugSynhashTerm Name
name
            EditDependentsI HashQualified Name
name -> HashQualified Name -> Cli ()
handleEditDependents HashQualified Name
name

inputDescription :: Input -> Cli Text
inputDescription :: Input -> Cli Text
inputDescription Input
input =
  case Input
input of
    SaveExecuteResultI Name
_str -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"save-execute-result"
    ForkLocalBranchI BranchId2
src0 BranchRelativePath
dest0 -> do
      Text
src <- (ShortCausalHash -> Cli Text)
-> (BranchRelativePath -> Cli Text) -> BranchId2 -> Cli Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Cli Text)
-> (ShortCausalHash -> Text) -> ShortCausalHash -> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text)
-> (ShortCausalHash -> String) -> ShortCausalHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortCausalHash -> String
forall a. Show a => a -> String
show) BranchRelativePath -> Cli Text
brp BranchId2
src0
      Text
dest <- BranchRelativePath -> Cli Text
brp BranchRelativePath
dest0
      pure (Text
"fork " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dest)
    MergeLocalBranchI BranchRelativePath
src0 Maybe BranchRelativePath
dest0 MergeMode
mode -> do
      let src :: Text
src = forall target source. From source target => source -> target
into @Text BranchRelativePath
src0
      let dest :: Text
dest = Text
-> (BranchRelativePath -> Text) -> Maybe BranchRelativePath -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall target source. From source target => source -> target
into @Text) Maybe BranchRelativePath
dest0
      let command :: Text
command =
            case MergeMode
mode of
              MergeMode
Branch.RegularMerge -> Text
"merge"
              MergeMode
Branch.SquashMerge -> Text
"merge.squash"
      Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
command Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dest)
    ResetI BranchId2
newRoot Maybe UnresolvedProjectBranch
tgt -> do
      Text
hashTxt <- BranchId2 -> Cli Text
bid2 BranchId2
newRoot
      Text
tgt <- case Maybe UnresolvedProjectBranch
tgt of
        Maybe UnresolvedProjectBranch
Nothing -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
        Just UnresolvedProjectBranch
tgt -> do
          let tgtText :: Text
tgtText = forall target source. From source target => source -> target
into @Text UnresolvedProjectBranch
tgt
          Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tgtText)
      pure (Text
"reset " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hashTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tgt)
    AliasTermI Bool
force HashOrHQSplit'
src0 Split'
dest0 -> do
      Text
src <- HashOrHQSplit' -> Cli Text
hhqs' HashOrHQSplit'
src0
      Text
dest <- Split' -> Cli Text
ps' Split'
dest0
      pure ((if Bool
force then Text
"debug.alias.term.force " else Text
"alias.term ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dest)
    AliasTypeI Bool
force HashOrHQSplit'
src0 Split'
dest0 -> do
      Text
src <- HashOrHQSplit' -> Cli Text
hhqs' HashOrHQSplit'
src0
      Text
dest <- Split' -> Cli Text
ps' Split'
dest0
      pure ((if Bool
force then Text
"debug.alias.type.force " else Text
"alias.term ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dest)
    AliasManyI [HQSplit]
srcs0 Path'
dest0 -> do
      [Text]
srcs <- (HQSplit -> Cli Text) -> [HQSplit] -> Cli [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse HQSplit -> Cli Text
hqs [HQSplit]
srcs0
      Text
dest <- Path' -> Cli Text
p' Path'
dest0
      pure (Text
"alias.many " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" " [Text]
srcs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dest)
    MoveTermI HQSplit'
src0 Split'
dest0 -> do
      Text
src <- HQSplit' -> Cli Text
hqs' HQSplit'
src0
      Text
dest <- Split' -> Cli Text
ps' Split'
dest0
      pure (Text
"move.term " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dest)
    MoveTypeI HQSplit'
src0 Split'
dest0 -> do
      Text
src <- HQSplit' -> Cli Text
hqs' HQSplit'
src0
      Text
dest <- Split' -> Cli Text
ps' Split'
dest0
      pure (Text
"move.type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dest)
    MoveBranchI Path'
src0 Path'
dest0 -> do
      Text
src <- Path' -> Cli Text
p' Path'
src0
      Text
dest <- Path' -> Cli Text
p' Path'
dest0
      pure (Text
"move.namespace " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dest)
    MoveAllI Path'
src0 Path'
dest0 -> do
      Text
src <- Path' -> Cli Text
p' Path'
src0
      Text
dest <- Path' -> Cli Text
p' Path'
dest0
      pure (Text
"move " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dest)
    DeleteI DeleteTarget
dtarget -> do
      case DeleteTarget
dtarget of
        DeleteTarget'TermOrType DeleteOutput
DeleteOutput'NoDiff [HQSplit']
things0 -> do
          [Text]
thing <- (HQSplit' -> Cli Text) -> [HQSplit'] -> Cli [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse HQSplit' -> Cli Text
hqs' [HQSplit']
things0
          pure (Text
"delete " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" " [Text]
thing)
        DeleteTarget'TermOrType DeleteOutput
DeleteOutput'Diff [HQSplit']
things0 -> do
          [Text]
thing <- (HQSplit' -> Cli Text) -> [HQSplit'] -> Cli [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse HQSplit' -> Cli Text
hqs' [HQSplit']
things0
          pure (Text
"delete.verbose " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" " [Text]
thing)
        DeleteTarget'Term DeleteOutput
DeleteOutput'NoDiff [HQSplit']
things0 -> do
          [Text]
thing <- (HQSplit' -> Cli Text) -> [HQSplit'] -> Cli [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse HQSplit' -> Cli Text
hqs' [HQSplit']
things0
          pure (Text
"delete.term " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" " [Text]
thing)
        DeleteTarget'Term DeleteOutput
DeleteOutput'Diff [HQSplit']
things0 -> do
          [Text]
thing <- (HQSplit' -> Cli Text) -> [HQSplit'] -> Cli [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse HQSplit' -> Cli Text
hqs' [HQSplit']
things0
          pure (Text
"delete.term.verbose " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" " [Text]
thing)
        DeleteTarget'Type DeleteOutput
DeleteOutput'NoDiff [HQSplit']
thing0 -> do
          [Text]
thing <- (HQSplit' -> Cli Text) -> [HQSplit'] -> Cli [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse HQSplit' -> Cli Text
hqs' [HQSplit']
thing0
          pure (Text
"delete.type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" " [Text]
thing)
        DeleteTarget'Type DeleteOutput
DeleteOutput'Diff [HQSplit']
thing0 -> do
          [Text]
thing <- (HQSplit' -> Cli Text) -> [HQSplit'] -> Cli [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse HQSplit' -> Cli Text
hqs' [HQSplit']
thing0
          pure (Text
"delete.type.verbose " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" " [Text]
thing)
        DeleteTarget'Namespace Insistence
Try Maybe Split
opath0 -> do
          Text
opath <- Maybe Split -> Cli Text
ops Maybe Split
opath0
          pure (Text
"delete.namespace " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opath)
        DeleteTarget'Namespace Insistence
Force Maybe Split
opath0 -> do
          Text
opath <- Maybe Split -> Cli Text
ops Maybe Split
opath0
          pure (Text
"delete.namespace.force " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opath)
        DeleteTarget'ProjectBranch UnresolvedProjectBranch
_ -> Cli Text
wat
        DeleteTarget'Project ProjectName
_ -> Cli Text
wat
    AddI Set Name
_selection -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"add"
    UpdateI OptionalPatch
p0 Set Name
_selection -> do
      Text
p <-
        case OptionalPatch
p0 of
          OptionalPatch
NoPatch -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
".nopatch"
          OptionalPatch
DefaultPatch -> (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Cli Text -> Cli Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Split' -> Cli Text
ps' Split'
Cli.defaultPatchPath
          UsePatch Split'
p0 -> (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Cli Text -> Cli Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Split' -> Cli Text
ps' Split'
p0
      pure (Text
"update.old" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p)
    Input
Update2I -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"update")
    UndoI {} -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"undo"
    ExecuteI HashQualified Name
s [String]
args -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"execute " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.unwords (HashQualified Name -> Text
HQ.toText HashQualified Name
s Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack [String]
args))
    IOTestI Bool
native HashQualified Name
hq -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Text
HQ.toText HashQualified Name
hq)
      where
        cmd :: Text
cmd | Bool
native = Text
"io.test.native " | Bool
otherwise = Text
"io.test "
    IOTestAllI Bool
native ->
      Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if Bool
native then Text
"io.test.native.all" else Text
"io.test.all")
    Input
UpdateBuiltinsI -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"builtins.update"
    MergeBuiltinsI Maybe Path
Nothing -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"builtins.merge"
    MergeBuiltinsI (Just Path
path) -> (Text
"builtins.merge " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Cli Text -> Cli Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> Cli Text
p Path
path
    MergeIOBuiltinsI Maybe Path
Nothing -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"builtins.mergeio"
    MergeIOBuiltinsI (Just Path
path) -> (Text
"builtins.mergeio " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Cli Text -> Cli Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> Cli Text
p Path
path
    MakeStandaloneI String
out HashQualified Name
nm -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"compile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
out Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Text
HQ.toText HashQualified Name
nm)
    ExecuteSchemeI HashQualified Name
nm [String]
args ->
      Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Cli Text) -> Text -> Cli Text
forall a b. (a -> b) -> a -> b
$ Text
"run.native " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.unwords (HashQualified Name -> Text
HQ.toText HashQualified Name
nm Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack [String]
args)
    CompileSchemeI Bool
pr Text
fi HashQualified Name
nm ->
      Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"compile.native " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Text
HQ.toText HashQualified Name
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fi Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
pr then Text
" profile" else Text
"")
    CreateAuthorI NameSegment
id Text
name -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"create.author " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NameSegment -> Text
NameSegment.toEscapedText NameSegment
id Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)
    ClearI {} -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"clear"
    DocToMarkdownI Name
name -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"debug.doc-to-markdown " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText Name
name)
    DebugTermI Bool
verbose HashQualified Name
hqName ->
      if Bool
verbose
        then Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"debug.term.verbose " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Text
HQ.toText HashQualified Name
hqName)
        else Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"debug.term " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Text
HQ.toText HashQualified Name
hqName)
    DebugTypeI HashQualified Name
hqName -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"debug.type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> Text
HQ.toText HashQualified Name
hqName)
    Input
DebugLSPFoldRangesI -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"debug.lsp.fold-ranges"
    DebugFuzzyOptionsI String
cmd [String]
input -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Cli Text) -> (String -> Text) -> String -> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Cli Text) -> String -> Cli Text
forall a b. (a -> b) -> a -> b
$ String
"debug.fuzzy-completions " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords (String
cmd String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [String]
input)
    Input
DebugFormatI -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"debug.format"
    EditNamespaceI [Path]
paths ->
      Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Cli Text) -> Text -> Cli Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords (Text
"edit.namespace" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Path -> Text
Path.toText (Path -> Text) -> [Path] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path]
paths))
    -- wat land
    Input
ApiI -> Cli Text
wat
    AuthLoginI {} -> Cli Text
wat
    BranchI {} -> Cli Text
wat
    BranchRenameI {} -> Cli Text
wat
    BranchesI {} -> Cli Text
wat
    CloneI {} -> Cli Text
wat
    CreateMessage {} -> Cli Text
wat
    DebugClearWatchI {} -> Cli Text
wat
    DebugDoctorI {} -> Cli Text
wat
    DebugDumpNamespaceSimpleI {} -> Cli Text
wat
    DebugDumpNamespacesI {} -> Cli Text
wat
    DebugLSPNameCompletionI {} -> Cli Text
wat
    DebugNameDiffI {} -> Cli Text
wat
    DebugNumberedArgsI {} -> Cli Text
wat
    DebugSynhashTermI {} -> Cli Text
wat
    DebugTabCompletionI {} -> Cli Text
wat
    DebugTypecheckedUnisonFileI {} -> Cli Text
wat
    DiffNamespaceI {} -> Cli Text
wat
    DisplayI {} -> Cli Text
wat
    DocsI {} -> Cli Text
wat
    DocsToHtmlI {} -> Cli Text
wat
    EditDependentsI {} -> Cli Text
wat
    FindI {} -> Cli Text
wat
    FindShallowI {} -> Cli Text
wat
    HistoryI {} -> Cli Text
wat
    LibInstallI {} -> Cli Text
wat
    ListDependenciesI {} -> Cli Text
wat
    ListDependentsI {} -> Cli Text
wat
    LoadI {} -> Cli Text
wat
    MergeCommitI {} -> Cli Text
wat
    MergeI {} -> Cli Text
wat
    NamesI {} -> Cli Text
wat
    NamespaceDependenciesI {} -> Cli Text
wat
    PopBranchI {} -> Cli Text
wat
    PreviewAddI {} -> Cli Text
wat
    PreviewMergeLocalBranchI {} -> Cli Text
wat
    PreviewUpdateI {} -> Cli Text
wat
    ProjectCreateI {} -> Cli Text
wat
    ProjectRenameI {} -> Cli Text
wat
    ProjectSwitchI {} -> Cli Text
wat
    Input
ProjectsI -> Cli Text
wat
    PullI {} -> Cli Text
wat
    PushRemoteBranchI {} -> Cli Text
wat
    QuitI {} -> Cli Text
wat
    ReleaseDraftI {} -> Cli Text
wat
    ShowDefinitionI {} -> Cli Text
wat
    StructuredFindI {} -> Cli Text
wat
    StructuredFindReplaceI {} -> Cli Text
wat
    TextFindI {} -> Cli Text
wat
    ShowRootReflogI {} -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"deprecated.root-reflog"
    ShowGlobalReflogI {} -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"reflog.global"
    ShowProjectReflogI Maybe ProjectName
mayProjName -> do
      case Maybe ProjectName
mayProjName of
        Maybe ProjectName
Nothing -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"project.reflog"
        Just ProjectName
projName -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Cli Text) -> Text -> Cli Text
forall a b. (a -> b) -> a -> b
$ Text
"project.reflog" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text ProjectName
projName
    ShowProjectBranchReflogI Maybe UnresolvedProjectBranch
mayProjBranch -> do
      case Maybe UnresolvedProjectBranch
mayProjBranch of
        Maybe UnresolvedProjectBranch
Nothing -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"branch.reflog"
        Just (PP.ProjectAndBranch Maybe ProjectName
Nothing ProjectBranchName
branchName) -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Cli Text) -> Text -> Cli Text
forall a b. (a -> b) -> a -> b
$ Text
"branch.reflog" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text ProjectBranchName
branchName
        Just (PP.ProjectAndBranch (Just ProjectName
projName) ProjectBranchName
branchName) -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Cli Text) -> Text -> Cli Text
forall a b. (a -> b) -> a -> b
$ Text
"branch.reflog" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
PP.ProjectAndBranch ProjectName
projName ProjectBranchName
branchName)
    SwitchBranchI {} -> Cli Text
wat
    TestI {} -> Cli Text
wat
    TodoI {} -> Cli Text
wat
    UiI {} -> Cli Text
wat
    UpI {} -> Cli Text
wat
    UpgradeCommitI {} -> Cli Text
wat
    UpgradeI {} -> Cli Text
wat
    Input
VersionI -> Cli Text
wat
  where
    p :: Path -> Cli Text
    p :: Path -> Cli Text
p = (ProjectPath -> Text) -> Cli ProjectPath -> Cli Text
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall target source. From source target => source -> target
into @Text) (Cli ProjectPath -> Cli Text)
-> (Path -> Cli ProjectPath) -> Path -> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Cli ProjectPath
Cli.resolvePath
    p' :: Path' -> Cli Text
    p' :: Path' -> Cli Text
p' = (ProjectPath -> Text) -> Cli ProjectPath -> Cli Text
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall target source. From source target => source -> target
into @Text) (Cli ProjectPath -> Cli Text)
-> (Path' -> Cli ProjectPath) -> Path' -> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> Cli ProjectPath
Cli.resolvePath'
    brp :: BranchRelativePath -> Cli Text
    brp :: BranchRelativePath -> Cli Text
brp = (ProjectPath -> Text) -> Cli ProjectPath -> Cli Text
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall target source. From source target => source -> target
into @Text) (Cli ProjectPath -> Cli Text)
-> (BranchRelativePath -> Cli ProjectPath)
-> BranchRelativePath
-> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath
    ops :: Maybe Path.Split -> Cli Text
    ops :: Maybe Split -> Cli Text
ops = Cli Text -> (Split -> Cli Text) -> Maybe Split -> Cli Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
".") Split -> Cli Text
ps
    wat :: Cli Text
wat = String -> Cli Text
forall a. HasCallStack => String -> a
error (String -> Cli Text) -> String -> Cli Text
forall a b. (a -> b) -> a -> b
$ Input -> String
forall a. Show a => a -> String
show Input
input String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not expected to alter the branch"
    hhqs' :: Either SH.ShortHash Path.HQSplit' -> Cli Text
    hhqs' :: HashOrHQSplit' -> Cli Text
hhqs' = \case
      Left ShortHash
sh -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShortHash -> Text
SH.toText ShortHash
sh)
      Right HQSplit'
x -> HQSplit' -> Cli Text
hqs' HQSplit'
x
    hqs' :: Path.HQSplit' -> Cli Text
    hqs' :: HQSplit' -> Cli Text
hqs' (Path'
p0, HQSegment
hq) = do
      Text
p <- if Path' -> Bool
Path.isRoot' Path'
p0 then Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
forall a. Monoid a => a
mempty else Path' -> Cli Text
p' Path'
p0
      pure (Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (NameSegment -> Text) -> HQSegment -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ'.toTextWith NameSegment -> Text
NameSegment.toEscapedText HQSegment
hq)
    hqs :: HQSplit -> Cli Text
hqs (Path
p, HQSegment
hq) = HQSplit' -> Cli Text
hqs' (Either Absolute Relative -> Path'
Path' (Either Absolute Relative -> Path')
-> (Path -> Either Absolute Relative) -> Path -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Either Absolute Relative
forall a b. b -> Either a b
Right (Relative -> Either Absolute Relative)
-> (Path -> Relative) -> Path -> Either Absolute Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative
Path.Relative (Path -> Path') -> Path -> Path'
forall a b. (a -> b) -> a -> b
$ Path
p, HQSegment
hq)
    ps' :: Split' -> Cli Text
ps' = Path' -> Cli Text
p' (Path' -> Cli Text) -> (Split' -> Path') -> Split' -> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split' -> Path'
Path.unsplit'
    ps :: Split -> Cli Text
ps = Path -> Cli Text
p (Path -> Cli Text) -> (Split -> Path) -> Split -> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Path
Path.unsplit
    bid2 :: BranchId2 -> Cli Text
    bid2 :: BranchId2 -> Cli Text
bid2 = \case
      Left ShortCausalHash
sch -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Cli Text) -> Text -> Cli Text
forall a b. (a -> b) -> a -> b
$ forall target source. From source target => source -> target
into @Text ShortCausalHash
sch
      Right BranchRelativePath
p -> BranchRelativePath -> Cli Text
brp BranchRelativePath
p

handleFindI ::
  Bool ->
  FindScope ->
  [String] ->
  Input ->
  Cli ()
handleFindI :: Bool -> FindScope -> [String] -> Input -> Cli ()
handleFindI Bool
isVerbose FindScope
fscope [String]
ws Input
input = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  case FindScope
fscope of
    FindLocal Path'
p -> do
      ProjectPath
searchRoot <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
p
      Branch0 IO
branch0 <- ProjectPath -> Cli (Branch0 IO)
Cli.getBranch0FromProjectPath ProjectPath
searchRoot
      let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.withoutLib Branch0 IO
branch0)
      -- Don't exclude anything from the pretty printer, since the type signatures we print for
      -- results may contain things in lib.
      Names
currentNames <- Cli Names
Cli.currentNames
      let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
currentNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
currentNames)
      let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
      [SearchResult]
results <- Codebase IO Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
forall (m :: * -> *).
Codebase m Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
searchBranch0 Codebase IO Symbol Ann
codebase Branch0 IO
branch0 Names
names
      if ([SearchResult] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SearchResult]
results)
        then do
          Output -> Cli ()
Cli.respond Output
FindNoLocalMatches
          -- We've already searched everything else, so now we search JUST the
          -- names in lib.
          let mayOnlyLibBranch :: Maybe (Branch0 IO)
mayOnlyLibBranch = Branch0 IO
branch0 Branch0 IO
-> (Branch0 IO -> Maybe (Branch0 IO)) -> Maybe (Branch0 IO)
forall a b. a -> (a -> b) -> b
& (Map NameSegment (Branch IO)
 -> Maybe (Map NameSegment (Branch IO)))
-> Branch0 IO -> Maybe (Branch0 IO)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children ((Map NameSegment (Branch IO)
  -> Maybe (Map NameSegment (Branch IO)))
 -> Branch0 IO -> Maybe (Branch0 IO))
-> (Map NameSegment (Branch IO)
    -> Maybe (Map NameSegment (Branch IO)))
-> Branch0 IO
-> Maybe (Branch0 IO)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ \Map NameSegment (Branch IO)
cs -> NameSegment -> Branch IO -> Map NameSegment (Branch IO)
forall k a. k -> a -> Map k a
Map.singleton NameSegment
NameSegment.libSegment (Branch IO -> Map NameSegment (Branch IO))
-> Maybe (Branch IO) -> Maybe (Map NameSegment (Branch IO))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameSegment -> Map NameSegment (Branch IO) -> Maybe (Branch IO)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
NameSegment.libSegment Map NameSegment (Branch IO)
cs
          case Maybe (Branch0 IO)
mayOnlyLibBranch of
            Maybe (Branch0 IO)
Nothing -> Codebase IO Symbol Ann
-> PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
forall (m :: * -> *).
Codebase m Symbol Ann
-> PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
respondResults Codebase IO Symbol Ann
codebase PrettyPrintEnv
suffixifiedPPE (Path' -> Maybe Path'
forall a. a -> Maybe a
Just Path'
p) []
            Just Branch0 IO
onlyLibBranch -> do
              let onlyLibNames :: Names
onlyLibNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
onlyLibBranch
              [SearchResult]
results <- Codebase IO Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
forall (m :: * -> *).
Codebase m Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
searchBranch0 Codebase IO Symbol Ann
codebase Branch0 IO
branch0 Names
onlyLibNames
              Codebase IO Symbol Ann
-> PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
forall (m :: * -> *).
Codebase m Symbol Ann
-> PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
respondResults Codebase IO Symbol Ann
codebase PrettyPrintEnv
suffixifiedPPE (Path' -> Maybe Path'
forall a. a -> Maybe a
Just Path'
p) [SearchResult]
results
        else Codebase IO Symbol Ann
-> PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
forall (m :: * -> *).
Codebase m Symbol Ann
-> PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
respondResults Codebase IO Symbol Ann
codebase PrettyPrintEnv
suffixifiedPPE (Path' -> Maybe Path'
forall a. a -> Maybe a
Just Path'
p) [SearchResult]
results
    FindLocalAndDeps Path'
p -> do
      ProjectPath
searchRoot <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
p
      Branch0 IO
branch0 <- ProjectPath -> Cli (Branch0 IO)
Cli.getBranch0FromProjectPath ProjectPath
searchRoot
      let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.withoutTransitiveLibs Branch0 IO
branch0)
      -- Don't exclude anything from the pretty printer, since the type signatures we print for
      -- results may contain things in lib.
      Names
currentNames <- Cli Names
Cli.currentNames
      let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
currentNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
currentNames)
      let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
      [SearchResult]
results <- Codebase IO Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
forall (m :: * -> *).
Codebase m Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
searchBranch0 Codebase IO Symbol Ann
codebase Branch0 IO
branch0 Names
names
      Codebase IO Symbol Ann
-> PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
forall (m :: * -> *).
Codebase m Symbol Ann
-> PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
respondResults Codebase IO Symbol Ann
codebase PrettyPrintEnv
suffixifiedPPE (Path' -> Maybe Path'
forall a. a -> Maybe a
Just Path'
p) [SearchResult]
results
    FindScope
FindGlobal -> do
      ((ProjectAndBranch ProjectName ProjectBranchName,
  ProjectAndBranch ProjectId ProjectBranchId)
 -> Branch IO -> Cli ())
-> Cli ()
forall r.
Monoid r =>
((ProjectAndBranch ProjectName ProjectBranchName,
  ProjectAndBranch ProjectId ProjectBranchId)
 -> Branch IO -> Cli r)
-> Cli r
Global.forAllProjectBranches \(ProjectAndBranch ProjectName ProjectBranchName
projAndBranchNames, ProjectAndBranch ProjectId ProjectBranchId
_ids) Branch IO
branch -> do
        let branch0 :: Branch0 IO
branch0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
branch
        let projectRootNames :: Names
projectRootNames = Names -> Names
Names.makeAbsolute (Names -> Names) -> (Branch0 IO -> Names) -> Branch0 IO -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Names) -> Branch0 IO -> Names
forall a b. (a -> b) -> a -> b
$ Branch0 IO
branch0
        let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
projectRootNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
projectRootNames)
        [SearchResult]
results <- Codebase IO Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
forall (m :: * -> *).
Codebase m Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
searchBranch0 Codebase IO Symbol Ann
codebase Branch0 IO
branch0 Names
projectRootNames
        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
$ [SearchResult] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SearchResult]
results) do
          [StructuredArgument] -> Cli ()
Cli.setNumberedArgs ([StructuredArgument] -> Cli ()) -> [StructuredArgument] -> Cli ()
forall a b. (a -> b) -> a -> b
$ (SearchResult -> StructuredArgument)
-> [SearchResult] -> [StructuredArgument]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Path' -> SearchResult -> StructuredArgument
SA.SearchResult Maybe Path'
forall a. Maybe a
Nothing) [SearchResult]
results
          [SearchResult' Symbol Ann]
results' <- Transaction [SearchResult' Symbol Ann]
-> Cli [SearchResult' Symbol Ann]
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase IO Symbol Ann
-> [SearchResult] -> Transaction [SearchResult' Symbol Ann]
forall (m :: * -> *).
Codebase m Symbol Ann
-> [SearchResult] -> Transaction [SearchResult' Symbol Ann]
Backend.loadSearchResults Codebase IO Symbol Ann
codebase [SearchResult]
results)
          Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ ProjectAndBranch ProjectName ProjectBranchName
-> PrettyPrintEnv -> Bool -> [SearchResult' Symbol Ann] -> Output
GlobalFindBranchResults ProjectAndBranch ProjectName ProjectBranchName
projAndBranchNames (PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped) Bool
isVerbose [SearchResult' Symbol Ann]
results'
  where
    searchBranch0 :: Codebase.Codebase m Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
    searchBranch0 :: forall (m :: * -> *).
Codebase m Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
searchBranch0 Codebase m Symbol Ann
codebase Branch0 IO
branch0 Names
names =
      case [String]
ws of
        [] -> [SearchResult] -> Cli [SearchResult]
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SearchResult -> SearchResult -> Ordering)
-> [SearchResult] -> [SearchResult]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy SearchResult -> SearchResult -> Ordering
SR.compareByName (Names -> [SearchResult]
SR.fromNames Names
names))
        -- type query
        String
":" : [String]
ws -> do
          Type Symbol Ann
typ <- String -> String -> Cli (Type Symbol Ann)
parseSearchType (Input -> String
forall a. Show a => a -> String
show Input
input) ([String] -> String
unwords [String]
ws)
          let keepNamed :: Set Referent -> Set Referent
keepNamed = Set Referent -> Set Referent -> Set Referent
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (Branch0 IO -> Set Referent
forall (m :: * -> *). Branch0 m -> Set Referent
Branch.deepReferents Branch0 IO
branch0)
          (Bool
noExactTypeMatches, Set Referent
matches) <- do
            Transaction (Bool, Set Referent) -> Cli (Bool, Set Referent)
forall a. Transaction a -> Cli a
Cli.runTransaction do
              Set Referent
matches <- Set Referent -> Set Referent
keepNamed (Set Referent -> Set Referent)
-> Transaction (Set Referent) -> Transaction (Set Referent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m Symbol Ann
-> Type Symbol Ann -> Transaction (Set Referent)
forall v (m :: * -> *) a.
Var v =>
Codebase m v a -> Type v a -> Transaction (Set Referent)
Codebase.termsOfType Codebase m Symbol Ann
codebase Type Symbol Ann
typ
              if Set Referent -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Referent
matches
                then (Bool
True,) (Set Referent -> (Bool, Set Referent))
-> (Set Referent -> Set Referent)
-> Set Referent
-> (Bool, Set Referent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Referent -> Set Referent
keepNamed (Set Referent -> (Bool, Set Referent))
-> Transaction (Set Referent) -> Transaction (Bool, Set Referent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase m Symbol Ann
-> Type Symbol Ann -> Transaction (Set Referent)
forall v (m :: * -> *) a.
Var v =>
Codebase m v a -> Type v a -> Transaction (Set Referent)
Codebase.termsMentioningType Codebase m Symbol Ann
codebase Type Symbol Ann
typ
                else (Bool, Set Referent) -> Transaction (Bool, Set Referent)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, Set Referent
matches)
          Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
noExactTypeMatches (Output -> Cli ()
Cli.respond Output
NoExactTypeMatches)
          pure $
            -- in verbose mode, aliases are shown, so we collapse all
            -- aliases to a single search result; in non-verbose mode,
            -- a separate result may be shown for each alias
            (if Bool
isVerbose then (SearchResult -> Referent) -> [SearchResult] -> [SearchResult]
forall (f :: * -> *) b a.
(Foldable f, Ord b) =>
(a -> b) -> f a -> [a]
uniqueBy SearchResult -> Referent
SR.toReferent else [SearchResult] -> [SearchResult]
forall a. a -> a
id) ([SearchResult] -> [SearchResult])
-> [SearchResult] -> [SearchResult]
forall a b. (a -> b) -> a -> b
$
              Names -> [Referent] -> [Reference] -> [SearchResult]
searchResultsFor Names
names (Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList Set Referent
matches) []

        -- name query
        [String]
qs -> do
          let anythingBeforeHash :: Megaparsec.Parsec (L.Token Text) [Char] Text
              anythingBeforeHash :: Parsec (Token Text) String Text
anythingBeforeHash = String -> Text
Text.pack (String -> Text)
-> ParsecT (Token Text) String Identity String
-> Parsec (Token Text) String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token String -> Bool)
-> ParsecT (Token Text) String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhileP Maybe String
forall a. Maybe a
Nothing (Token String -> Token String -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token String
'#')
          let srs :: [SearchResult]
srs =
                Names
-> (Text -> Text -> Maybe Int)
-> [HashQualified Text]
-> [SearchResult]
forall score.
Ord score =>
Names
-> (Text -> Text -> Maybe score)
-> [HashQualified Text]
-> [SearchResult]
searchBranchScored
                  Names
names
                  Text -> Text -> Maybe Int
Find.simpleFuzzyScore
                  ((String -> Maybe (HashQualified Text))
-> [String] -> [HashQualified Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Parsec (Token Text) String Text
-> Text -> Maybe (HashQualified Text)
forall name.
Parsec (Token Text) String name
-> Text -> Maybe (HashQualified name)
HQ.parseTextWith Parsec (Token Text) String Text
anythingBeforeHash (Text -> Maybe (HashQualified Text))
-> (String -> Text) -> String -> Maybe (HashQualified Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) [String]
qs)
          [SearchResult] -> Cli [SearchResult]
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SearchResult] -> Cli [SearchResult])
-> [SearchResult] -> Cli [SearchResult]
forall a b. (a -> b) -> a -> b
$ (SearchResult -> Referent) -> [SearchResult] -> [SearchResult]
forall (f :: * -> *) b a.
(Foldable f, Ord b) =>
(a -> b) -> f a -> [a]
uniqueBy SearchResult -> Referent
SR.toReferent [SearchResult]
srs
    respondResults :: Codebase.Codebase m Symbol Ann -> PPE.PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
    respondResults :: forall (m :: * -> *).
Codebase m Symbol Ann
-> PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
respondResults Codebase m Symbol Ann
codebase PrettyPrintEnv
ppe Maybe Path'
searchRoot [SearchResult]
results = do
      [StructuredArgument] -> Cli ()
Cli.setNumberedArgs ([StructuredArgument] -> Cli ()) -> [StructuredArgument] -> Cli ()
forall a b. (a -> b) -> a -> b
$ (SearchResult -> StructuredArgument)
-> [SearchResult] -> [StructuredArgument]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Path' -> SearchResult -> StructuredArgument
SA.SearchResult Maybe Path'
searchRoot) [SearchResult]
results
      [SearchResult' Symbol Ann]
results' <- Transaction [SearchResult' Symbol Ann]
-> Cli [SearchResult' Symbol Ann]
forall a. Transaction a -> Cli a
Cli.runTransaction (Codebase m Symbol Ann
-> [SearchResult] -> Transaction [SearchResult' Symbol Ann]
forall (m :: * -> *).
Codebase m Symbol Ann
-> [SearchResult] -> Transaction [SearchResult' Symbol Ann]
Backend.loadSearchResults Codebase m Symbol Ann
codebase [SearchResult]
results)
      Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ FindScope
-> PrettyPrintEnv -> Bool -> [SearchResult' Symbol Ann] -> Output
ListOfDefinitions FindScope
fscope PrettyPrintEnv
ppe Bool
isVerbose [SearchResult' Symbol Ann]
results'

handleDependencies :: HQ.HashQualified Name -> Cli ()
handleDependencies :: HashQualified Name -> Cli ()
handleDependencies HashQualified Name
hq = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  -- todo: add flag to handle transitive efficiently
  Set LabeledDependency
lds <- HashQualified Name -> Cli (Set LabeledDependency)
resolveHQToLabeledDependencies HashQualified Name
hq
  Names
names <- Cli Names
Cli.currentNames
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set LabeledDependency -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set LabeledDependency
lds) do
    Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (HashQualified Name -> Output
LabeledReferenceNotFound HashQualified Name
hq)
  [([(HashQualified Name, Reference)],
  [(HashQualified Name, Referent)])]
results <- [LabeledDependency]
-> (LabeledDependency
    -> Cli
         ([(HashQualified Name, Reference)],
          [(HashQualified Name, Referent)]))
-> Cli
     [([(HashQualified Name, Reference)],
       [(HashQualified Name, Referent)])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Set LabeledDependency -> [LabeledDependency]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set LabeledDependency
lds) \LabeledDependency
ld -> do
    Set LabeledDependency
dependencies :: Set LabeledDependency <-
      Transaction (Set LabeledDependency) -> Cli (Set LabeledDependency)
forall a. Transaction a -> Cli a
Cli.runTransaction do
        let tp :: Reference -> Transaction (Set LabeledDependency)
tp r :: Reference
r@(Reference.DerivedId Id
i) =
              Codebase IO Symbol Ann
-> Id -> Transaction (Maybe (Decl Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
Codebase.getTypeDeclaration Codebase IO Symbol Ann
codebase Id
i Transaction (Maybe (Decl Symbol Ann))
-> (Maybe (Decl Symbol Ann) -> Set LabeledDependency)
-> Transaction (Set LabeledDependency)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                Maybe (Decl Symbol Ann)
Nothing -> String -> Set LabeledDependency
forall a. HasCallStack => String -> a
error (String -> Set LabeledDependency)
-> String -> Set LabeledDependency
forall a b. (a -> b) -> a -> b
$ String
"What happened to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"?"
                Just Decl Symbol Ann
decl ->
                  (Reference -> LabeledDependency)
-> Set Reference -> Set LabeledDependency
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Reference -> LabeledDependency
LabeledDependency.TypeReference (Set Reference -> Set LabeledDependency)
-> (DataDeclaration Symbol Ann -> Set Reference)
-> DataDeclaration Symbol Ann
-> Set LabeledDependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Set Reference -> Set Reference
forall a. Ord a => a -> Set a -> Set a
Set.delete Reference
r (Set Reference -> Set Reference)
-> (DataDeclaration Symbol Ann -> Set Reference)
-> DataDeclaration Symbol Ann
-> Set Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDeclaration Symbol Ann -> Set Reference
forall v a. Ord v => DataDeclaration v a -> Set Reference
DD.typeDependencies (DataDeclaration Symbol Ann -> Set LabeledDependency)
-> DataDeclaration Symbol Ann -> Set LabeledDependency
forall a b. (a -> b) -> a -> b
$
                    Decl Symbol Ann -> DataDeclaration Symbol Ann
forall v a. Decl v a -> DataDeclaration v a
DD.asDataDecl Decl Symbol Ann
decl
            tp Reference
_ = Set LabeledDependency -> Transaction (Set LabeledDependency)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set LabeledDependency
forall a. Monoid a => a
mempty
            tm :: Referent -> Transaction (Set LabeledDependency)
tm r :: Referent
r@(Referent.Ref (Reference.DerivedId Id
i)) =
              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.getTerm Codebase IO Symbol Ann
codebase Id
i Transaction (Maybe (Term Symbol Ann))
-> (Maybe (Term Symbol Ann) -> Set LabeledDependency)
-> Transaction (Set LabeledDependency)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                Maybe (Term Symbol Ann)
Nothing -> String -> Set LabeledDependency
forall a. HasCallStack => String -> a
error (String -> Set LabeledDependency)
-> String -> Set LabeledDependency
forall a b. (a -> b) -> a -> b
$ String
"What happened to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"?"
                Just Term Symbol Ann
tm -> LabeledDependency -> Set LabeledDependency -> Set LabeledDependency
forall a. Ord a => a -> Set a -> Set a
Set.delete (Referent -> LabeledDependency
LabeledDependency.TermReferent Referent
r) (Term Symbol Ann -> Set LabeledDependency
forall v vt at ap a.
(Ord v, Ord vt) =>
Term2 vt at ap v a -> Set LabeledDependency
Term.labeledDependencies Term Symbol Ann
tm)
            tm con :: Referent
con@(Referent.Con (ConstructorReference (Reference.DerivedId Id
i) ConstructorId
cid) ConstructorType
_ct) =
              Codebase IO Symbol Ann
-> Id -> Transaction (Maybe (Decl Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
Codebase.getTypeDeclaration Codebase IO Symbol Ann
codebase Id
i Transaction (Maybe (Decl Symbol Ann))
-> (Maybe (Decl Symbol Ann) -> Set LabeledDependency)
-> Transaction (Set LabeledDependency)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                Maybe (Decl Symbol Ann)
Nothing -> String -> Set LabeledDependency
forall a. HasCallStack => String -> a
error (String -> Set LabeledDependency)
-> String -> Set LabeledDependency
forall a b. (a -> b) -> a -> b
$ String
"What happened to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"?"
                Just Decl Symbol Ann
decl -> case DataDeclaration Symbol Ann
-> ConstructorId -> Maybe (Type Symbol Ann)
forall v a.
DataDeclaration v a -> ConstructorId -> Maybe (Type v a)
DD.typeOfConstructor (Decl Symbol Ann -> DataDeclaration Symbol Ann
forall v a. Decl v a -> DataDeclaration v a
DD.asDataDecl Decl Symbol Ann
decl) ConstructorId
cid of
                  Maybe (Type Symbol Ann)
Nothing -> String -> Set LabeledDependency
forall a. HasCallStack => String -> a
error (String -> Set LabeledDependency)
-> String -> Set LabeledDependency
forall a b. (a -> b) -> a -> b
$ String
"What happened to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Referent -> String
forall a. Show a => a -> String
show Referent
con String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"?"
                  Just Type Symbol Ann
tp -> Type Symbol Ann -> Set LabeledDependency
forall v a. Ord v => Type v a -> Set LabeledDependency
Type.labeledDependencies Type Symbol Ann
tp
            tm Referent
_ = Set LabeledDependency -> Transaction (Set LabeledDependency)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set LabeledDependency
forall a. Monoid a => a
mempty
         in (Reference -> Transaction (Set LabeledDependency))
-> (Referent -> Transaction (Set LabeledDependency))
-> LabeledDependency
-> Transaction (Set LabeledDependency)
forall a.
(Reference -> a) -> (Referent -> a) -> LabeledDependency -> a
LD.fold Reference -> Transaction (Set LabeledDependency)
tp Referent -> Transaction (Set LabeledDependency)
tm LabeledDependency
ld
    let types :: [(HashQualified Name, Reference)]
types = [(PrettyPrintEnv -> Reference -> HashQualified Name
PPE.typeName PrettyPrintEnv
suffixifiedPPE Reference
r, Reference
r) | LabeledDependency.TypeReference Reference
r <- Set LabeledDependency -> [LabeledDependency]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set LabeledDependency
dependencies]
    let terms :: [(HashQualified Name, Referent)]
terms = [(PrettyPrintEnv -> Referent -> HashQualified Name
PPE.termName PrettyPrintEnv
suffixifiedPPE Referent
r, Referent
r) | LabeledDependency.TermReferent Referent
r <- Set LabeledDependency -> [LabeledDependency]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set LabeledDependency
dependencies]
    ([(HashQualified Name, Reference)],
 [(HashQualified Name, Referent)])
-> Cli
     ([(HashQualified Name, Reference)],
      [(HashQualified Name, Referent)])
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(HashQualified Name, Reference)]
types, [(HashQualified Name, Referent)]
terms)
  let types :: [HashQualified Name]
types = ((HashQualified Name, Reference) -> HashQualified Name)
-> [(HashQualified Name, Reference)] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name, Reference) -> HashQualified Name
forall a b. (a, b) -> a
fst ([(HashQualified Name, Reference)] -> [HashQualified Name])
-> ([[(HashQualified Name, Reference)]]
    -> [(HashQualified Name, Reference)])
-> [[(HashQualified Name, Reference)]]
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashQualified Name, Reference) -> Reference)
-> [(HashQualified Name, Reference)]
-> [(HashQualified Name, Reference)]
forall (f :: * -> *) b a.
(Foldable f, Ord b) =>
(a -> b) -> f a -> [a]
nubOrdOn (HashQualified Name, Reference) -> Reference
forall a b. (a, b) -> b
snd ([(HashQualified Name, Reference)]
 -> [(HashQualified Name, Reference)])
-> ([[(HashQualified Name, Reference)]]
    -> [(HashQualified Name, Reference)])
-> [[(HashQualified Name, Reference)]]
-> [(HashQualified Name, Reference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashQualified Name, Reference) -> Text)
-> [(HashQualified Name, Reference)]
-> [(HashQualified Name, Reference)]
forall a. (a -> Text) -> [a] -> [a]
Name.sortByText (HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text)
-> ((HashQualified Name, Reference) -> HashQualified Name)
-> (HashQualified Name, Reference)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name, Reference) -> HashQualified Name
forall a b. (a, b) -> a
fst) ([(HashQualified Name, Reference)]
 -> [(HashQualified Name, Reference)])
-> ([[(HashQualified Name, Reference)]]
    -> [(HashQualified Name, Reference)])
-> [[(HashQualified Name, Reference)]]
-> [(HashQualified Name, Reference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(HashQualified Name, Reference)]]
-> [(HashQualified Name, Reference)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(HashQualified Name, Reference)]] -> [HashQualified Name])
-> [[(HashQualified Name, Reference)]] -> [HashQualified Name]
forall a b. (a -> b) -> a -> b
$ ([(HashQualified Name, Reference)],
 [(HashQualified Name, Referent)])
-> [(HashQualified Name, Reference)]
forall a b. (a, b) -> a
fst (([(HashQualified Name, Reference)],
  [(HashQualified Name, Referent)])
 -> [(HashQualified Name, Reference)])
-> [([(HashQualified Name, Reference)],
     [(HashQualified Name, Referent)])]
-> [[(HashQualified Name, Reference)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([(HashQualified Name, Reference)],
  [(HashQualified Name, Referent)])]
results
  let terms :: [HashQualified Name]
terms = ((HashQualified Name, Referent) -> HashQualified Name)
-> [(HashQualified Name, Referent)] -> [HashQualified Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashQualified Name, Referent) -> HashQualified Name
forall a b. (a, b) -> a
fst ([(HashQualified Name, Referent)] -> [HashQualified Name])
-> ([[(HashQualified Name, Referent)]]
    -> [(HashQualified Name, Referent)])
-> [[(HashQualified Name, Referent)]]
-> [HashQualified Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashQualified Name, Referent) -> Referent)
-> [(HashQualified Name, Referent)]
-> [(HashQualified Name, Referent)]
forall (f :: * -> *) b a.
(Foldable f, Ord b) =>
(a -> b) -> f a -> [a]
nubOrdOn (HashQualified Name, Referent) -> Referent
forall a b. (a, b) -> b
snd ([(HashQualified Name, Referent)]
 -> [(HashQualified Name, Referent)])
-> ([[(HashQualified Name, Referent)]]
    -> [(HashQualified Name, Referent)])
-> [[(HashQualified Name, Referent)]]
-> [(HashQualified Name, Referent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashQualified Name, Referent) -> Text)
-> [(HashQualified Name, Referent)]
-> [(HashQualified Name, Referent)]
forall a. (a -> Text) -> [a] -> [a]
Name.sortByText (HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text)
-> ((HashQualified Name, Referent) -> HashQualified Name)
-> (HashQualified Name, Referent)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name, Referent) -> HashQualified Name
forall a b. (a, b) -> a
fst) ([(HashQualified Name, Referent)]
 -> [(HashQualified Name, Referent)])
-> ([[(HashQualified Name, Referent)]]
    -> [(HashQualified Name, Referent)])
-> [[(HashQualified Name, Referent)]]
-> [(HashQualified Name, Referent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(HashQualified Name, Referent)]]
-> [(HashQualified Name, Referent)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(HashQualified Name, Referent)]] -> [HashQualified Name])
-> [[(HashQualified Name, Referent)]] -> [HashQualified Name]
forall a b. (a -> b) -> a -> b
$ ([(HashQualified Name, Reference)],
 [(HashQualified Name, Referent)])
-> [(HashQualified Name, Referent)]
forall a b. (a, b) -> b
snd (([(HashQualified Name, Reference)],
  [(HashQualified Name, Referent)])
 -> [(HashQualified Name, Referent)])
-> [([(HashQualified Name, Reference)],
     [(HashQualified Name, Referent)])]
-> [[(HashQualified Name, Referent)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([(HashQualified Name, Reference)],
  [(HashQualified Name, Referent)])]
results
  [StructuredArgument] -> Cli ()
Cli.setNumberedArgs ([StructuredArgument] -> Cli ())
-> ([HashQualified Name] -> [StructuredArgument])
-> [HashQualified Name]
-> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashQualified Name -> StructuredArgument)
-> [HashQualified Name] -> [StructuredArgument]
forall a b. (a -> b) -> [a] -> [b]
map HashQualified Name -> StructuredArgument
SA.HashQualified ([HashQualified Name] -> Cli ()) -> [HashQualified Name] -> Cli ()
forall a b. (a -> b) -> a -> b
$ [HashQualified Name]
types [HashQualified Name]
-> [HashQualified Name] -> [HashQualified Name]
forall a. Semigroup a => a -> a -> a
<> [HashQualified Name]
terms
  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
-> Set LabeledDependency
-> [HashQualified Name]
-> [HashQualified Name]
-> Output
ListDependencies PrettyPrintEnv
suffixifiedPPE Set LabeledDependency
lds [HashQualified Name]
types [HashQualified Name]
terms

doDisplay :: OutputLocation -> Names -> Term Symbol () -> Cli ()
doDisplay :: OutputLocation -> Names -> Term Symbol () -> Cli ()
doDisplay OutputLocation
outputLoc Names
names Term Symbol ()
tm = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  LoopState
loopState <- Cli LoopState
forall s (m :: * -> *). MonadState s m => m s
State.get
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
suffixify Names
names)
  let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
  (Map Id (Ann, Term Symbol Ann, Type Symbol Ann)
tms, Map Id (Decl Symbol Ann)
typs) <- (Map Id (Ann, Term Symbol Ann, Type Symbol Ann),
 Map Id (Decl Symbol Ann))
-> (TypecheckedUnisonFile Symbol Ann
    -> (Map Id (Ann, Term Symbol Ann, Type Symbol Ann),
        Map Id (Decl Symbol Ann)))
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> (Map Id (Ann, Term Symbol Ann, Type Symbol Ann),
    Map Id (Decl Symbol Ann))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Map Id (Ann, Term Symbol Ann, Type Symbol Ann),
 Map Id (Decl Symbol Ann))
forall a. Monoid a => a
mempty TypecheckedUnisonFile Symbol Ann
-> (Map Id (Ann, Term Symbol Ann, Type Symbol Ann),
    Map Id (Decl Symbol Ann))
forall v a.
TypecheckedUnisonFile v a
-> (Map Id (a, Term v a, Type v a), Map Id (Decl v a))
UF.indexByReference (Maybe (TypecheckedUnisonFile Symbol Ann)
 -> (Map Id (Ann, Term Symbol Ann, Type Symbol Ann),
     Map Id (Decl Symbol Ann)))
-> Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
-> Cli
     (Map Id (Ann, Term Symbol Ann, Type Symbol Ann),
      Map Id (Decl Symbol Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
Cli.getLatestTypecheckedFile
  let useCache :: Bool
useCache = Bool
True
      evalTerm :: Term Symbol () -> Cli (Maybe (Term Symbol ()))
evalTerm Term Symbol ()
tm =
        (Either Error (Term Symbol ()) -> Maybe (Term Symbol ()))
-> Cli (Either Error (Term Symbol ()))
-> Cli (Maybe (Term Symbol ()))
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Error (Term Symbol ()) -> Maybe (Term Symbol ())
forall a b. Either a b -> Maybe b
ErrorUtil.hush (Cli (Either Error (Term Symbol ()))
 -> Cli (Maybe (Term Symbol ())))
-> (Cli (Either Error (Term Symbol Ann))
    -> Cli (Either Error (Term Symbol ())))
-> Cli (Either Error (Term Symbol Ann))
-> Cli (Maybe (Term Symbol ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Error (Term Symbol Ann) -> Either Error (Term Symbol ()))
-> Cli (Either Error (Term Symbol Ann))
-> Cli (Either Error (Term Symbol ()))
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Term Symbol Ann -> Term Symbol ())
-> Either Error (Term Symbol Ann) -> Either Error (Term Symbol ())
forall a b. (a -> b) -> Either Error a -> Either Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term Symbol Ann -> Term Symbol ()
forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
Term.unannotate) (Cli (Either Error (Term Symbol Ann))
 -> Cli (Maybe (Term Symbol ())))
-> Cli (Either Error (Term Symbol Ann))
-> Cli (Maybe (Term Symbol ()))
forall a b. (a -> b) -> a -> b
$
          EvalMode
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Either Error (Term Symbol Ann))
RuntimeUtils.evalUnisonTermE EvalMode
Sandboxed PrettyPrintEnv
suffixifiedPPE Bool
useCache ((() -> Ann) -> Term Symbol () -> Term Symbol Ann
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap (Ann -> () -> Ann
forall a b. a -> b -> a
const Ann
External) Term Symbol ()
tm)
      loadTerm :: Reference -> Cli (Maybe (Term Symbol ()))
loadTerm (Reference.DerivedId Id
r) = case Id
-> Map Id (Ann, Term Symbol Ann, Type Symbol Ann)
-> Maybe (Ann, Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id
r Map Id (Ann, Term Symbol Ann, Type Symbol Ann)
tms of
        Maybe (Ann, Term Symbol Ann, Type Symbol Ann)
Nothing -> (Maybe (Term Symbol Ann) -> Maybe (Term Symbol ()))
-> Cli (Maybe (Term Symbol Ann)) -> Cli (Maybe (Term Symbol ()))
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Term Symbol Ann -> Term Symbol ())
-> Maybe (Term Symbol Ann) -> Maybe (Term Symbol ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Term Symbol Ann -> Term Symbol ()
forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
Term.unannotate) (Cli (Maybe (Term Symbol Ann)) -> Cli (Maybe (Term Symbol ())))
-> Cli (Maybe (Term Symbol Ann)) -> Cli (Maybe (Term Symbol ()))
forall a b. (a -> b) -> a -> b
$ Transaction (Maybe (Term Symbol Ann))
-> Cli (Maybe (Term Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction (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.getTerm Codebase IO Symbol Ann
codebase Id
r)
        Just (Ann
_, Term Symbol Ann
tm, Type Symbol Ann
_) -> Maybe (Term Symbol ()) -> Cli (Maybe (Term Symbol ()))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term Symbol () -> Maybe (Term Symbol ())
forall a. a -> Maybe a
Just (Term Symbol () -> Maybe (Term Symbol ()))
-> Term Symbol () -> Maybe (Term Symbol ())
forall a b. (a -> b) -> a -> b
$ Term Symbol Ann -> Term Symbol ()
forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
Term.unannotate Term Symbol Ann
tm)
      loadTerm Reference
_ = Maybe (Term Symbol ()) -> Cli (Maybe (Term Symbol ()))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Term Symbol ())
forall a. Maybe a
Nothing
      loadDecl :: Reference -> Cli (Maybe (Decl Symbol ()))
loadDecl (Reference.DerivedId Id
r) = case Id -> Map Id (Decl Symbol Ann) -> Maybe (Decl Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id
r Map Id (Decl Symbol Ann)
typs of
        Maybe (Decl Symbol Ann)
Nothing -> (Maybe (Decl Symbol Ann) -> Maybe (Decl Symbol ()))
-> Cli (Maybe (Decl Symbol Ann)) -> Cli (Maybe (Decl Symbol ()))
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Decl Symbol Ann -> Decl Symbol ())
-> Maybe (Decl Symbol Ann) -> Maybe (Decl Symbol ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Decl Symbol Ann -> Decl Symbol ())
 -> Maybe (Decl Symbol Ann) -> Maybe (Decl Symbol ()))
-> (Decl Symbol Ann -> Decl Symbol ())
-> Maybe (Decl Symbol Ann)
-> Maybe (Decl Symbol ())
forall a b. (a -> b) -> a -> b
$ (Ann -> ()) -> Decl Symbol Ann -> Decl Symbol ()
forall a a2 v. (a -> a2) -> Decl v a -> Decl v a2
DD.amap (() -> Ann -> ()
forall a b. a -> b -> a
const ())) (Cli (Maybe (Decl Symbol Ann)) -> Cli (Maybe (Decl Symbol ())))
-> Cli (Maybe (Decl Symbol Ann)) -> Cli (Maybe (Decl Symbol ()))
forall a b. (a -> b) -> a -> b
$ Transaction (Maybe (Decl Symbol Ann))
-> Cli (Maybe (Decl Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction (Maybe (Decl Symbol Ann))
 -> Cli (Maybe (Decl Symbol Ann)))
-> Transaction (Maybe (Decl Symbol Ann))
-> Cli (Maybe (Decl Symbol Ann))
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann
-> Id -> Transaction (Maybe (Decl Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Decl v a))
Codebase.getTypeDeclaration Codebase IO Symbol Ann
codebase Id
r
        Just Decl Symbol Ann
decl -> Maybe (Decl Symbol ()) -> Cli (Maybe (Decl Symbol ()))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decl Symbol () -> Maybe (Decl Symbol ())
forall a. a -> Maybe a
Just (Decl Symbol () -> Maybe (Decl Symbol ()))
-> Decl Symbol () -> Maybe (Decl Symbol ())
forall a b. (a -> b) -> a -> b
$ (Ann -> ()) -> Decl Symbol Ann -> Decl Symbol ()
forall a a2 v. (a -> a2) -> Decl v a -> Decl v a2
DD.amap (() -> Ann -> ()
forall a b. a -> b -> a
const ()) Decl Symbol Ann
decl)
      loadDecl Reference
_ = Maybe (Decl Symbol ()) -> Cli (Maybe (Decl Symbol ()))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Decl Symbol ())
forall a. Maybe a
Nothing
      loadTypeOfTerm' :: Referent -> Cli (Maybe (Term F Symbol ()))
loadTypeOfTerm' (Referent.Ref (Reference.DerivedId Id
r))
        | Just (Ann
_, Term Symbol Ann
_, Type Symbol Ann
ty) <- Id
-> Map Id (Ann, Term Symbol Ann, Type Symbol Ann)
-> Maybe (Ann, Term Symbol Ann, Type Symbol Ann)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Id
r Map Id (Ann, Term Symbol Ann, Type Symbol Ann)
tms = Maybe (Term F Symbol ()) -> Cli (Maybe (Term F Symbol ()))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Term F Symbol ()) -> Cli (Maybe (Term F Symbol ())))
-> Maybe (Term F Symbol ()) -> Cli (Maybe (Term F Symbol ()))
forall a b. (a -> b) -> a -> b
$ Term F Symbol () -> Maybe (Term F Symbol ())
forall a. a -> Maybe a
Just (Type Symbol Ann -> Term F Symbol ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Type Symbol Ann
ty)
      loadTypeOfTerm' Referent
r = (Maybe (Type Symbol Ann) -> Maybe (Term F Symbol ()))
-> Cli (Maybe (Type Symbol Ann)) -> Cli (Maybe (Term F Symbol ()))
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Type Symbol Ann -> Term F Symbol ())
-> Maybe (Type Symbol Ann) -> Maybe (Term F Symbol ())
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type Symbol Ann -> Term F Symbol ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void) (Cli (Maybe (Type Symbol Ann)) -> Cli (Maybe (Term F Symbol ())))
-> (Referent -> Cli (Maybe (Type Symbol Ann)))
-> Referent
-> Cli (Maybe (Term F Symbol ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction (Maybe (Type Symbol Ann))
-> Cli (Maybe (Type Symbol Ann))
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction (Maybe (Type Symbol Ann))
 -> Cli (Maybe (Type Symbol Ann)))
-> (Referent -> Transaction (Maybe (Type Symbol Ann)))
-> Referent
-> Cli (Maybe (Type Symbol Ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO Symbol Ann
-> Referent -> Transaction (Maybe (Type Symbol Ann))
forall a (m :: * -> *).
BuiltinAnnotation a =>
Codebase m Symbol a
-> Referent -> Transaction (Maybe (Type Symbol a))
Codebase.getTypeOfReferent Codebase IO Symbol Ann
codebase (Referent -> Cli (Maybe (Term F Symbol ())))
-> Referent -> Cli (Maybe (Term F Symbol ()))
forall a b. (a -> b) -> a -> b
$ Referent
r
  Error
rendered <- PrettyPrintEnvDecl
-> (Reference -> Cli (Maybe (Term Symbol ())))
-> (Referent -> Cli (Maybe (Term F Symbol ())))
-> (Term Symbol () -> Cli (Maybe (Term Symbol ())))
-> (Reference -> Cli (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> Cli Error
forall (m :: * -> *).
Monad m =>
PrettyPrintEnvDecl
-> (Reference -> m (Maybe (Term Symbol ())))
-> (Referent -> m (Maybe (Term F Symbol ())))
-> (Term Symbol () -> m (Maybe (Term Symbol ())))
-> (Reference -> m (Maybe (Decl Symbol ())))
-> Term Symbol ()
-> m Error
DisplayValues.displayTerm PrettyPrintEnvDecl
pped Reference -> Cli (Maybe (Term Symbol ()))
loadTerm Referent -> Cli (Maybe (Term F Symbol ()))
loadTypeOfTerm' Term Symbol () -> Cli (Maybe (Term Symbol ()))
evalTerm Reference -> Cli (Maybe (Decl Symbol ()))
loadDecl Term Symbol ()
tm
  Maybe String
mayFP <- case OutputLocation
outputLoc of
    OutputLocation
ConsoleLocation -> Maybe String -> Cli (Maybe String)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
    FileLocation String
path RelativeToFold
_ -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> Cli String -> Cli (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Cli String
forall (m :: * -> *). MonadIO m => String -> m String
Directory.canonicalizePath String
path
    LatestFileLocation RelativeToFold
_ -> (String -> Cli String) -> Maybe String -> Cli (Maybe String)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse String -> Cli String
forall (m :: * -> *). MonadIO m => String -> m String
Directory.canonicalizePath (Maybe String -> Cli (Maybe String))
-> Maybe String -> Cli (Maybe String)
forall a b. (a -> b) -> a -> b
$ ((String, Bool) -> String) -> Maybe (String, Bool) -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Bool) -> String
forall a b. (a, b) -> a
fst (LoopState
loopState LoopState
-> Getting (Maybe (String, Bool)) LoopState (Maybe (String, Bool))
-> Maybe (String, Bool)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (String, Bool)) LoopState (Maybe (String, Bool))
#latestFile) Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe String
forall a. a -> Maybe a
Just String
"scratch.u"
  Maybe String -> (String -> Cli ()) -> Cli ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe String
mayFP \String
fp -> do
    IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Cli ()) -> IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
prependFile String
fp (String -> Text
Text.pack (String -> Text) -> (Error -> String) -> Error -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Error -> String
P.toPlain Width
80 (Error -> Text) -> Error -> Text
forall a b. (a -> b) -> a -> b
$ Error
rendered)
  Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> Error -> Output
DisplayRendered Maybe String
mayFP Error
rendered
  where
    suffixify :: Names -> Suffixifier
suffixify =
      case OutputLocation
outputLoc of
        OutputLocation
ConsoleLocation -> Names -> Suffixifier
PPE.suffixifyByHash
        FileLocation String
_ RelativeToFold
_ -> Names -> Suffixifier
PPE.suffixifyByHashName
        LatestFileLocation RelativeToFold
_ -> Names -> Suffixifier
PPE.suffixifyByHashName

    prependFile :: FilePath -> Text -> IO ()
    prependFile :: String -> Text -> IO ()
prependFile String
filePath Text
txt = do
      Bool
exists <- String -> IO Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
Directory.doesFileExist String
filePath
      if Bool
exists
        then do
          Text
existing <- String -> IO Text
readUtf8 String
filePath
          String -> Text -> IO ()
writeUtf8 String
filePath (Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
existing)
        else do
          String -> Text -> IO ()
writeUtf8 String
filePath Text
txt

confirmedCommand :: Input -> Cli Bool
confirmedCommand :: Input -> Cli Bool
confirmedCommand Input
i = do
  LoopState
loopState <- Cli LoopState
forall s (m :: * -> *). MonadState s m => m s
State.get
  pure $ Input -> Maybe Input
forall a. a -> Maybe a
Just Input
i Maybe Input -> Maybe Input -> Bool
forall a. Eq a => a -> a -> Bool
== (LoopState
loopState LoopState
-> Getting (Maybe Input) LoopState (Maybe Input) -> Maybe Input
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Input) LoopState (Maybe Input)
#lastInput)

-- return `name` and `name.<everything>...`
_searchBranchPrefix :: Branch m -> Name -> [SearchResult]
_searchBranchPrefix :: forall (m :: * -> *). Branch m -> Name -> [SearchResult]
_searchBranchPrefix Branch m
b Name
n = case Path -> Maybe Split
Path.unsnoc (Name -> Path
Path.fromName Name
n) of
  Maybe Split
Nothing -> []
  Just (Path
init, NameSegment
last) -> case Path -> Branch m -> Maybe (Branch m)
forall (m :: * -> *). Path -> Branch m -> Maybe (Branch m)
Branch.getAt Path
init Branch m
b of
    Maybe (Branch m)
Nothing -> []
    Just Branch m
b -> Names -> [SearchResult]
SR.fromNames (Names -> [SearchResult])
-> (Names -> Names) -> Names -> [SearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Names -> Names
Names.prefix0 Name
n (Names -> [SearchResult]) -> Names -> [SearchResult]
forall a b. (a -> b) -> a -> b
$ Names
names0
      where
        lastName :: Name
lastName = NameSegment -> Name
Name.fromSegment NameSegment
last
        subnames :: Names
subnames =
          Branch0 m -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 m -> Names)
-> (Branch m -> Branch0 m) -> Branch m -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch m -> Names) -> Branch m -> Names
forall a b. (a -> b) -> a -> b
$
            Path -> Branch m -> Branch m
forall (m :: * -> *). Path -> Branch m -> Branch m
Branch.getAt' (NameSegment -> Path
Path.singleton NameSegment
last) Branch m
b
        rootnames :: Names
rootnames =
          (Name -> Bool) -> Names -> Names
Names.filter (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
lastName)
            (Names -> Names) -> (Branch0 m -> Names) -> Branch0 m -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch0 m -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames
            (Branch0 m -> Names)
-> (Branch0 m -> Branch0 m) -> Branch0 m -> Names
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (Branch m))
  (Map NameSegment (Branch m))
-> Map NameSegment (Branch m) -> Branch0 m -> Branch0 m
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Branch0 m)
  (Branch0 m)
  (Map NameSegment (Branch m))
  (Map NameSegment (Branch m))
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children Map NameSegment (Branch m)
forall a. Monoid a => a
mempty
            (Branch0 m -> Names) -> Branch0 m -> Names
forall a b. (a -> b) -> a -> b
$ Branch m -> Branch0 m
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch m
b
        names0 :: Names
names0 = Names
rootnames Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Name -> Names -> Names
Names.prefix0 Name
lastName Names
subnames

searchResultsFor :: Names -> [Referent] -> [Reference] -> [SearchResult]
searchResultsFor :: Names -> [Referent] -> [Reference] -> [SearchResult]
searchResultsFor Names
ns [Referent]
terms [Reference]
types =
  [ Names -> Name -> Referent -> SearchResult
SR.termSearchResult Names
ns Name
name Referent
ref
    | Referent
ref <- [Referent]
terms,
      Name
name <- Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Names -> Referent -> Set Name
Names.namesForReferent Names
ns Referent
ref)
  ]
    [SearchResult] -> [SearchResult] -> [SearchResult]
forall a. Semigroup a => a -> a -> a
<> [ Names -> Name -> Reference -> SearchResult
SR.typeSearchResult Names
ns Name
name Reference
ref
         | Reference
ref <- [Reference]
types,
           Name
name <- Set Name -> [Name]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Names -> Reference -> Set Name
Names.namesForReference Names
ns Reference
ref)
       ]

searchBranchScored ::
  forall score.
  (Ord score) =>
  Names ->
  (Text -> Text -> Maybe score) ->
  [HQ.HashQualified Text] ->
  [SearchResult]
searchBranchScored :: forall score.
Ord score =>
Names
-> (Text -> Text -> Maybe score)
-> [HashQualified Text]
-> [SearchResult]
searchBranchScored Names
names0 Text -> Text -> Maybe score
score [HashQualified Text]
queries =
  [SearchResult] -> [SearchResult]
forall a. Ord a => [a] -> [a]
nubOrd
    ([SearchResult] -> [SearchResult])
-> ([(Maybe score, SearchResult)] -> [SearchResult])
-> [(Maybe score, SearchResult)]
-> [SearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe score, SearchResult) -> SearchResult)
-> [(Maybe score, SearchResult)] -> [SearchResult]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe score, SearchResult) -> SearchResult
forall a b. (a, b) -> b
snd
    ([(Maybe score, SearchResult)] -> [SearchResult])
-> ([(Maybe score, SearchResult)] -> [(Maybe score, SearchResult)])
-> [(Maybe score, SearchResult)]
-> [SearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe score, SearchResult)
 -> (Maybe score, SearchResult) -> Ordering)
-> [(Maybe score, SearchResult)] -> [(Maybe score, SearchResult)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (\(Maybe score
s0, SearchResult
r0) (Maybe score
s1, SearchResult
r1) -> Maybe score -> Maybe score -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe score
s0 Maybe score
s1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> SearchResult -> SearchResult -> Ordering
SR.compareByName SearchResult
r0 SearchResult
r1)
    ([(Maybe score, SearchResult)] -> [SearchResult])
-> [(Maybe score, SearchResult)] -> [SearchResult]
forall a b. (a -> b) -> a -> b
$ [(Maybe score, SearchResult)]
searchTermNamespace [(Maybe score, SearchResult)]
-> [(Maybe score, SearchResult)] -> [(Maybe score, SearchResult)]
forall a. Semigroup a => a -> a -> a
<> [(Maybe score, SearchResult)]
searchTypeNamespace
  where
    searchTermNamespace :: [(Maybe score, SearchResult)]
searchTermNamespace = [HashQualified Text]
queries [HashQualified Text]
-> (HashQualified Text -> [(Maybe score, SearchResult)])
-> [(Maybe score, SearchResult)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashQualified Text -> [(Maybe score, SearchResult)]
do1query
      where
        do1query :: HQ.HashQualified Text -> [(Maybe score, SearchResult)]
        do1query :: HashQualified Text -> [(Maybe score, SearchResult)]
do1query HashQualified Text
q = ((Name, Referent) -> Maybe (Maybe score, SearchResult))
-> [(Name, Referent)] -> [(Maybe score, SearchResult)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (HashQualified Text
-> (Name, Referent) -> Maybe (Maybe score, SearchResult)
score1hq HashQualified Text
q) (Relation Name Referent -> [(Name, Referent)]
forall a b. Relation a b -> [(a, b)]
R.toList (Relation Name Referent -> [(Name, Referent)])
-> (Names -> Relation Name Referent) -> Names -> [(Name, Referent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> Relation Name Referent
Names.terms (Names -> [(Name, Referent)]) -> Names -> [(Name, Referent)]
forall a b. (a -> b) -> a -> b
$ Names
names0)
        score1hq :: HQ.HashQualified Text -> (Name, Referent) -> Maybe (Maybe score, SearchResult)
        score1hq :: HashQualified Text
-> (Name, Referent) -> Maybe (Maybe score, SearchResult)
score1hq HashQualified Text
query (Name
name, Referent
ref) = case HashQualified Text
query of
          HQ.NameOnly Text
qn ->
            Text -> Maybe (Maybe score, SearchResult)
pair Text
qn
          HQ.HashQualified Text
qn ShortHash
h
            | ShortHash
h ShortHash -> ShortHash -> Bool
`SH.isPrefixOf` Referent -> ShortHash
Referent.toShortHash Referent
ref ->
                Text -> Maybe (Maybe score, SearchResult)
pair Text
qn
          HQ.HashOnly ShortHash
h
            | ShortHash
h ShortHash -> ShortHash -> Bool
`SH.isPrefixOf` Referent -> ShortHash
Referent.toShortHash Referent
ref ->
                (Maybe score, SearchResult) -> Maybe (Maybe score, SearchResult)
forall a. a -> Maybe a
Just (Maybe score
forall a. Maybe a
Nothing, SearchResult
result)
          HashQualified Text
_ -> Maybe (Maybe score, SearchResult)
forall a. Maybe a
Nothing
          where
            result :: SearchResult
result = Names -> Name -> Referent -> SearchResult
SR.termSearchResult Names
names0 Name
name Referent
ref
            pair :: Text -> Maybe (Maybe score, SearchResult)
pair Text
qn =
              (\score
score -> (score -> Maybe score
forall a. a -> Maybe a
Just score
score, SearchResult
result)) (score -> (Maybe score, SearchResult))
-> Maybe score -> Maybe (Maybe score, SearchResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe score
score Text
qn (Name -> Text
Name.toText Name
name)
    searchTypeNamespace :: [(Maybe score, SearchResult)]
searchTypeNamespace = [HashQualified Text]
queries [HashQualified Text]
-> (HashQualified Text -> [(Maybe score, SearchResult)])
-> [(Maybe score, SearchResult)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashQualified Text -> [(Maybe score, SearchResult)]
do1query
      where
        do1query :: HQ.HashQualified Text -> [(Maybe score, SearchResult)]
        do1query :: HashQualified Text -> [(Maybe score, SearchResult)]
do1query HashQualified Text
q = ((Name, Reference) -> Maybe (Maybe score, SearchResult))
-> [(Name, Reference)] -> [(Maybe score, SearchResult)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (HashQualified Text
-> (Name, Reference) -> Maybe (Maybe score, SearchResult)
score1hq HashQualified Text
q) (Relation Name Reference -> [(Name, Reference)]
forall a b. Relation a b -> [(a, b)]
R.toList (Relation Name Reference -> [(Name, Reference)])
-> (Names -> Relation Name Reference)
-> Names
-> [(Name, Reference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Names -> Relation Name Reference
Names.types (Names -> [(Name, Reference)]) -> Names -> [(Name, Reference)]
forall a b. (a -> b) -> a -> b
$ Names
names0)
        score1hq :: HQ.HashQualified Text -> (Name, Reference) -> Maybe (Maybe score, SearchResult)
        score1hq :: HashQualified Text
-> (Name, Reference) -> Maybe (Maybe score, SearchResult)
score1hq HashQualified Text
query (Name
name, Reference
ref) = case HashQualified Text
query of
          HQ.NameOnly Text
qn ->
            Text -> Maybe (Maybe score, SearchResult)
pair Text
qn
          HQ.HashQualified Text
qn ShortHash
h
            | ShortHash
h ShortHash -> ShortHash -> Bool
`SH.isPrefixOf` Reference -> ShortHash
Reference.toShortHash Reference
ref ->
                Text -> Maybe (Maybe score, SearchResult)
pair Text
qn
          HQ.HashOnly ShortHash
h
            | ShortHash
h ShortHash -> ShortHash -> Bool
`SH.isPrefixOf` Reference -> ShortHash
Reference.toShortHash Reference
ref ->
                (Maybe score, SearchResult) -> Maybe (Maybe score, SearchResult)
forall a. a -> Maybe a
Just (Maybe score
forall a. Maybe a
Nothing, SearchResult
result)
          HashQualified Text
_ -> Maybe (Maybe score, SearchResult)
forall a. Maybe a
Nothing
          where
            result :: SearchResult
result = Names -> Name -> Reference -> SearchResult
SR.typeSearchResult Names
names0 Name
name Reference
ref
            pair :: Text -> Maybe (Maybe score, SearchResult)
pair Text
qn =
              (\score
score -> (score -> Maybe score
forall a. a -> Maybe a
Just score
score, SearchResult
result)) (score -> (Maybe score, SearchResult))
-> Maybe score -> Maybe (Maybe score, SearchResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe score
score Text
qn (Name -> Text
Name.toText Name
name)

doCompile :: Bool -> Bool -> String -> HQ.HashQualified Name -> Cli ()
doCompile :: Bool -> Bool -> String -> HashQualified Name -> Cli ()
doCompile Bool
profile Bool
native String
output HashQualified Name
main = do
  Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase, Runtime Symbol
$sel:runtime:Env :: Env -> Runtime Symbol
runtime :: Runtime Symbol
runtime, Runtime Symbol
nativeRuntime :: Runtime Symbol
$sel:nativeRuntime:Env :: Env -> Runtime Symbol
nativeRuntime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let theRuntime :: Runtime Symbol
theRuntime
        | Bool
native = Runtime Symbol
nativeRuntime
        | Bool
otherwise = Runtime Symbol
runtime
  (Reference
ref, PrettyPrintEnv
ppe) <- HashQualified Name -> Cli (Reference, PrettyPrintEnv)
resolveMainRef HashQualified Name
main
  let codeLookup :: CodeLookup Symbol IO ()
codeLookup = () () -> CodeLookup Symbol IO Ann -> CodeLookup Symbol IO ()
forall a b. a -> CodeLookup Symbol IO b -> CodeLookup Symbol IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Codebase IO Symbol Ann -> CodeLookup Symbol IO Ann
forall (m :: * -> *).
MonadIO m =>
Codebase m Symbol Ann -> CodeLookup Symbol m Ann
Codebase.codebaseToCodeLookup Codebase IO Symbol Ann
codebase
      outf :: String
outf
        | Bool
native = String
output
        | Bool
otherwise = String
output String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".uc"
      copts :: CompileOpts
copts = CompileOpts
Runtime.defaultCompileOpts {Runtime.profile = profile}
  Cli (Maybe Error) -> (Error -> Cli ()) -> Cli ()
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM
    ( IO (Maybe Error) -> Cli (Maybe Error)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Error) -> Cli (Maybe Error))
-> IO (Maybe Error) -> Cli (Maybe Error)
forall a b. (a -> b) -> a -> b
$
        Runtime Symbol
-> CompileOpts
-> CodeLookup Symbol IO ()
-> PrettyPrintEnv
-> Reference
-> String
-> IO (Maybe Error)
forall v.
Runtime v
-> CompileOpts
-> CodeLookup v IO ()
-> PrettyPrintEnv
-> Reference
-> String
-> IO (Maybe Error)
Runtime.compileTo Runtime Symbol
theRuntime CompileOpts
copts CodeLookup Symbol IO ()
codeLookup PrettyPrintEnv
ppe Reference
ref String
outf
    )
    (Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli ()) -> (Error -> Output) -> Error -> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Output
EvaluationFailure)

delete ::
  Input ->
  DeleteOutput ->
  ((Path.Absolute, HQ'.HQSegment) -> Cli (Set Referent)) -> -- compute matching terms
  ((Path.Absolute, HQ'.HQSegment) -> Cli (Set Reference)) -> -- compute matching types
  [Path.HQSplit'] -> -- targets for deletion
  Cli ()
delete :: Input
-> DeleteOutput
-> (HQSplitAbsolute -> Cli (Set Referent))
-> (HQSplitAbsolute -> Cli (Set Reference))
-> [HQSplit']
-> Cli ()
delete Input
input DeleteOutput
doutput HQSplitAbsolute -> Cli (Set Referent)
getTerms HQSplitAbsolute -> Cli (Set Reference)
getTypes [HQSplit']
hqs' = do
  -- persists the original hash qualified entity for error reporting
  [(HQSplit', Set Reference, Set Referent)]
typesTermsTuple <-
    (HQSplit' -> Cli (HQSplit', Set Reference, Set Referent))
-> [HQSplit'] -> Cli [(HQSplit', Set Reference, Set Referent)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
      ( \HQSplit'
hq -> do
          (ProjectPath, HQSegment)
absolute <- HQSplit' -> Cli (ProjectPath, HQSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' HQSplit'
hq
          Set Reference
types <- HQSplitAbsolute -> Cli (Set Reference)
getTypes ((ProjectPath -> Absolute)
-> (ProjectPath, HQSegment) -> HQSplitAbsolute
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ProjectPath -> Absolute
forall proj branch. ProjectPathG proj branch -> Absolute
PP.absPath (ProjectPath, HQSegment)
absolute)
          Set Referent
terms <- HQSplitAbsolute -> Cli (Set Referent)
getTerms ((ProjectPath -> Absolute)
-> (ProjectPath, HQSegment) -> HQSplitAbsolute
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ProjectPath -> Absolute
forall proj branch. ProjectPathG proj branch -> Absolute
PP.absPath (ProjectPath, HQSegment)
absolute)
          return (HQSplit'
hq, Set Reference
types, Set Referent
terms)
      )
      [HQSplit']
hqs'
  let notFounds :: [(HQSplit', Set Reference, Set Referent)]
notFounds = ((HQSplit', Set Reference, Set Referent) -> Bool)
-> [(HQSplit', Set Reference, Set Referent)]
-> [(HQSplit', Set Reference, Set Referent)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (\(HQSplit'
_, Set Reference
types, Set Referent
terms) -> Set Referent -> Bool
forall a. Set a -> Bool
Set.null Set Referent
terms Bool -> Bool -> Bool
&& Set Reference -> Bool
forall a. Set a -> Bool
Set.null Set Reference
types) [(HQSplit', Set Reference, Set Referent)]
typesTermsTuple
  -- if there are any entities which cannot be deleted because they don't exist, short circuit.
  if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(HQSplit', Set Reference, Set Referent)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HQSplit', Set Reference, Set Referent)]
notFounds
    then do
      let toName :: [(Path.HQSplit', Set Reference, Set referent)] -> [Name]
          toName :: forall referent.
[(HQSplit', Set Reference, Set referent)] -> [Name]
toName [(HQSplit', Set Reference, Set referent)]
notFounds =
            ((HQSplit', Set Reference, Set referent) -> Name)
-> [(HQSplit', Set Reference, Set referent)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\(HQSplit'
split, Set Reference
_, Set referent
_) -> HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName (HashQualified Name -> Name) -> HashQualified Name -> Name
forall a b. (a -> b) -> a -> b
$ HQSplit' -> HashQualified Name
Path.nameFromHQSplit' HQSplit'
split) [(HQSplit', Set Reference, Set referent)]
notFounds
      Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ [Name] -> Output
NamesNotFound ([(HQSplit', Set Reference, Set Referent)] -> [Name]
forall referent.
[(HQSplit', Set Reference, Set referent)] -> [Name]
toName [(HQSplit', Set Reference, Set Referent)]
notFounds)
    else do
      [(HQSplit', Set Reference, Set Referent)]
-> DeleteOutput -> Input -> Cli ()
checkDeletes [(HQSplit', Set Reference, Set Referent)]
typesTermsTuple DeleteOutput
doutput Input
input

checkDeletes :: [(Path.HQSplit', Set Reference, Set Referent)] -> DeleteOutput -> Input -> Cli ()
checkDeletes :: [(HQSplit', Set Reference, Set Referent)]
-> DeleteOutput -> Input -> Cli ()
checkDeletes [(HQSplit', Set Reference, Set Referent)]
typesTermsTuples DeleteOutput
doutput Input
inputs = do
  let toSplitName ::
        (Path.HQSplit', Set Reference, Set Referent) ->
        Cli (Path.AbsSplit, Name, Set Reference, Set Referent)
      toSplitName :: (HQSplit', Set Reference, Set Referent)
-> Cli ((Absolute, NameSegment), Name, Set Reference, Set Referent)
toSplitName (HQSplit', Set Reference, Set Referent)
hq = do
        (ProjectPath
pp, NameSegment
ns) <- Split' -> Cli (ProjectPath, NameSegment)
forall a. (Path', a) -> Cli (ProjectPath, a)
Cli.resolveSplit' (HQSegment -> NameSegment
forall n. HashQualified n -> n
HQ'.toName (HQSegment -> NameSegment) -> HQSplit' -> Split'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HQSplit', Set Reference, Set Referent)
hq (HQSplit', Set Reference, Set Referent)
-> Getting
     HQSplit' (HQSplit', Set Reference, Set Referent) HQSplit'
-> HQSplit'
forall s a. s -> Getting a s a -> a
^. Getting HQSplit' (HQSplit', Set Reference, Set Referent) HQSplit'
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (HQSplit', Set Reference, Set Referent)
  (HQSplit', Set Reference, Set Referent)
  HQSplit'
  HQSplit'
_1)
        let resolvedSplit :: (Absolute, NameSegment)
resolvedSplit = (ProjectPath
pp.absPath, NameSegment
ns)
        ((Absolute, NameSegment), Name, Set Reference, Set Referent)
-> Cli ((Absolute, NameSegment), Name, Set Reference, Set Referent)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
return
          ((Absolute, NameSegment)
resolvedSplit, Split' -> Name
Path.nameFromSplit' (Split' -> Name) -> Split' -> Name
forall a b. (a -> b) -> a -> b
$ (Absolute -> Path') -> (Absolute, NameSegment) -> Split'
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Relative -> Path'
Path.RelativePath' (Relative -> Path') -> (Absolute -> Relative) -> Absolute -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative
Path.Relative (Path -> Relative) -> (Absolute -> Path) -> Absolute -> Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Path
Path.unabsolute) (Absolute, NameSegment)
resolvedSplit, (HQSplit', Set Reference, Set Referent)
hq (HQSplit', Set Reference, Set Referent)
-> Getting
     (Set Reference)
     (HQSplit', Set Reference, Set Referent)
     (Set Reference)
-> Set Reference
forall s a. s -> Getting a s a -> a
^. Getting
  (Set Reference)
  (HQSplit', Set Reference, Set Referent)
  (Set Reference)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (HQSplit', Set Reference, Set Referent)
  (HQSplit', Set Reference, Set Referent)
  (Set Reference)
  (Set Reference)
_2, (HQSplit', Set Reference, Set Referent)
hq (HQSplit', Set Reference, Set Referent)
-> Getting
     (Set Referent)
     (HQSplit', Set Reference, Set Referent)
     (Set Referent)
-> Set Referent
forall s a. s -> Getting a s a -> a
^. Getting
  (Set Referent)
  (HQSplit', Set Reference, Set Referent)
  (Set Referent)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (HQSplit', Set Reference, Set Referent)
  (HQSplit', Set Reference, Set Referent)
  (Set Referent)
  (Set Referent)
_3)

  -- get the splits and names with terms and types
  [((Absolute, NameSegment), Name, Set Reference, Set Referent)]
splitsNames <- ((HQSplit', Set Reference, Set Referent)
 -> Cli
      ((Absolute, NameSegment), Name, Set Reference, Set Referent))
-> [(HQSplit', Set Reference, Set Referent)]
-> Cli
     [((Absolute, NameSegment), Name, Set Reference, Set Referent)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (HQSplit', Set Reference, Set Referent)
-> Cli ((Absolute, NameSegment), Name, Set Reference, Set Referent)
toSplitName [(HQSplit', Set Reference, Set Referent)]
typesTermsTuples
  let toRel :: (Ord ref) => Set ref -> Name -> R.Relation Name ref
      toRel :: forall ref. Ord ref => Set ref -> Name -> Relation Name ref
toRel Set ref
setRef Name
name = [(Name, ref)] -> Relation Name ref
forall a b. (Ord a, Ord b) => [(a, b)] -> Relation a b
R.fromList ((ref -> (Name, ref)) -> [ref] -> [(Name, ref)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name
name,) (Set ref -> [ref]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set ref
setRef))
  let toDelete :: [Names]
toDelete = (((Absolute, NameSegment), Name, Set Reference, Set Referent)
 -> Names)
-> [((Absolute, NameSegment), Name, Set Reference, Set Referent)]
-> [Names]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((Absolute, NameSegment)
_, Name
names, Set Reference
types, Set Referent
terms) -> Relation Name Referent -> Relation Name Reference -> Names
Names (Set Referent -> Name -> Relation Name Referent
forall ref. Ord ref => Set ref -> Name -> Relation Name ref
toRel Set Referent
terms Name
names) (Set Reference -> Name -> Relation Name Reference
forall ref. Ord ref => Set ref -> Name -> Relation Name ref
toRel Set Reference
types Name
names)) [((Absolute, NameSegment), Name, Set Reference, Set Referent)]
splitsNames
  -- make sure endangered is compeletely contained in paths
  Branch0 IO
currentBranch <- Cli (Branch0 IO)
Cli.getCurrentProjectRoot0
  let projectNames :: Names
projectNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
currentBranch
      projectNamesSansLib :: Names
projectNamesSansLib = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.deleteLibdeps Branch0 IO
currentBranch)
  -- get only once for the entire deletion set
  let allTermsToDelete :: Set LabeledDependency
      allTermsToDelete :: Set LabeledDependency
allTermsToDelete = [Set LabeledDependency] -> Set LabeledDependency
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ((Names -> Set LabeledDependency)
-> [Names] -> [Set LabeledDependency]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Names -> Set LabeledDependency
Names.labeledReferences [Names]
toDelete)
  -- get the endangered dependencies for each entity to delete
  [Map LabeledDependency (NESet LabeledDependency)]
endangered <-
    Transaction [Map LabeledDependency (NESet LabeledDependency)]
-> Cli [Map LabeledDependency (NESet LabeledDependency)]
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction [Map LabeledDependency (NESet LabeledDependency)]
 -> Cli [Map LabeledDependency (NESet LabeledDependency)])
-> Transaction [Map LabeledDependency (NESet LabeledDependency)]
-> Cli [Map LabeledDependency (NESet LabeledDependency)]
forall a b. (a -> b) -> a -> b
$
      (Names
 -> Transaction (Map LabeledDependency (NESet LabeledDependency)))
-> [Names]
-> Transaction [Map LabeledDependency (NESet LabeledDependency)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
        (\Names
targetToDelete -> Names
-> Set LabeledDependency
-> Names
-> Names
-> Transaction (Map LabeledDependency (NESet LabeledDependency))
getEndangeredDependents Names
targetToDelete Set LabeledDependency
allTermsToDelete Names
projectNames Names
projectNamesSansLib)
        [Names]
toDelete
  -- If the overall dependency map is not completely empty, abort deletion
  let endangeredDeletions :: [Map LabeledDependency (NESet LabeledDependency)]
endangeredDeletions = (Map LabeledDependency (NESet LabeledDependency) -> Bool)
-> [Map LabeledDependency (NESet LabeledDependency)]
-> [Map LabeledDependency (NESet LabeledDependency)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (\Map LabeledDependency (NESet LabeledDependency)
m -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map LabeledDependency (NESet LabeledDependency) -> Bool
forall a. Map LabeledDependency a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map LabeledDependency (NESet LabeledDependency)
m Bool -> Bool -> Bool
|| (NESet LabeledDependency -> Bool -> Bool)
-> Bool -> Map LabeledDependency (NESet LabeledDependency) -> Bool
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (\NESet LabeledDependency
s Bool
b -> NESet LabeledDependency -> Bool
forall a. NESet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null NESet LabeledDependency
s Bool -> Bool -> Bool
|| Bool
b) Bool
False Map LabeledDependency (NESet LabeledDependency)
m) [Map LabeledDependency (NESet LabeledDependency)]
endangered
  if [Map LabeledDependency (NESet LabeledDependency)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Map LabeledDependency (NESet LabeledDependency)]
endangeredDeletions
    then do
      let deleteTypesTerms :: [(Absolute, Branch0 IO -> Branch0 IO)]
deleteTypesTerms =
            [((Absolute, NameSegment), Name, Set Reference, Set Referent)]
splitsNames
              [((Absolute, NameSegment), Name, Set Reference, Set Referent)]
-> (((Absolute, NameSegment), Name, Set Reference, Set Referent)
    -> [(Absolute, Branch0 IO -> Branch0 IO)])
-> [(Absolute, Branch0 IO -> Branch0 IO)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \((Absolute, NameSegment)
split, Name
_, Set Reference
types, Set Referent
terms) ->
                      ((Reference -> (Absolute, Branch0 IO -> Branch0 IO))
-> [Reference] -> [(Absolute, Branch0 IO -> Branch0 IO)]
forall a b. (a -> b) -> [a] -> [b]
map ((Absolute, NameSegment)
-> Reference -> (Absolute, Branch0 IO -> Branch0 IO)
forall p (m :: * -> *).
(p, NameSegment) -> Reference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeDeleteTypeName (Absolute, NameSegment)
split) ([Reference] -> [(Absolute, Branch0 IO -> Branch0 IO)])
-> (Set Reference -> [Reference])
-> Set Reference
-> [(Absolute, Branch0 IO -> Branch0 IO)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Reference -> [Reference]
forall a. Set a -> [a]
Set.toList (Set Reference -> [(Absolute, Branch0 IO -> Branch0 IO)])
-> Set Reference -> [(Absolute, Branch0 IO -> Branch0 IO)]
forall a b. (a -> b) -> a -> b
$ Set Reference
types)
                        [(Absolute, Branch0 IO -> Branch0 IO)]
-> [(Absolute, Branch0 IO -> Branch0 IO)]
-> [(Absolute, Branch0 IO -> Branch0 IO)]
forall a. [a] -> [a] -> [a]
++ ((Referent -> (Absolute, Branch0 IO -> Branch0 IO))
-> [Referent] -> [(Absolute, Branch0 IO -> Branch0 IO)]
forall a b. (a -> b) -> [a] -> [b]
map ((Absolute, NameSegment)
-> Referent -> (Absolute, Branch0 IO -> Branch0 IO)
forall p (m :: * -> *).
(p, NameSegment) -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeDeleteTermName (Absolute, NameSegment)
split) ([Referent] -> [(Absolute, Branch0 IO -> Branch0 IO)])
-> (Set Referent -> [Referent])
-> Set Referent
-> [(Absolute, Branch0 IO -> Branch0 IO)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Referent -> [Referent]
forall a. Set a -> [a]
Set.toList (Set Referent -> [(Absolute, Branch0 IO -> Branch0 IO)])
-> Set Referent -> [(Absolute, Branch0 IO -> Branch0 IO)]
forall a b. (a -> b) -> a -> b
$ Set Referent
terms)
                  )
      Branch0 IO
before <- Cli (Branch0 IO)
Cli.getCurrentBranch0
      Text
description <- Input -> Cli Text
inputDescription Input
inputs
      ProjectBranch
pb <- Cli ProjectBranch
Cli.getCurrentProjectBranch
      ProjectBranch
-> Text -> [(Absolute, Branch0 IO -> Branch0 IO)] -> Cli ()
Cli.stepManyAt ProjectBranch
pb Text
description [(Absolute, Branch0 IO -> Branch0 IO)]
deleteTypesTerms
      case DeleteOutput
doutput of
        DeleteOutput
DeleteOutput'Diff -> do
          Branch0 IO
after <- Cli (Branch0 IO)
Cli.getCurrentBranch0
          (PrettyPrintEnv
ppe, BranchDiffOutput Symbol Ann
diff) <- Branch0 IO
-> Branch0 IO -> Cli (PrettyPrintEnv, BranchDiffOutput Symbol Ann)
diffHelper Branch0 IO
before Branch0 IO
after
          NumberedOutput -> Cli ()
Cli.respondNumbered (PrettyPrintEnv -> BranchDiffOutput Symbol Ann -> NumberedOutput
ShowDiffAfterDeleteDefinitions PrettyPrintEnv
ppe BranchDiffOutput Symbol Ann
diff)
        DeleteOutput
DeleteOutput'NoDiff -> do
          Output -> Cli ()
Cli.respond Output
Success
    else do
      let ppeDecl :: PrettyPrintEnvDecl
ppeDecl = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
projectNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
projectNames)
      let combineRefs :: Map LabeledDependency (NESet LabeledDependency)
combineRefs = (Map LabeledDependency (NESet LabeledDependency)
 -> Map LabeledDependency (NESet LabeledDependency)
 -> Map LabeledDependency (NESet LabeledDependency))
-> Map LabeledDependency (NESet LabeledDependency)
-> [Map LabeledDependency (NESet LabeledDependency)]
-> Map LabeledDependency (NESet LabeledDependency)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl ((NESet LabeledDependency
 -> NESet LabeledDependency -> NESet LabeledDependency)
-> Map LabeledDependency (NESet LabeledDependency)
-> Map LabeledDependency (NESet LabeledDependency)
-> Map LabeledDependency (NESet LabeledDependency)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith NESet LabeledDependency
-> NESet LabeledDependency -> NESet LabeledDependency
forall a. Ord a => NESet a -> NESet a -> NESet a
NESet.union) Map LabeledDependency (NESet LabeledDependency)
forall k a. Map k a
Map.empty [Map LabeledDependency (NESet LabeledDependency)]
endangeredDeletions
      NumberedOutput -> Cli ()
Cli.respondNumbered (PrettyPrintEnvDecl
-> Map LabeledDependency (NESet LabeledDependency)
-> NumberedOutput
CantDeleteDefinitions PrettyPrintEnvDecl
ppeDecl Map LabeledDependency (NESet LabeledDependency)
combineRefs)

displayI ::
  OutputLocation ->
  HQ.HashQualified Name ->
  Cli ()
displayI :: OutputLocation -> HashQualified Name -> Cli ()
displayI OutputLocation
outputLoc HashQualified Name
hq = do
  let useRoot :: Bool
useRoot = (Name -> Bool) -> HashQualified Name -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Name -> Bool
Name.isAbsolute HashQualified Name
hq
  (Names
names, PrettyPrintEnvDecl
pped) <-
    if Bool
useRoot
      then do
        Branch IO
root <- Cli (Branch IO)
Cli.getCurrentProjectRoot
        let root0 :: Branch0 IO
root0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
root
        let names :: Names
names = Names -> Names
Names.makeAbsolute (Names -> Names) -> Names -> Names
forall a b. (a -> b) -> a -> b
$ Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
root0
        let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
suffixify Names
names)
        (Names, PrettyPrintEnvDecl) -> Cli (Names, PrettyPrintEnvDecl)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Names
names, PrettyPrintEnvDecl
pped)
      else do
        Names
names <- Cli Names
Cli.currentNames
        let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
suffixify Names
names)
        (Names, PrettyPrintEnvDecl) -> Cli (Names, PrettyPrintEnvDecl)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Names
names, PrettyPrintEnvDecl
pped)
  let suffixifiedPPE :: PrettyPrintEnv
suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped
  let bias :: [Name]
bias = Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
hq
  Maybe (TypecheckedUnisonFile Symbol Ann)
latestTypecheckedFile <- Cli (Maybe (TypecheckedUnisonFile Symbol Ann))
Cli.getLatestTypecheckedFile
  case String
-> Maybe (TypecheckedUnisonFile Symbol Ann)
-> Maybe (Symbol, TypecheckedUnisonFile Symbol Ann)
forall v.
Var v =>
String
-> Maybe (TypecheckedUnisonFile v Ann)
-> Maybe (v, TypecheckedUnisonFile v Ann)
addWatch (Text -> String
Text.unpack (HashQualified Name -> Text
HQ.toText HashQualified Name
hq)) Maybe (TypecheckedUnisonFile Symbol Ann)
latestTypecheckedFile of
    Maybe (Symbol, TypecheckedUnisonFile Symbol Ann)
Nothing -> do
      let results :: Set Referent
results = SearchType -> HashQualified Name -> Names -> Set Referent
Names.lookupHQTerm SearchType
Names.IncludeSuffixes HashQualified Name
hq Names
names
      Referent
ref <-
        Set Referent -> Maybe Referent
forall a. Set a -> Maybe a
Set.asSingleton Set Referent
results Maybe Referent -> (Maybe Referent -> Cli Referent) -> Cli Referent
forall a b. a -> (a -> b) -> b
& Cli Referent -> Maybe Referent -> Cli Referent
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing do
          Output -> Cli Referent
forall a. Output -> Cli a
Cli.returnEarly
            if Set Referent -> Bool
forall a. Set a -> Bool
Set.null Set Referent
results
              then [HashQualified Name] -> Output
SearchTermsNotFound [HashQualified Name
hq]
              else PrettyPrintEnv -> HashQualified Name -> Set Referent -> Output
TermAmbiguous PrettyPrintEnv
suffixifiedPPE HashQualified Name
hq Set Referent
results
      let tm :: Term Symbol Ann
tm = Ann -> Referent -> Term Symbol Ann
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.fromReferent Ann
External Referent
ref
      Term Symbol Ann
tm <- EvalMode
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Term Symbol Ann)
RuntimeUtils.evalUnisonTerm EvalMode
Sandboxed ([Name] -> PrettyPrintEnv -> PrettyPrintEnv
PPE.biasTo [Name]
bias (PrettyPrintEnv -> PrettyPrintEnv)
-> PrettyPrintEnv -> PrettyPrintEnv
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnv
suffixifiedPPE) Bool
True Term Symbol Ann
tm
      OutputLocation -> Names -> Term Symbol () -> Cli ()
doDisplay OutputLocation
outputLoc Names
names (Term Symbol Ann -> Term Symbol ()
forall vt at ap v a. Ord v => Term2 vt at ap v a -> Term0' vt v
Term.unannotate Term Symbol Ann
tm)
    Just (Symbol
toDisplay, TypecheckedUnisonFile Symbol Ann
unisonFile) -> do
      let namesWithDefinitionsFromFile :: Names
namesWithDefinitionsFromFile = TypecheckedUnisonFile Symbol Ann -> Names -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names -> Names
UF.addNamesFromTypeCheckedUnisonFile TypecheckedUnisonFile Symbol Ann
unisonFile Names
names
      let filePPED :: PrettyPrintEnvDecl
filePPED = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
namesWithDefinitionsFromFile) (Names -> Suffixifier
suffixify Names
namesWithDefinitionsFromFile)

      let suffixifiedFilePPE :: PrettyPrintEnv
suffixifiedFilePPE = [Name] -> PrettyPrintEnv -> PrettyPrintEnv
PPE.biasTo [Name]
bias (PrettyPrintEnv -> PrettyPrintEnv)
-> PrettyPrintEnv -> PrettyPrintEnv
forall a b. (a -> b) -> a -> b
$ PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
filePPED
      ([(Symbol, Term Symbol ())]
_, Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
watches) <-
        EvalMode
-> PrettyPrintEnv
-> TypecheckedUnisonFile Symbol Ann
-> [String]
-> Cli
     (Either
        Error
        ([(Symbol, Term Symbol ())],
         Map
           Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
evalUnisonFile EvalMode
Sandboxed PrettyPrintEnv
suffixifiedFilePPE TypecheckedUnisonFile Symbol Ann
unisonFile [] Cli
  (Either
     Error
     ([(Symbol, Term Symbol ())],
      Map
        Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
-> (Cli
      (Either
         Error
         ([(Symbol, Term Symbol ())],
          Map
            Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
    -> Cli
         ([(Symbol, Term Symbol ())],
          Map
            Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
-> Cli
     ([(Symbol, Term Symbol ())],
      Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
forall a b. a -> (a -> b) -> b
& (Error
 -> Cli
      ([(Symbol, Term Symbol ())],
       Map
         Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
-> Cli
     (Either
        Error
        ([(Symbol, Term Symbol ())],
         Map
           Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)))
-> Cli
     ([(Symbol, Term Symbol ())],
      Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM \Error
err ->
          Output
-> Cli
     ([(Symbol, Term Symbol ())],
      Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
forall a. Output -> Cli a
Cli.returnEarly (Error -> Output
Output.EvaluationFailure Error
err)
      (Ann
_, String
_, Id
_, Term Symbol ()
_, Term Symbol ()
tm, Bool
_) <-
        Symbol
-> Map
     Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
-> Maybe (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Symbol
toDisplay Map Symbol (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
watches Maybe (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
-> (Maybe (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
    -> Cli (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
-> Cli (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
forall a b. a -> (a -> b) -> b
& Cli (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
-> Maybe (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
-> Cli (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing (String
-> Cli (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
forall a. HasCallStack => String -> a
error (String
 -> Cli (Ann, String, Id, Term Symbol (), Term Symbol (), Bool))
-> String
-> Cli (Ann, String, Id, Term Symbol (), Term Symbol (), Bool)
forall a b. (a -> b) -> a -> b
$ String
"Evaluation dropped a watch expression: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (HashQualified Name -> Text
HQ.toText HashQualified Name
hq))
      let ns :: Names
ns = TypecheckedUnisonFile Symbol Ann -> Names -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names -> Names
UF.addNamesFromTypeCheckedUnisonFile TypecheckedUnisonFile Symbol Ann
unisonFile Names
names
      OutputLocation -> Names -> Term Symbol () -> Cli ()
doDisplay OutputLocation
outputLoc Names
ns Term Symbol ()
tm
  where
    suffixify :: Names -> Suffixifier
suffixify =
      case OutputLocation
outputLoc of
        OutputLocation
ConsoleLocation -> Names -> Suffixifier
PPE.suffixifyByHash
        FileLocation String
_ RelativeToFold
_ -> Names -> Suffixifier
PPE.suffixifyByHashName
        LatestFileLocation RelativeToFold
_ -> Names -> Suffixifier
PPE.suffixifyByHashName

docsI :: Name -> Cli ()
docsI :: Name -> Cli ()
docsI Name
src = do
  Cli ()
findInScratchfileByName
  where
    {- Given `docs foo`, we look for docs in 3 places, in this order:
       (fileByName) First check the file for `foo.doc`, and if found do `display foo.doc`
       (codebaseByName) Lastly check for `foo.doc` in the codebase and if found do `display foo.doc`
    -}
    dotDoc :: HQ.HashQualified Name
    dotDoc :: HashQualified Name
dotDoc = Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly (Name -> HashQualified Name)
-> (Name -> Name) -> Name -> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Name -> Name -> Name
Name -> Name -> Name
Name.joinDot Name
src (Name -> HashQualified Name) -> Name -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ NameSegment -> Name
Name.fromSegment NameSegment
NameSegment.docSegment

    findInScratchfileByName :: Cli ()
    findInScratchfileByName :: Cli ()
findInScratchfileByName = do
      Names
namesInFile <- Cli Names
Cli.getNamesFromLatestFile
      case SearchType -> HashQualified Name -> Names -> Set Referent
Names.lookupHQTerm SearchType
Names.IncludeSuffixes HashQualified Name
dotDoc Names
namesInFile of
        Set Referent
s | Set Referent -> Int
forall a. Set a -> Int
Set.size Set Referent
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> do
          -- the displayI command expects full term names, so we resolve
          -- the hash back to its full name in the file
          OutputLocation -> HashQualified Name -> Cli ()
displayI OutputLocation
ConsoleLocation (Int -> Referent -> Names -> HashQualified Name
Names.longestTermName Int
10 (Set Referent -> Referent
forall a. Set a -> a
Set.findMin Set Referent
s) Names
namesInFile)
        Set Referent
_ -> OutputLocation -> HashQualified Name -> Cli ()
displayI OutputLocation
ConsoleLocation HashQualified Name
dotDoc

lexedSource :: Text -> Text -> Cli (Text, [L.Token L.Lexeme])
lexedSource :: Text -> Text -> Cli (Text, [Token Lexeme])
lexedSource Text
name Text
src = do
  let tokens :: [Token Lexeme]
tokens = String -> String -> [Token Lexeme]
L.lexer (Text -> String
Text.unpack Text
name) (Text -> String
Text.unpack Text
src)
  (Text, [Token Lexeme]) -> Cli (Text, [Token Lexeme])
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
src, [Token Lexeme]
tokens)

parseSearchType :: SrcLoc -> String -> Cli (Type Symbol Ann)
parseSearchType :: String -> String -> Cli (Type Symbol Ann)
parseSearchType String
srcLoc String
typ = Type Symbol Ann -> Type Symbol Ann
forall v a. Var v => Type v a -> Type v a
Type.removeAllEffectVars (Type Symbol Ann -> Type Symbol Ann)
-> Cli (Type Symbol Ann) -> Cli (Type Symbol Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Cli (Type Symbol Ann)
parseType String
srcLoc String
typ

-- | A description of where the given parse was triggered from, for error messaging purposes.
type SrcLoc = String

parseType :: SrcLoc -> String -> Cli (Type Symbol Ann)
parseType :: String -> String -> Cli (Type Symbol Ann)
parseType String
input String
src = do
  -- `show Input` is the name of the "file" being lexed
  (Text, [Token Lexeme])
lexed <- Text -> Text -> Cli (Text, [Token Lexeme])
lexedSource (String -> Text
Text.pack String
input) (String -> Text
Text.pack String
src)
  Names
names <- Cli Names
Cli.currentNames
  let parsingEnv :: ParsingEnv Cli
parsingEnv =
        Parser.ParsingEnv
          { $sel:uniqueNames:ParsingEnv :: UniqueName
uniqueNames = UniqueName
forall a. Monoid a => a
mempty,
            $sel:uniqueTypeGuid:ParsingEnv :: Name -> Cli (Maybe Text)
uniqueTypeGuid = \Name
_ -> Maybe Text -> Cli (Maybe Text)
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing,
            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
          }
  Type Symbol Ann
typ <-
    String
-> ParsingEnv Cli -> Cli (Either (Err Symbol) (Type Symbol Ann))
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> ParsingEnv m -> m (Either (Err v) (Type v Ann))
Parsers.parseType (Text -> String
Text.unpack ((Text, [Token Lexeme]) -> Text
forall a b. (a, b) -> a
fst (Text, [Token Lexeme])
lexed)) ParsingEnv Cli
parsingEnv Cli (Either (Err Symbol) (Type Symbol Ann))
-> (Cli (Either (Err Symbol) (Type Symbol Ann))
    -> Cli (Type Symbol Ann))
-> Cli (Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& (Err Symbol -> Cli (Type Symbol Ann))
-> Cli (Either (Err Symbol) (Type Symbol Ann))
-> Cli (Type Symbol Ann)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM \Err Symbol
err ->
      Output -> Cli (Type Symbol Ann)
forall a. Output -> Cli a
Cli.returnEarly (String -> Err Symbol -> Output
TypeParseError String
src Err Symbol
err)

  (Symbol -> Name)
-> (Name -> Symbol)
-> Set Symbol
-> Names
-> Type Symbol Ann
-> ResolutionResult Ann (Type Symbol Ann)
forall a v.
Var v =>
(v -> Name)
-> (Name -> v)
-> Set v
-> Names
-> Type v a
-> ResolutionResult a (Type v a)
Type.bindNames Symbol -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Name -> Symbol
forall v. Var v => Name -> v
Name.toVar Set Symbol
forall a. Set a
Set.empty Names
names (Set Symbol -> Type Symbol Ann -> Type Symbol Ann
forall v a. Var v => Set v -> Type v a -> Type v a
Type.generalizeLowercase Set Symbol
forall a. Monoid a => a
mempty Type Symbol Ann
typ) ResolutionResult Ann (Type Symbol Ann)
-> (ResolutionResult Ann (Type Symbol Ann)
    -> Cli (Type Symbol Ann))
-> Cli (Type Symbol Ann)
forall a b. a -> (a -> b) -> b
& (Seq (ResolutionFailure Ann) -> Cli (Type Symbol Ann))
-> ResolutionResult Ann (Type Symbol Ann) -> Cli (Type Symbol Ann)
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft \Seq (ResolutionFailure Ann)
errs ->
    Output -> Cli (Type Symbol Ann)
forall a. Output -> Cli a
Cli.returnEarly (String -> [ResolutionFailure Ann] -> Output
ParseResolutionFailures String
src (Seq (ResolutionFailure Ann) -> [ResolutionFailure Ann]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (ResolutionFailure Ann)
errs))

-- Adds a watch expression of the given name to the file, if
-- it would resolve to a TLD in the file. Returns the freshened
-- variable name and the new typechecked file.
--
-- Otherwise, returns `Nothing`.
addWatch ::
  (Var v) =>
  String ->
  Maybe (TypecheckedUnisonFile v Ann) ->
  Maybe (v, TypecheckedUnisonFile v Ann)
addWatch :: forall v.
Var v =>
String
-> Maybe (TypecheckedUnisonFile v Ann)
-> Maybe (v, TypecheckedUnisonFile v Ann)
addWatch String
_watchName Maybe (TypecheckedUnisonFile v Ann)
Nothing = Maybe (v, TypecheckedUnisonFile v Ann)
forall a. Maybe a
Nothing
addWatch String
watchName (Just TypecheckedUnisonFile v Ann
uf) = do
  let components :: [(v, Ann, Term v Ann, Type v Ann)]
components = [[(v, Ann, Term v Ann, Type v Ann)]]
-> [(v, Ann, Term v Ann, Type v Ann)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(v, Ann, Term v Ann, Type v Ann)]]
 -> [(v, Ann, Term v Ann, Type v Ann)])
-> [[(v, Ann, Term v Ann, Type v Ann)]]
-> [(v, Ann, Term v Ann, Type v Ann)]
forall a b. (a -> b) -> a -> b
$ TypecheckedUnisonFile v Ann -> [[(v, Ann, Term v Ann, Type v Ann)]]
forall v a.
TypecheckedUnisonFile v a -> [[(v, a, Term v a, Type v a)]]
UF.topLevelComponents TypecheckedUnisonFile v Ann
uf
  let mainComponent :: [(v, Ann, Term v Ann, Type v Ann)]
mainComponent = ((v, Ann, Term v Ann, Type v Ann) -> Bool)
-> [(v, Ann, Term v Ann, Type v Ann)]
-> [(v, Ann, Term v Ann, Type v Ann)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((\v
v -> v -> String
forall v. Var v => v -> String
Var.nameStr v
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
watchName) (v -> Bool)
-> ((v, Ann, Term v Ann, Type v Ann) -> v)
-> (v, Ann, Term v Ann, Type v Ann)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting v (v, Ann, Term v Ann, Type v Ann) v
-> (v, Ann, Term v Ann, Type v Ann) -> v
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting v (v, Ann, Term v Ann, Type v Ann) v
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (v, Ann, Term v Ann, Type v Ann)
  (v, Ann, Term v Ann, Type v Ann)
  v
  v
_1) [(v, Ann, Term v Ann, Type v Ann)]
components
  case [(v, Ann, Term v Ann, Type v Ann)]
mainComponent of
    [(v
v, Ann
ann, Term v Ann
tm, Type v Ann
ty)] ->
      (v, TypecheckedUnisonFile v Ann)
-> Maybe (v, TypecheckedUnisonFile v Ann)
forall a. a -> Maybe a
Just ((v, TypecheckedUnisonFile v Ann)
 -> Maybe (v, TypecheckedUnisonFile v Ann))
-> (v, TypecheckedUnisonFile v Ann)
-> Maybe (v, TypecheckedUnisonFile v Ann)
forall a b. (a -> b) -> a -> b
$
        let v2 :: v
v2 = Set v -> v -> v
forall v. Var v => Set v -> v -> v
Var.freshIn ([v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [v
v]) v
v
            a :: Ann
a = Term v Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term v Ann
tm
         in ( v
v2,
              Map v (Id, DataDeclaration v Ann)
-> Map v (Id, EffectDeclaration v Ann)
-> [[(v, Ann, Term v Ann, Type v Ann)]]
-> [(String, [(v, Ann, Term v Ann, Type v Ann)])]
-> TypecheckedUnisonFile v Ann
forall v a.
Var v =>
Map v (Id, DataDeclaration v a)
-> Map v (Id, EffectDeclaration v a)
-> [[(v, a, Term v a, Type v a)]]
-> [(String, [(v, a, Term v a, Type v a)])]
-> TypecheckedUnisonFile v a
UF.typecheckedUnisonFile
                (TypecheckedUnisonFile v Ann -> Map v (Id, DataDeclaration v Ann)
forall v a.
TypecheckedUnisonFile v a -> Map v (Id, DataDeclaration v a)
UF.dataDeclarationsId' TypecheckedUnisonFile v Ann
uf)
                (TypecheckedUnisonFile v Ann -> Map v (Id, EffectDeclaration v Ann)
forall v a.
TypecheckedUnisonFile v a -> Map v (Id, EffectDeclaration v a)
UF.effectDeclarationsId' TypecheckedUnisonFile v Ann
uf)
                (TypecheckedUnisonFile v Ann -> [[(v, Ann, Term v Ann, Type v Ann)]]
forall v a.
TypecheckedUnisonFile v a -> [[(v, a, Term v a, Type v a)]]
UF.topLevelComponents' TypecheckedUnisonFile v Ann
uf)
                (TypecheckedUnisonFile v Ann
-> [(String, [(v, Ann, Term v Ann, Type v Ann)])]
forall v a.
TypecheckedUnisonFile v a
-> [(String, [(v, a, Term v a, Type v a)])]
UF.watchComponents TypecheckedUnisonFile v Ann
uf [(String, [(v, Ann, Term v Ann, Type v Ann)])]
-> [(String, [(v, Ann, Term v Ann, Type v Ann)])]
-> [(String, [(v, Ann, Term v Ann, Type v Ann)])]
forall a. Semigroup a => a -> a -> a
<> [(String
forall a. (Eq a, IsString a) => a
WK.RegularWatch, [(v
v2, Ann
ann, Ann -> v -> Term v Ann
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var Ann
a v
v, Type v Ann
ty)])])
            )
    [(v, Ann, Term v Ann, Type v Ann)]
_ -> String
-> Maybe (TypecheckedUnisonFile v Ann)
-> Maybe (v, TypecheckedUnisonFile v Ann)
forall v.
Var v =>
String
-> Maybe (TypecheckedUnisonFile v Ann)
-> Maybe (v, TypecheckedUnisonFile v Ann)
addWatch String
watchName Maybe (TypecheckedUnisonFile v Ann)
forall a. Maybe a
Nothing

resolveBranchId2 :: BranchId2 -> Cli (Branch IO)
resolveBranchId2 :: BranchId2 -> Cli (Branch IO)
resolveBranchId2 = \case
  Left ShortCausalHash
sch -> ShortCausalHash -> Cli (Branch IO)
Cli.resolveShortCausalHash ShortCausalHash
sch
  Right BranchRelativePath
brp -> do
    ProjectPath
pp <- BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
brp
    Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
    Branch IO -> Maybe (Branch IO) -> Branch IO
forall a. a -> Maybe a -> a
fromMaybe Branch IO
forall (m :: * -> *). Branch m
Branch.empty (Maybe (Branch IO) -> Branch IO)
-> Cli (Maybe (Branch IO)) -> Cli (Branch IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Branch IO)) -> Cli (Maybe (Branch IO))
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Codebase IO Symbol Ann -> ProjectPath -> IO (Maybe (Branch IO))
forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> ProjectPath -> m (Maybe (Branch m))
Codebase.getBranchAtProjectPath Codebase IO Symbol Ann
codebase ProjectPath
pp)