{-# 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
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.Text qualified as Text
import Data.Time (UTCTime)
import Data.Tuple.Extra (uncurry3)
import System.Directory (makeAbsolute)
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.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.AliasType (handleAliasType)
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.BranchSquash (handleBranchSquash)
import Unison.Codebase.Editor.HandleInput.Branches (handleBranches)
import Unison.Codebase.Editor.HandleInput.Cancel (handleCancel)
import Unison.Codebase.Editor.HandleInput.Config (handleConfigGet, handleConfigSet)
import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition
import Unison.Codebase.Editor.HandleInput.DebugDependentsGraph (handleDebugDependentsGraph)
import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFoldRanges
import Unison.Codebase.Editor.HandleInput.DebugSynhashTerm (handleDebugSynhashTerm)
import Unison.Codebase.Editor.HandleInput.Delete (handleDelete)
import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch)
import Unison.Codebase.Editor.HandleInput.DeleteNamespace (handleDeleteNamespace)
import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject)
import Unison.Codebase.Editor.HandleInput.Dependencies (handleDependencies)
import Unison.Codebase.Editor.HandleInput.Dependents (handleDependents)
import Unison.Codebase.Editor.HandleInput.DiffBranch (handleDiffBranch)
import Unison.Codebase.Editor.HandleInput.DiffUpdate qualified as DiffUpdate
import Unison.Codebase.Editor.HandleInput.EditDependents (handleEditDependents)
import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
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.History (handleHistory)
import Unison.Codebase.Editor.HandleInput.HistoryComment (handleHistoryComment)
import Unison.Codebase.Editor.HandleInput.InstallLib (handleInstallLib, handleInstallLocalLib)
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.MoveTo (handleMoveTo)
import Unison.Codebase.Editor.HandleInput.MoveType (doMoveType)
import Unison.Codebase.Editor.HandleInput.Names (handleNames)
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)
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.Rename (handleRename)
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.SyncV2 qualified as SyncV2
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.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.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.Codebase.Watch qualified as Watch
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.DataDeclaration qualified as DD
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.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.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 (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
import Prelude hiding (unzip)

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

loop :: Either Event Input -> Cli ()
loop :: Either Event Input -> Cli ()
loop Either Event Input
e = do
  env <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  case e of
    Left (UnisonFileChanged Text
sourceName Text
text) -> Text -> Cli () -> Cli ()
forall a. Text -> Cli a -> Cli a
Cli.time Text
"UnisonFileChanged" do
      -- We skip this update if it was programmatically generated and we aren't running a transcript
      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) | Bool -> Bool
not Env
env.isTranscriptTest -> ((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 ->
      Text -> Cli () -> Cli ()
forall a. Text -> Cli a -> Cli a
Cli.time Text
"InputPattern" case Input
input of
        -- this implementation will happily produce name conflicts,
        -- but will surface them in a normal diff at the end of the operation.
        AliasManyI [HashQualified (Split Path)]
srcs Path'
dest' -> do
          root0 <- Cli (Branch0 IO)
Cli.getCurrentProjectRoot0
          currentBranch0 <- Cli.getCurrentBranch0
          destPP <- Cli.resolvePath' dest'
          old <- Cli.getBranch0FromProjectPath destPP
          description <- inputDescription input
          let (unknown, actions) = foldl' (go root0 currentBranch0 (PP.absPath destPP)) mempty srcs
          Cli.stepManyAt destPP.branch description actions
          new <- Cli.getBranch0FromProjectPath destPP
          (ppe, diff) <- diffHelper old new
          Cli.respondNumbered (ShowDiffAfterModifyBranch dest' (destPP.absPath) ppe diff)
          when (not (null unknown)) do
            Cli.respond . SearchTermsNotFound . fmap fixupOutput $ unknown
          where
            -- a list of missing sources (if any) and the actions that do the work
            go ::
              Branch0 IO ->
              Branch0 IO ->
              Path.Absolute ->
              ([HQ'.HashQualified (Path.Split Path)], [(Path.Absolute, Branch0 m -> Branch0 m)]) ->
              HQ'.HashQualified (Path.Split Path) ->
              ([HQ'.HashQualified (Path.Split Path)], [(Path.Absolute, Branch0 m -> Branch0 m)])
            go :: forall (m :: * -> *).
Branch0 IO
-> Branch0 IO
-> Absolute
-> ([HashQualified (Split Path)],
    [(Absolute, Branch0 m -> Branch0 m)])
-> HashQualified (Split Path)
-> ([HashQualified (Split Path)],
    [(Absolute, Branch0 m -> Branch0 m)])
go Branch0 IO
root0 Branch0 IO
currentBranch0 Absolute
dest ([HashQualified (Split Path)]
missingSrcs, [(Absolute, Branch0 m -> Branch0 m)]
actions) HashQualified (Split Path)
hqsrc =
              let proposedDest :: Path.Split Path.Absolute
                  proposedDest :: Split Absolute
proposedDest = HashQualified (Split Absolute) -> Split Absolute
forall n. HashQualified n -> n
HQ'.toName HashQualified (Split Absolute)
hqProposedDest
                  hqProposedDest :: HQ'.HashQualified (Path.Split Path.Absolute)
                  hqProposedDest :: HashQualified (Split Absolute)
hqProposedDest = Absolute -> Split Path -> Split Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
dest (Split Path -> Split Absolute)
-> HashQualified (Split Path) -> HashQualified (Split Absolute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified (Split Path)
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 ( HashQualified (Split Path) -> Branch0 IO -> Set Reference
forall (m :: * -> *).
HashQualified (Split Path) -> Branch0 m -> Set Reference
BranchUtil.getType HashQualified (Split Path)
hqsrc Branch0 IO
currentBranch0,
                                  HashQualified (Split Path) -> Branch0 IO -> Set Reference
forall (m :: * -> *).
HashQualified (Split Path) -> Branch0 m -> Set Reference
BranchUtil.getType ((Absolute -> Path) -> Split Absolute -> Split Path
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 (Split Absolute -> Split Path)
-> HashQualified (Split Absolute) -> HashQualified (Split Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified (Split Absolute)
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 = Split Absolute -> Reference -> (Absolute, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> Reference -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTypeName Split Absolute
proposedDest Reference
r
                  doTerm :: Maybe [(Path.Absolute, Branch0 m -> Branch0 m)]
                  doTerm :: forall (m :: * -> *). Maybe [(Absolute, Branch0 m -> Branch0 m)]
doTerm = case HashQualified (Split Path) -> Branch0 IO -> Set Referent
forall (m :: * -> *).
HashQualified (Split Path) -> Branch0 m -> Set Referent
BranchUtil.getTerm HashQualified (Split Path)
hqsrc Branch0 IO
currentBranch0 of
                    (Set Referent -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null -> Bool
True) -> Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall a. Maybe a
Nothing -- missing src
                    Set Referent
rsrcs ->
                      [(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 -> [Referent])
-> (Set Referent -> Set Referent) -> Set Referent -> [Referent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Referent -> Set Referent -> Set Referent
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Referent
rsrcs (Set Referent -> Maybe [(Absolute, Branch0 m -> Branch0 m)])
-> Set Referent -> Maybe [(Absolute, Branch0 m -> Branch0 m)]
forall a b. (a -> b) -> a -> b
$
                        HashQualified (Split Path) -> Branch0 IO -> Set Referent
forall (m :: * -> *).
HashQualified (Split Path) -> Branch0 m -> Set Referent
BranchUtil.getTerm ((Absolute -> Path) -> Split Absolute -> Split Path
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 (Split Absolute -> Split Path)
-> HashQualified (Split Absolute) -> HashQualified (Split Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified (Split Absolute)
hqProposedDest) Branch0 IO
root0
                      where
                        addAlias :: Referent -> (Absolute, Branch0 m -> Branch0 m)
addAlias Referent
r = Split Absolute -> Referent -> (Absolute, Branch0 m -> Branch0 m)
forall p (m :: * -> *).
Split p -> Referent -> (p, Branch0 m -> Branch0 m)
BranchUtil.makeAddTermName Split Absolute
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) -> ([HashQualified (Split Path)]
missingSrcs [HashQualified (Split Path)]
-> HashQualified (Split Path) -> [HashQualified (Split Path)]
forall a b. Snoc a a b b => a -> b -> a
:> HashQualified (Split Path)
hqsrc, [(Absolute, Branch0 m -> Branch0 m)]
actions)
                    (Just [(Absolute, Branch0 m -> Branch0 m)]
as, Maybe [(Absolute, Branch0 m -> Branch0 m)]
Nothing) -> ([HashQualified (Split Path)]
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) -> ([HashQualified (Split Path)]
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) -> ([HashQualified (Split Path)]
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 :: HQ'.HashQualified (Path.Split Path) -> HQ.HashQualified Name
            fixupOutput :: HashQualified (Split Path) -> HashQualified Name
fixupOutput = HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (HashQualified Name -> HashQualified Name)
-> (HashQualified (Split Path) -> HashQualified Name)
-> HashQualified (Split Path)
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Split Path -> Name)
-> HashQualified (Split Path) -> HashQualified Name
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Split Path -> Name
forall path. Namey path => Split path -> Name
Path.nameFromSplit
        AliasTermI Bool
force HashOrHQ (Split Path')
src' Split Path'
dest' -> do
          src <- (HashQualified (Split Path')
 -> Cli (HashQualified (Split ProjectPath)))
-> HashOrHQ (Split Path')
-> Cli (Either ShortHash (HashQualified (Split 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 ShortHash a -> f (Either ShortHash b)
traverse ((Split Path' -> Cli (Split ProjectPath))
-> HashQualified (Split Path')
-> Cli (HashQualified (Split 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) -> HashQualified a -> f (HashQualified b)
traverse Split Path' -> Cli (Split ProjectPath)
Cli.resolveSplit') HashOrHQ (Split Path')
src'
          srcTerms <-
            either
              (Cli.runTransaction . Backend.termReferentsByShortHash env.codebase)
              Cli.getTermsAt
              src
          srcTerm <-
            Set.asSingleton srcTerms & onNothing do
              Cli.returnEarly =<< case (Set.null srcTerms, 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 HashQualified (Split Path')
name) -> Output -> Cli Output
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashQualified (Split Path') -> Output
TermNotFound HashQualified (Split Path')
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 HashQualified (Split Path')
name) -> do
                  hqLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.hashLength
                  pure (DeleteNameAmbiguous hqLength name srcTerms Set.empty)
          dest <- Cli.resolveSplit' dest'
          destTerms <- Cli.getTermsAt $ HQ'.NameOnly dest
          when (not force && not (Set.null destTerms)) do
            Cli.returnEarly (TermAlreadyExists dest' destTerms)
          description <- inputDescription input
          Cli.stepAt description (BranchUtil.makeAddTermName dest srcTerm)
          Cli.respond Success
        AliasTypeI Bool
force HashOrHQ (Split Path')
src Split Path'
dest -> Bool -> HashOrHQ (Split Path') -> Split Path' -> Cli ()
handleAliasType Bool
force HashOrHQ (Split Path')
src Split Path'
dest
        Input
ApiI -> do
          pp <- Cli ProjectPath
Cli.getCurrentProjectPath
          whenJust env.serverBaseUrl \BaseUrl
baseUrl ->
            Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$
              Pretty ColorText -> Output
Literal (Pretty ColorText -> Output) -> Pretty ColorText -> Output
forall a b. (a -> b) -> a -> b
$
                [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
                  [ Pretty ColorText
"The API information is as follows:",
                    Pretty ColorText
forall s. IsString s => Pretty s
P.newline,
                    Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty ColorText -> Pretty ColorText
P.hiBlue (Pretty ColorText
"UI: " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty ColorText
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.Root Maybe DefinitionReference
forall a. Maybe a
Nothing) BaseUrl
baseUrl))),
                    Pretty ColorText
forall s. IsString s => Pretty s
P.newline,
                    Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty ColorText -> Pretty ColorText
P.hiBlue (Pretty ColorText
"API: " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pretty.text (Service -> BaseUrl -> Text
Server.urlFor Service
Server.Api BaseUrl
baseUrl)))
                  ]
        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)
        BranchI BranchSourceI
source UnresolvedProjectBranch
name -> BranchSourceI -> UnresolvedProjectBranch -> Cli ()
handleBranch BranchSourceI
source UnresolvedProjectBranch
name
        BranchRenameI ProjectBranchName
name -> ProjectBranchName -> Cli ()
handleBranchRename ProjectBranchName
name
        BranchSquashI UnresolvedProjectBranch
branchToSquash UnresolvedProjectBranch
destBranch -> UnresolvedProjectBranch -> UnresolvedProjectBranch -> Cli ()
handleBranchSquash UnresolvedProjectBranch
branchToSquash UnresolvedProjectBranch
destBranch
        BranchesI Maybe ProjectName
name -> Maybe ProjectName -> Cli ()
handleBranches Maybe ProjectName
name
        Input
CancelI -> Cli ()
handleCancel
        Input
ClearI -> Output -> Cli ()
Cli.respond Output
ClearScreen
        CloneI ProjectAndBranchNames
remoteNames Maybe ProjectAndBranchNames
localNames -> ProjectAndBranchNames -> Maybe ProjectAndBranchNames -> Cli ()
handleClone ProjectAndBranchNames
remoteNames Maybe ProjectAndBranchNames
localNames
        ConfigGetI ConfigKey
key -> ConfigKey -> Cli ()
handleConfigGet ConfigKey
key
        ConfigSetI ConfigKey
key Text
value -> ConfigKey -> Text -> Cli ()
handleConfigSet ConfigKey
key Text
value
        CreateAuthorI NameSegment
authorNameSegment Text
authorFullName -> do
          initialBranch <- Cli (Branch IO)
Cli.getCurrentBranch
          AuthorInfo
            guid@(guidRef, _, _)
            author@(authorRef, _, _)
            copyrightHolder@(copyrightHolderRef, _, _) <-
            AuthorInfo.createAuthorInfo Ann.External authorFullName
          description <- inputDescription input
          -- add the new definitions to the codebase and to the namespace
          Cli.runTransaction (traverse_ (uncurry3 (Codebase.putTerm env.codebase)) [guid, author, copyrightHolder])
          authorPath <- Cli.resolveSplit' authorPath'
          copyrightHolderPath <-
            Cli.resolveSplit' (Path.descend base NameSegment.copyrightHoldersSegment, authorNameSegment)
          guidPath <- Cli.resolveSplit' (Path.unsplit authorPath', NameSegment.guidSegment)
          pb <- Cli.getCurrentProjectBranch
          Cli.stepManyAt
            pb
            description
            [ BranchUtil.makeAddTermName (first PP.absPath authorPath) (d authorRef),
              BranchUtil.makeAddTermName (first PP.absPath copyrightHolderPath) (d copyrightHolderRef),
              BranchUtil.makeAddTermName (first PP.absPath guidPath) (d guidRef)
            ]
          currentPath <- Cli.getCurrentPath
          finalBranch <- Cli.getCurrentBranch0
          (ppe, diff) <- diffHelper (Branch.head initialBranch) finalBranch
          Cli.respondNumbered $ ShowDiffAfterCreateAuthor authorNameSegment base currentPath ppe 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
            base :: Path'
base = Path' -> NameSegment -> Path'
forall path. Pathy path => path -> NameSegment -> path
Path.descend Path'
Path.Current' NameSegment
NameSegment.metadataSegment
            authorPath' :: Split Path'
authorPath' = (Path' -> NameSegment -> Path'
forall path. Pathy path => path -> NameSegment -> path
Path.descend Path'
base NameSegment
NameSegment.authorsSegment, NameSegment
authorNameSegment)
        CreateMessage Pretty ColorText
pretty -> Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> Output
Literal Pretty ColorText
pretty
        Input
DebugClearWatchI -> Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction ()
Codebase.clearWatches
        Input
DebugDependentsGraph -> Cli ()
handleDebugDependentsGraph
        Input
DebugDoctorI -> do
          r <- Transaction IntegrityResult -> Cli IntegrityResult
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction IntegrityResult
IntegrityCheck.integrityCheckFullCodebase
          Cli.respond (IntegrityCheck r)
        Input
DebugDumpNamespaceSimpleI -> do
          projectRootBranch0 <- Cli (Branch0 IO)
Cli.getCurrentProjectRoot0
          for_ (Relation.toList . Branch.deepTypes $ 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)
          for_ (Relation.toList . Branch.deepTerms $ 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)
        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 ())
-> (Text -> String) -> Text -> StateT (Set CausalHash) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> StateT (Set CausalHash) m ())
-> Text -> StateT (Set CausalHash) m ()
forall a b. (a -> b) -> a -> b
$ Width -> Pretty ColorText -> Text
P.toPlain Width
200 ((CausalHash, DumpNamespace) -> Pretty ColorText
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
          projectRoot <- Cli (Branch IO)
Cli.getCurrentProjectRoot
          void . liftIO . flip State.execStateT mempty $ goCausal [getCausal projectRoot]
        Input
DebugFormatI -> do
          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
            (filePath, _) <- Cli (Maybe (String, Bool)) -> MaybeT Cli (String, Bool)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT Cli (Maybe (String, Bool))
Cli.getLatestFile
            pf <- lift Cli.getLatestParsedFile
            tf <- lift Cli.getLatestTypecheckedFile
            names <- lift Cli.currentNames
            let 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
80
            currentPath <- lift $ Cli.getCurrentPath
            updates <- MaybeT $ Format.formatFile buildPPED formatWidth currentPath pf tf Nothing
            source <-
              liftIO (env.loadSource (Text.pack filePath)) >>= \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 = [TextReplacement] -> Text -> Text
Format.applyTextReplacements [TextReplacement]
updates Text
source
            liftIO $ env.writeSource (Text.pack filePath) updatedSource True
        DebugFuzzyOptionsI String
command [String]
args -> do
          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 Map.lookup command InputPatterns.patternMap of
            Just IP.InputPattern {Parameters
params :: Parameters
params :: InputPattern -> Parameters
params} ->
              (NonEmpty String -> Cli ())
-> (((), Parameters) -> Cli ())
-> Either (NonEmpty String) ((), Parameters)
-> Cli ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Output -> Cli ()
Cli.respond (Output -> Cli ())
-> (NonEmpty String -> Output) -> NonEmpty String -> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> Output
DebugFuzzyOptionsIncorrectArgs) (() -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Cli ())
-> (((), Parameters) -> ()) -> ((), Parameters) -> Cli ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), Parameters) -> ()
forall a b. (a, b) -> a
fst)
                (Either (NonEmpty String) ((), Parameters) -> Cli ())
-> Cli (Either (NonEmpty String) ((), Parameters)) -> Cli ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (() -> Parameter -> String -> Cli ((), [String]))
-> ()
-> Parameters
-> [String]
-> Cli (Either (NonEmpty String) ((), Parameters))
forall (m :: * -> *) state arg.
Monad m =>
(state -> Parameter -> arg -> m (state, [arg]))
-> state
-> Parameters
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
IP.foldParamsWithM
                  ( \()
_ (Text
paramName, IP.ParameterType {Maybe FZFResolver
fzfResolver :: Maybe FZFResolver
fzfResolver :: ParameterType -> Maybe FZFResolver
fzfResolver}) String
arg ->
                      if String
arg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"_"
                        then case Maybe FZFResolver
fzfResolver of
                          Just FZFResolver
IP.DefaultFZFFileSearch -> do
                            (,[]) (() -> ((), [String])) -> Cli () -> Cli ((), [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Output -> Cli ()
Cli.respond (Text -> [String] -> Output
DebugDisplayFuzzyOptions Text
paramName [String
"<files>"])
                          Just (IP.FetchOptions OptionFetcher
getOptions) -> do
                            pp <- Cli ProjectPath
Cli.getCurrentProjectPath
                            results <- liftIO $ getOptions env.codebase pp currentBranch
                            (,[]) <$> Cli.respond (DebugDisplayFuzzyOptions paramName (Text.unpack <$> results))
                          Maybe FZFResolver
Nothing -> (,[]) (() -> ((), [String])) -> Cli () -> Cli ((), [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Output -> Cli ()
Cli.respond Output
DebugFuzzyOptionsNoResolver
                        else ((), [String]) -> Cli ((), [String])
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), [])
                  )
                  ()
                  Parameters
params
                  [String]
args
            Maybe InputPattern
Nothing -> Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ String -> Output
DebugFuzzyOptionsNoCommand String
command
        Input
DebugLSPFoldRangesI -> Cli ()
DebugFoldRanges.debugFoldRanges
        DebugLSPNameCompletionI Text
prefix -> Text -> Cli ()
LSPDebug.debugLspNameCompletion Text
prefix
        DebugNameDiffI ShortCausalHash
fromSCH ShortCausalHash
toSCH -> do
          (fromCH, toCH) <-
            ((forall void. Output -> Transaction void)
 -> Transaction (CausalHash, CausalHash))
-> Cli (CausalHash, CausalHash)
forall a.
((forall void. Output -> Transaction void) -> Transaction a)
-> Cli a
Cli.runTransactionWithRollback \forall void. Output -> Transaction void
abort -> do
              fromCH <- (forall void. Output -> Transaction void)
-> ShortCausalHash -> Transaction CausalHash
Cli.resolveShortCausalHashToCausalHash Output -> Transaction void
forall void. Output -> Transaction void
abort ShortCausalHash
fromSCH
              toCH <- Cli.resolveShortCausalHashToCausalHash abort toSCH
              pure (fromCH, toCH)
          output <-
            Cli.runTransaction do
              fromBranch <- Codebase.expectCausalBranchByCausalHash fromCH >>= V2Causal.value
              toBranch <- Codebase.expectCausalBranchByCausalHash toCH >>= V2Causal.value
              treeDiff <- V2Branch.Diff.diffBranches fromBranch toBranch
              nameChanges <- V2Branch.Diff.allNameChanges Nothing treeDiff
              pure (DisplayDebugNameDiff nameChanges)
          Cli.respond output
        Input
DebugNumberedArgsI -> do
          schLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.branchHashLength
          numArgs <- use #numberedArgs
          Cli.respond (DumpNumberedArgs schLength numArgs)
        DebugSynhashTermI Name
name -> Name -> Cli ()
handleDebugSynhashTerm Name
name
        DebugTabCompletionI [String]
inputs -> do
          pp <- Cli ProjectPath
Cli.getCurrentProjectPath
          let 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 Env
env.codebase Env
env.authHTTPClient ProjectPath
pp
          (_, completions) <- liftIO $ completionFunc (reverse (unwords inputs), "")
          Cli.respond (DisplayDebugCompletions completions)
        DebugTermI Bool
isVerbose HashQualified Name
hqName -> Bool -> HashQualified Name -> Cli ()
DebugDefinition.debugTerm Bool
isVerbose HashQualified Name
hqName
        DebugTypeI HashQualified Name
hqName -> HashQualified Name -> Cli ()
DebugDefinition.debugDecl HashQualified Name
hqName
        Input
DebugTypecheckedUnisonFileI -> do
          hqLength <- Transaction Int -> Cli Int
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction Int
Codebase.hashLength
          uf <- Cli.expectLatestTypecheckedFile
          let datas, effects, terms :: [(Name, Reference.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 = [(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 = [(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]
          Cli.respond $ DumpUnisonFileHashes hqLength datas effects terms
        DeleteBranchI UnresolvedProjectBranch
name -> UnresolvedProjectBranch -> Cli ()
handleDeleteBranch UnresolvedProjectBranch
name
        DeleteI Bool
force DeleteTarget
which [HashQualified Name]
target -> Bool -> DeleteTarget -> [HashQualified Name] -> Cli ()
handleDelete Bool
force DeleteTarget
which [HashQualified Name]
target
        DeleteNamespaceI Insistence
insistence Maybe (Split Path)
path -> Input -> Insistence -> Maybe (Split Path) -> Cli ()
handleDeleteNamespace Input
input Insistence
insistence Maybe (Split Path)
path
        DeleteProjectI ProjectName
name -> ProjectName -> Cli ()
handleDeleteProject ProjectName
name
        DiffBranchI DiffBranchArg
alice DiffBranchArg
bob -> DiffBranchArg -> DiffBranchArg -> Cli ()
handleDiffBranch DiffBranchArg
alice DiffBranchArg
bob
        DiffNamespaceI BranchId2
before BranchId2
after -> do
          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
          beforeBranch0 <- Branch.head <$> resolveBranchId2 before
          afterLoc <- traverse ProjectUtils.resolveBranchRelativePath after
          afterBranch0 <- Branch.head <$> resolveBranchId2 after
          case (Branch.isEmpty0 beforeBranch0, Branch.isEmpty0 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 ()
          (ppe, diff) <- diffHelper beforeBranch0 afterBranch0
          Cli.respondNumbered (ShowDiffNamespace beforeLoc afterLoc ppe diff)
        DisplayI OutputLocation
outputLoc NonEmpty (HashQualified Name)
namesToDisplay -> (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
        DocsI NonEmpty Name
srcs -> 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
        DocsToHtmlI BranchRelativePath
namespacePath' String
sourceDirectory -> do
          projPath <- BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
namespacePath'
          branch <- Cli.getBranchFromProjectPath projPath
          _evalErrs <- liftIO $ (Backend.docsInBranchToHtmlFiles env.sandboxedRuntime env.codebase branch sourceDirectory)
          pure ()
        DocToMarkdownI Name
docName -> do
          names <- Cli Names
Cli.currentNames
          let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
          docRefs <- Cli.runTransaction do
            hqLength <- Codebase.hashLength
            let nameSearch = Int -> Names -> NameSearch Transaction
forall (m :: * -> *). Applicative m => Int -> Names -> NameSearch m
NameSearch.makeNameSearch Int
hqLength Names
names
            Backend.docsForDefinitionName env.codebase nameSearch Names.IncludeSuffixes docName
          mdText <- liftIO do
            for docRefs \Reference
docRef -> do
              Identity (_, _, doc, _evalErrs) <- PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> Identity Reference
-> IO (Identity (Text, Text, Doc, [DecompError]))
forall (t :: * -> *).
Traversable t =>
PrettyPrintEnvDecl
-> Width
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> t Reference
-> IO (t (Text, Text, Doc, [DecompError]))
Backend.renderDocRefs PrettyPrintEnvDecl
pped (Int -> Width
Pretty.Width Int
80) Env
env.codebase Env
env.runtime (Reference -> Identity Reference
forall a. a -> Identity a
Identity Reference
docRef)
              pure . Md.toText $ Md.toMarkdown doc
          Cli.respond $ Output.MarkdownOut (Text.intercalate "\n---\n" mdText)
        EditDependentsI HashQualified Name
name -> HashQualified Name -> Cli ()
handleEditDependents HashQualified Name
name
        EditNamespaceI [Path']
paths -> OutputLocation -> [Path'] -> Cli ()
handleEditNamespace (RelativeToFold -> OutputLocation
LatestFileLocation RelativeToFold
AboveFold) [Path']
paths
        ExecuteI ProfileSpec
prof HashQualified Name
main [String]
args -> ProfileSpec -> HashQualified Name -> [String] -> Cli ()
handleRun ProfileSpec
prof HashQualified Name
main [String]
args
        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
        ForkLocalBranchI BranchId2
src0 BranchRelativePath
dest0 -> do
          (srcb, 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
                srcPP <- BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
path'
                srcb <- Cli.getBranchFromProjectPath srcPP
                pure (srcb, WhichBranchEmptyPath srcPP)
          description <- inputDescription input
          dest <- ProjectUtils.resolveBranchRelativePath dest0
          ok <- Cli.updateAtM description dest (const $ pure srcb)
          Cli.respond
            if ok
              then Success
              else BranchEmpty branchEmpty
        HistoryI Maybe Int
resultsCap Maybe Int
diffCap BranchId
from -> do
          Maybe Int -> Maybe Int -> BranchId -> Cli ()
handleHistory Maybe Int
resultsCap Maybe Int
diffCap BranchId
from
        HistoryCommentI Maybe BranchId2
toAnnotate Maybe Text
message -> do
          Maybe BranchId2 -> Maybe Text -> Cli ()
handleHistoryComment Maybe BranchId2
toAnnotate Maybe Text
message
        Input
IOTestAllI -> Cli ()
Tests.handleAllIOTests
        IOTestI HashQualified Name
main -> HashQualified Name -> Cli ()
Tests.handleIOTest HashQualified Name
main
        LibInstallI Bool
remind ProjectAndBranch
  ProjectName (Maybe ProjectBranchNameOrLatestRelease)
libdep -> Bool
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
-> Cli ()
handleInstallLib Bool
remind ProjectAndBranch
  ProjectName (Maybe ProjectBranchNameOrLatestRelease)
libdep
        LibInstallLocalI ProjectAndBranch ProjectName ProjectBranchName
src Maybe NameSegment
destLibName -> ProjectAndBranch ProjectName ProjectBranchName
-> Maybe NameSegment -> Cli ()
handleInstallLocalLib ProjectAndBranch ProjectName ProjectBranchName
src Maybe NameSegment
destLibName
        ListDependenciesI HashQualified Name
hq -> HashQualified Name -> Cli ()
handleDependencies HashQualified Name
hq
        ListDependentsI HashQualified Name
hq -> HashQualified Name -> Cli ()
handleDependents HashQualified Name
hq
        LoadI Maybe String
maybePath -> Maybe String -> Cli ()
handleLoad Maybe String
maybePath
        MakeStandaloneI String
output HashQualified Name
main -> Bool -> String -> HashQualified Name -> Cli ()
doCompile Bool
False String
output HashQualified Name
main
        MergeBuiltinsI Maybe Path
opath -> do
          description <- Input -> Cli Text
inputDescription Input
input
          -- these were added once, but maybe they've changed and need to be
          -- added again.
          let 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, HasCallStack) =>
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
          Cli.runTransaction (Codebase.addDefsToCodebase env.codebase 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 = Names -> Branch IO
forall (m :: * -> *). Monad m => Names -> Branch m
BranchUtil.fromNames Names
Builtin.names
          currentPath <- Cli.getCurrentPath
          let destPath = case Maybe Path
opath of
                Just Path
path -> Absolute -> Path -> Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
currentPath Path
path
                Maybe Path
Nothing -> Absolute -> NameSegment -> Absolute
forall path. Pathy path => path -> NameSegment -> path
Path.descend Absolute
currentPath NameSegment
NameSegment.builtinSegment
          pp <- set PP.absPath_ destPath <$> Cli.getCurrentProjectPath
          _ <- Cli.updateAtM description 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 Env
env.codebase) MergeMode
Branch.RegularMerge Branch IO
srcb Branch IO
destb)
          Cli.respond Success
        Input
MergeCommitI ->
          Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"The `merge.commit` command has been removed in favor of `update`.")
        MergeI UnresolvedProjectBranch
branch -> UnresolvedProjectBranch -> Cli ()
handleMerge UnresolvedProjectBranch
branch
        MergeIOBuiltinsI Maybe Path
opath -> do
          description <- Input -> Cli Text
inputDescription Input
input
          -- these were added once, but maybe they've changed and need to be
          -- added again.
          let 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, HasCallStack) =>
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
          Cli.runTransaction do
            Codebase.addDefsToCodebase env.codebase uf
            -- these have not necessarily been added yet
            Codebase.addDefsToCodebase env.codebase 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
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 = Names -> Branch IO
forall (m :: * -> *). Monad m => Names -> Branch m
BranchUtil.fromNames Names
names0
          currentPath <- Cli.getCurrentPath
          let destPath = case Maybe Path
opath of
                Just Path
path -> Absolute -> Path -> Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
currentPath Path
path
                Maybe Path
Nothing -> Absolute -> NameSegment -> Absolute
forall path. Pathy path => path -> NameSegment -> path
Path.descend Absolute
currentPath NameSegment
NameSegment.builtinSegment
          pp <- set PP.absPath_ destPath <$> Cli.getCurrentProjectPath
          _ <- Cli.updateAtM description 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 Env
env.codebase) MergeMode
Branch.RegularMerge Branch IO
srcb Branch IO
destb)
          Cli.respond Success
        MoveAllI Path'
src' Path'
dest' -> do
          hasConfirmed <- Input -> Cli Bool
confirmedCommand Input
input
          desc <- inputDescription input
          handleMoveAll hasConfirmed src' dest' desc
        MoveBranchI Path'
src' Path'
dest' -> do
          hasConfirmed <- Input -> Cli Bool
confirmedCommand Input
input
          description <- inputDescription input
          doMoveBranch description hasConfirmed src' dest'
        MoveTermI HashQualified (Split Path')
src' Split Path'
dest' -> HashQualified (Split Path') -> Split Path' -> Text -> Cli ()
doMoveTerm HashQualified (Split Path')
src' Split Path'
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
        MoveToI NonEmpty Path'
sources Path'
dest -> NonEmpty Path' -> Path' -> Text -> Cli ()
handleMoveTo NonEmpty Path'
sources Path'
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 HashQualified (Split Path')
src' Split Path'
dest' -> HashQualified (Split Path') -> Split Path' -> Text -> Cli ()
doMoveType HashQualified (Split Path')
src' Split Path'
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
        NamesI Bool
global [(String, ErrorMessageOrName)]
queries -> ((String, ErrorMessageOrName) -> Cli ())
-> [(String, ErrorMessageOrName)] -> Cli ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> (String, ErrorMessageOrName) -> Cli ()
handleNames Bool
global) [(String, ErrorMessageOrName)]
queries
        RenameI Path'
src NameSegment
newNameSeg -> Path' -> NameSegment -> Text -> Cli ()
handleRename Path'
src NameSegment
newNameSeg (Text -> Cli ()) -> Cli Text -> Cli ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Input -> Cli Text
inputDescription Input
input
        NamespaceDependenciesI Maybe Path'
_ ->
          Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText -> Output
Output.Literal (Pretty ColorText -> Output) -> Pretty ColorText -> Output
forall a b. (a -> b) -> a -> b
$
              Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                Pretty ColorText
"The `namespace.dependencies` command has been replaced by `todo`. Run `todo` instead."
        Input
PopBranchI -> do
          success <- Cli Bool
Cli.popd
          when (not success) (Cli.respond StartOfCurrentPathHistory)
        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
        ProjectRenameI ProjectName
name -> ProjectName -> Cli ()
handleProjectRename ProjectName
name
        ProjectSwitchI ProjectAndBranchNames
name -> ProjectAndBranchNames -> Cli ()
projectSwitch ProjectAndBranchNames
name
        Input
ProjectsI -> Cli ()
handleProjects
        PullI PullSourceTarget
sourceTarget PullMode
pullMode -> PullSourceTarget -> PullMode -> Cli ()
handlePull PullSourceTarget
sourceTarget PullMode
pullMode
        PushRemoteBranchI PushRemoteBranchInput
pushRemoteBranchInput -> PushRemoteBranchInput -> Cli ()
handlePushRemoteBranch PushRemoteBranchInput
pushRemoteBranchInput
        Input
QuitI -> Cli ()
forall a. Cli a
Cli.haltRepl
        ReleaseDraftI Semver
semver -> Semver -> Cli ()
handleReleaseDraft Semver
semver
        ResetI BranchId2
newRoot Maybe UnresolvedProjectBranch
mtarget -> do
          newRoot <- BranchId2 -> Cli (Branch IO)
resolveBranchId2 BranchId2
newRoot
          target <-
            case mtarget of
              Maybe UnresolvedProjectBranch
Nothing -> Cli ProjectPath
Cli.getCurrentProjectPath
              Just UnresolvedProjectBranch
unresolvedProjectAndBranch -> do
                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 $ PP.projectBranchRoot targetProjectAndBranch
          description <- inputDescription input
          _ <- Cli.updateAt description target (const newRoot)
          Cli.respond Success
        SaveExecuteResultI Name
resultName -> Input -> Name -> Cli ()
handleAddRun Input
input Name
resultName
        ShowDefinitionI OutputLocation
outputLoc ShowDefinitionScope
showDefinitionScope NonEmpty (HashQualified Name)
query -> OutputLocation
-> ShowDefinitionScope -> NonEmpty (HashQualified Name) -> Cli ()
handleShowDefinition OutputLocation
outputLoc ShowDefinitionScope
showDefinitionScope NonEmpty (HashQualified Name)
query
        Input
ShowGlobalReflogI -> Cli ()
Reflogs.showGlobalReflog
        ShowProjectBranchReflogI Maybe UnresolvedProjectBranch
mayProjBranch -> Maybe UnresolvedProjectBranch -> Cli ()
Reflogs.showProjectBranchReflog Maybe UnresolvedProjectBranch
mayProjBranch
        ShowProjectReflogI Maybe ProjectName
mayProj -> Maybe ProjectName -> Cli ()
Reflogs.showProjectReflog Maybe ProjectName
mayProj
        Input
ShowRootReflogI -> do
          let numEntriesToShow :: Int
numEntriesToShow = Int
500
          (schLength, 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 = [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 = (([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 (shortEntries, numberedEntries) =
                unzip $
                  expandedEntries <&> \(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)
          Cli.setNumberedArgs numberedEntries
          Cli.respond $ ShowReflog 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
time :: forall causal text. Entry causal text -> UTCTime
time, CausalHash
fromRootCausalHash :: CausalHash
fromRootCausalHash :: forall causal text. Entry causal text -> causal
fromRootCausalHash, CausalHash
toRootCausalHash :: CausalHash
toRootCausalHash :: forall causal text. Entry causal text -> causal
toRootCausalHash, Text
reason :: Text
reason :: 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))
        StructuredFindI FindScope
_fscope HashQualified Name
ws -> HashQualified Name -> Cli ()
handleStructuredFindI HashQualified Name
ws
        StructuredFindReplaceI HashQualified Name
ws -> HashQualified Name -> Cli ()
handleStructuredFindReplaceI HashQualified Name
ws
        SwitchBranchI Path'
path' -> do
          path <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
path'
          branchExists <- Cli.branchExistsAtPath' path'
          when (not branchExists) (Cli.respond $ CreatedNewBranch (path ^. PP.absPath_))
          Cli.cd (path ^. PP.absPath_)
        SyncFromCodebaseI String
srcCodebasePath ProjectAndBranch ProjectName ProjectBranchName
srcBranch UnresolvedProjectBranch
destBranch -> do
          description <- Input -> Cli Text
inputDescription Input
input
          SyncV2.handleSyncFromCodebase description srcCodebasePath srcBranch destBranch
        SyncFromFileI String
syncFileSrc UnresolvedProjectBranch
projectBranchName -> do
          description <- Input -> Cli Text
inputDescription Input
input
          SyncV2.handleSyncFromFile description syncFileSrc projectBranchName
        SyncToFileI String
syncFileDest ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
projectBranchName -> String
-> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
-> Cli ()
SyncV2.handleSyncToFile String
syncFileDest ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)
projectBranchName
        TestI TestInput
testInput -> TestInput -> Cli ()
Tests.handleTest TestInput
testInput
        TextFindI Bool
allowLib [String]
ws -> Bool -> [String] -> Cli ()
handleTextFindI Bool
allowLib [String]
ws
        Input
TodoI -> Cli ()
handleTodo
        UiI Path'
path' -> Path' -> Cli ()
openUI Path'
path'
        Input
UndoI -> do
          rootBranch <- Cli (Branch IO)
Cli.getCurrentProjectRoot
          (_, prev) <-
            liftIO (Branch.uncons rootBranch) & onNothingM do
              Cli.returnEarly . CantUndo $
                if Branch.isOne rootBranch
                  then CantUndoPastStart
                  else CantUndoPastMerge
          description <- inputDescription input
          pb <- getCurrentProjectBranch
          Cli.updateProjectBranchRoot_ pb description (const prev)
          (ppe, diff) <- diffHelper (Branch.head prev) (Branch.head rootBranch)
          Cli.respondNumbered (Output.ShowDiffAfterUndo ppe diff)
        Input
UpI -> do
          path0 <- Cli Absolute
Cli.getCurrentPath
          whenJust (Path.ascend path0) Cli.cd
        Input
Update2I -> Cli ()
handleUpdate2
        Input
DiffUpdateI -> Cli ()
DiffUpdate.handleDiffUpdate
        Input
UpdateBuiltinsI -> Output -> Cli ()
Cli.respond Output
NotImplemented
        Input
UpgradeCommitI -> Output -> Cli ()
forall a. Output -> Cli a
Cli.returnEarly (Pretty ColorText -> Output
Output.Literal Pretty ColorText
"The `upgrade.commit` command has been removed in favor of `update`.")
        UpgradeI [NameSegment]
libs -> [NameSegment] -> Cli ()
handleUpgrade [NameSegment]
libs
        Input
VersionI -> Output -> Cli ()
Cli.respond (Output -> Cli ()) -> Output -> Cli ()
forall a b. (a -> b) -> a -> b
$ Text -> Output
PrintVersion Env
env.ucmVersion
        WatchI String
path -> case Env
env.watchState of
          Maybe WatchState
Nothing -> Output -> Cli ()
Cli.respond Output
Output.WatchDisabled
          Just WatchState
ws -> do
            result <- IO (Maybe String) -> Cli (Maybe String)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> Cli (Maybe String))
-> IO (Maybe String) -> Cli (Maybe String)
forall a b. (a -> b) -> a -> b
$ WatchState -> String -> IO (Maybe String)
Watch.watchPath WatchState
ws String
path
            Cli.respond $ Output.WatchAddResult result path
        UnwatchI [String]
paths -> case Env
env.watchState of
          Maybe WatchState
Nothing -> Output -> Cli ()
Cli.respond Output
Output.WatchDisabled
          Just WatchState
ws -> do
            -- Process each path and collect results
            results <- [String]
-> (String -> Cli (String, String, Bool))
-> Cli [(String, String, Bool)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [String]
paths \String
path -> do
              canonPath <- IO String -> Cli String
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Cli String) -> IO String -> Cli String
forall a b. (a -> b) -> a -> b
$ String -> IO String
makeAbsolute String
path
              success <- liftIO $ Watch.unwatchPath ws canonPath
              pure (path, canonPath, success)
            let (removed, failed) = List.partition (\(String
_, String
_, Bool
success) -> Bool
success) results
            let removedPaths = [String
canonPath | (String
_, String
canonPath, Bool
_) <- [(String, String, Bool)]
removed]
            let failedPaths = [String
path | (String
path, String
_, Bool
_) <- [(String, String, Bool)]
failed]
            remainingPaths <- liftIO $ Set.toList <$> Watch.getWatchedPaths ws
            Cli.respondNumbered $ Output.WatchRemoved removedPaths failedPaths remainingPaths
        Input
WatchListI -> case Env
env.watchState of
          Maybe WatchState
Nothing -> Output -> Cli ()
Cli.respond Output
Output.WatchDisabled
          Just WatchState
ws -> do
            watchedPaths <- IO [String] -> Cli [String]
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Cli [String]) -> IO [String] -> Cli [String]
forall a b. (a -> b) -> a -> b
$ Set String -> [String]
forall a. Set a -> [a]
Set.toList (Set String -> [String]) -> IO (Set String) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WatchState -> IO (Set String)
Watch.getWatchedPaths WatchState
ws
            Cli.respondNumbered $ Output.WatchList watchedPaths

inputDescription :: Input -> Cli Text
inputDescription :: Input -> Cli Text
inputDescription Input
input =
  case Input
input of
    AliasTermI Bool
force HashOrHQ (Split Path')
src0 Split Path'
dest0 -> do
      src <- HashOrHQ (Split Path') -> Cli Text
hhqs' HashOrHQ (Split Path')
src0
      dest <- ps' dest0
      pure ((if force then "debug.alias.term.force " else "alias.term ") <> src <> " " <> dest)
    AliasManyI [HashQualified (Split Path)]
srcs0 Path'
dest0 -> do
      srcs <- (HashQualified (Split Path) -> Cli Text)
-> [HashQualified (Split Path)] -> 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 HashQualified (Split Path) -> Cli Text
hqs [HashQualified (Split Path)]
srcs0
      dest <- p' dest0
      pure ("alias.many " <> Text.intercalate " " srcs <> " " <> dest)
    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)
    BranchSquashI {} -> Cli Text
wat
    Input
DebugFormatI -> Cli Text
wat
    DebugFuzzyOptionsI {} -> Cli Text
wat
    Input
DebugLSPFoldRangesI -> Cli Text
wat
    DebugTermI {} -> Cli Text
wat
    DebugTypeI {} -> Cli Text
wat
    DocToMarkdownI {} -> Cli Text
wat
    EditNamespaceI {} -> Cli Text
wat
    ExecuteI {} -> Cli Text
wat
    ForkLocalBranchI BranchId2
src0 BranchRelativePath
dest0 -> do
      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
      dest <- brp dest0
      pure ("fork " <> src <> " " <> dest)
    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 -> Text) -> Cli Text -> Cli Text
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
"builtins.merge " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Cli Text -> Cli Text) -> (Path' -> Cli Text) -> Path' -> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> Cli Text
p' (Path' -> Cli Text) -> Path' -> Cli Text
forall a b. (a -> b) -> a -> b
$ Path -> Path'
Path.RelativePath' 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 -> Text) -> Cli Text -> Cli Text
forall a b. (a -> b) -> Cli a -> Cli b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
"builtins.mergeio " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Cli Text -> Cli Text) -> (Path' -> Cli Text) -> Path' -> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> Cli Text
p' (Path' -> Cli Text) -> Path' -> Cli Text
forall a b. (a -> b) -> a -> b
$ Path -> Path'
Path.RelativePath' Path
path
    MoveAllI Path'
src0 Path'
dest0 -> do
      src <- Path' -> Cli Text
p' Path'
src0
      dest <- p' dest0
      pure ("move " <> src <> " " <> dest)
    MoveBranchI Path'
src0 Path'
dest0 -> do
      src <- Path' -> Cli Text
p' Path'
src0
      dest <- p' dest0
      pure ("move.namespace " <> src <> " " <> dest)
    MoveTermI HashQualified (Split Path')
src0 Split Path'
dest0 -> do
      src <- HashQualified (Split Path') -> Cli Text
hqs' HashQualified (Split Path')
src0
      dest <- ps' dest0
      pure ("move.term " <> src <> " " <> dest)
    MoveToI NonEmpty Path'
srcs0 Path'
dest0 -> do
      srcs <- (Path' -> Cli Text) -> [Path'] -> 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 Path' -> Cli Text
p' (NonEmpty Path' -> [Path']
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Path'
srcs0)
      dest <- p' dest0
      pure ("moveTo " <> Text.intercalate " " srcs <> " " <> dest)
    MoveTypeI HashQualified (Split Path')
src0 Split Path'
dest0 -> do
      src <- HashQualified (Split Path') -> Cli Text
hqs' HashQualified (Split Path')
src0
      dest <- ps' dest0
      pure ("move.type " <> src <> " " <> dest)
    RenameI Path'
src0 NameSegment
newSeg -> do
      src <- Path' -> Cli Text
p' Path'
src0
      pure ("rename " <> src <> " " <> NameSegment.toEscapedText newSeg)
    ResetI BranchId2
newRoot Maybe UnresolvedProjectBranch
tgt -> do
      hashTxt <- BranchId2 -> Cli Text
bid2 BranchId2
newRoot
      tgt <- case 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 ("reset " <> hashTxt <> tgt)
    SyncFromCodebaseI String
fp ProjectAndBranch ProjectName ProjectBranchName
srcBranch UnresolvedProjectBranch
destBranch -> do
      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
"sync.from-file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
srcBranch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text UnresolvedProjectBranch
destBranch
    SyncFromFileI String
fp UnresolvedProjectBranch
pab ->
      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
"sync.from-file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text UnresolvedProjectBranch
pab
    UndoI {} -> Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"undo"
    -- wat land
    AliasTypeI {} -> Cli Text
wat
    Input
ApiI -> Cli Text
wat
    AuthLoginI {} -> Cli Text
wat
    BranchI {} -> Cli Text
wat
    BranchRenameI {} -> Cli Text
wat
    BranchesI {} -> Cli Text
wat
    ClearI {} -> Cli Text
wat
    CloneI {} -> Cli Text
wat
    ConfigSetI {} -> Cli Text
wat
    ConfigGetI {} -> Cli Text
wat
    CreateMessage {} -> Cli Text
wat
    DebugClearWatchI {} -> Cli Text
wat
    Input
DebugDependentsGraph -> 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
    DeleteBranchI {} -> Cli Text
wat
    DeleteI {} -> Cli Text
wat
    DeleteNamespaceI {} -> Cli Text
wat
    DeleteProjectI {} -> Cli Text
wat
    DiffBranchI {} -> 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
    Input
IOTestAllI -> Cli Text
wat
    IOTestI {} -> Cli Text
wat
    HistoryCommentI {} -> Cli Text
wat
    LibInstallI {} -> Cli Text
wat
    LibInstallLocalI {} -> Cli Text
wat
    ListDependenciesI {} -> Cli Text
wat
    ListDependentsI {} -> Cli Text
wat
    LoadI {} -> Cli Text
wat
    MakeStandaloneI {} -> Cli Text
wat
    MergeCommitI {} -> Cli Text
wat
    MergeI {} -> Cli Text
wat
    NamesI {} -> Cli Text
wat
    NamespaceDependenciesI {} -> Cli Text
wat
    PopBranchI {} -> 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
    SaveExecuteResultI {} -> Cli Text
wat
    ShowDefinitionI {} -> Cli Text
wat
    ShowGlobalReflogI {} -> Cli Text
wat
    ShowProjectBranchReflogI {} -> Cli Text
wat
    ShowProjectReflogI {} -> Cli Text
wat
    ShowRootReflogI {} -> Cli Text
wat
    StructuredFindI {} -> Cli Text
wat
    StructuredFindReplaceI {} -> Cli Text
wat
    SwitchBranchI {} -> Cli Text
wat
    SyncToFileI {} -> Cli Text
wat
    TestI {} -> Cli Text
wat
    TextFindI {} -> Cli Text
wat
    TodoI {} -> Cli Text
wat
    UiI {} -> Cli Text
wat
    UpI {} -> Cli Text
wat
    Input
Update2I -> Cli Text
wat
    Input
DiffUpdateI -> Cli Text
wat
    Input
UpdateBuiltinsI -> Cli Text
wat
    UpgradeCommitI {} -> Cli Text
wat
    UpgradeI {} -> Cli Text
wat
    Input
VersionI -> Cli Text
wat
    WatchI {} -> Cli Text
wat
    UnwatchI {} -> Cli Text
wat
    Input
WatchListI -> Cli Text
wat
    Input
CancelI -> 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'
    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
    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' :: HQ'.HashOrHQ (Path.Split Path') -> Cli Text
    hhqs' :: HashOrHQ (Split Path') -> Cli Text
hhqs' = (ShortHash -> Cli Text)
-> (HashQualified (Split Path') -> Cli Text)
-> HashOrHQ (Split Path')
-> 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) -> (ShortHash -> Text) -> ShortHash -> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortHash -> Text
SH.toText) HashQualified (Split Path') -> Cli Text
hqs'
    hqs' :: HQ'.HashQualified (Path.Split Path') -> Cli Text
    hqs' :: HashQualified (Split Path') -> Cli Text
hqs' = Text -> Cli Text
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Cli Text)
-> (HashQualified (Split Path') -> Text)
-> HashQualified (Split Path')
-> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Split Path' -> Text) -> HashQualified (Split Path') -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ'.toTextWith (Path' -> Text
forall path. Pathy path => path -> Text
Path.toText (Path' -> Text) -> (Split Path' -> Path') -> Split Path' -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split Path' -> Path'
forall path. Pathy path => Split path -> path
Path.unsplit)
    hqs :: HashQualified (Split Path) -> Cli Text
hqs = HashQualified (Split Path') -> Cli Text
hqs' (HashQualified (Split Path') -> Cli Text)
-> (HashQualified (Split Path) -> HashQualified (Split Path'))
-> HashQualified (Split Path)
-> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Split Path -> Split Path')
-> HashQualified (Split Path) -> HashQualified (Split Path')
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Path -> Path') -> Split Path -> Split Path'
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 Path -> Path'
Path.RelativePath')
    ps' :: Split Path' -> Cli Text
ps' = Path' -> Cli Text
p' (Path' -> Cli Text)
-> (Split Path' -> Path') -> Split Path' -> Cli Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split Path' -> Path'
forall path. Pathy path => Split path -> 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} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  case fscope of
    FindLocal Path'
p -> do
      searchRoot <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
p
      branch0 <- Cli.getBranch0FromProjectPath searchRoot
      let filteredBranch = Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.withoutLib Branch0 IO
branch0
      let names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
filteredBranch
      -- Don't exclude anything from the pretty printer, since the type signatures we print for
      -- results may contain things in lib.
      currentNames <- Cli.currentNames
      let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
currentNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
currentNames)
      let suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
      results <- searchBranch0 codebase filteredBranch names
      if (null results)
        then do
          Cli.respond FindNoLocalMatches
          -- We've already searched everything else, so now we search JUST the
          -- names in lib.
          let 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 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
              -- Apply withoutTransitiveLibs to filter out transitive dependencies
              -- (lib.*.lib.*) while keeping direct dependencies (lib.*)
              let filteredLibBranch :: Branch0 IO
filteredLibBranch = Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.withoutTransitiveLibs Branch0 IO
onlyLibBranch
              let onlyLibNames :: Names
onlyLibNames = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
filteredLibBranch
              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
filteredLibBranch Names
onlyLibNames
              respondResults codebase suffixifiedPPE (Just p) results
        else respondResults codebase suffixifiedPPE (Just p) results
    FindLocalAndDeps Path'
p -> do
      searchRoot <- Path' -> Cli ProjectPath
Cli.resolvePath' Path'
p
      branch0 <- Cli.getBranch0FromProjectPath searchRoot
      let filteredBranch = Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.withoutTransitiveLibs Branch0 IO
branch0
      let names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames Branch0 IO
filteredBranch
      -- Don't exclude anything from the pretty printer, since the type signatures we print for
      -- results may contain things in lib.
      currentNames <- Cli.currentNames
      let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
currentNames) (Names -> Suffixifier
PPE.suffixifyByHash Names
currentNames)
      let suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
      results <- searchBranch0 codebase filteredBranch names
      respondResults codebase suffixifiedPPE (Just p) 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)
        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
        when (not $ null results) do
          Cli.setNumberedArgs $ fmap (SA.SearchResult Nothing) results
          results' <- Cli.runTransaction (Backend.loadSearchResults codebase results)
          Cli.respond $ GlobalFindBranchResults projAndBranchNames (PPED.suffixifiedPPE pped) isVerbose 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
searchBranch 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
          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 -> 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
searchBranch)
          (noExactTypeMatches, matches) <- do
            Cli.runTransaction do
              matches <- keepNamed <$> Codebase.termsOfType codebase typ
              if null matches
                then (True,) . keepNamed <$> Codebase.termsMentioningType codebase typ
                else pure (False, matches)
          when noExactTypeMatches (Cli.respond 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 isVerbose then uniqueBy SR.toReferent else id) $
              searchResultsFor names (Set.toList 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
      NumberedArgs -> Cli ()
Cli.setNumberedArgs (NumberedArgs -> Cli ()) -> NumberedArgs -> Cli ()
forall a b. (a -> b) -> a -> b
$ (SearchResult -> StructuredArgument)
-> [SearchResult] -> NumberedArgs
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
      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)
      Cli.respond $ ListOfDefinitions fscope ppe isVerbose results'

doDisplay :: OutputLocation -> Names -> Term Symbol () -> Cli ()
doDisplay :: OutputLocation -> Names -> Term Symbol () -> Cli ()
doDisplay OutputLocation
outputLoc Names
names Term Symbol ()
tm = do
  Cli.Env {codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  loopState <- State.get
  let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
suffixify Names
names)
  let suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPED.suffixifiedPPE PrettyPrintEnvDecl
pped
  (tms, typs) <- maybe mempty UF.indexByReference <$> Cli.getLatestTypecheckedFile
  let useCache = Bool
True
      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.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.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.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
  rendered <- DisplayValues.displayTerm pped loadTerm loadTypeOfTerm' evalTerm loadDecl tm
  mayFP <- case 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"
  whenJust 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 (Width -> Pretty ColorText -> Text
P.toPlain Width
80 (Pretty ColorText -> Text) -> Pretty ColorText -> Text
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
rendered)
  Cli.respond $ DisplayRendered mayFP 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
      exists <- String -> IO Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
Directory.doesFileExist String
filePath
      if exists
        then do
          existing <- readUtf8 filePath
          writeUtf8 filePath (txt <> "\n\n" <> existing)
        else do
          writeUtf8 filePath txt

confirmedCommand :: Input -> Cli Bool
confirmedCommand :: Input -> Cli Bool
confirmedCommand Input
i = do
  loopState <- Cli LoopState
forall s (m :: * -> *). MonadState s m => m s
State.get
  pure $ Just i == (loopState ^. #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)
forall path. Pathy path => path -> Maybe (Split path)
Path.split (Name -> Path
Path.fromName Name
n) of
  Maybe (Split Path)
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 -> String -> HQ.HashQualified Name -> Cli ()
doCompile :: Bool -> String -> HashQualified Name -> Cli ()
doCompile Bool
profile String
output HashQualified Name
main = do
  Cli.Env {codebase, runtime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  (_, ref, _, _) <- resolveMainRef "compile" main
  names <- Cli.currentNames
  let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  let ppe = PrettyPrintEnvDecl
pped.suffixifiedPPE
  let 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
output String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".uc"
      copts = CompileOpts
Runtime.defaultCompileOpts {Runtime.profile = profile}
  whenJustM
    ( liftIO $
        Runtime.compileTo runtime copts codeLookup ppe ref outf
    )
    (Cli.returnEarly . EvaluationFailure id)

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, pped) <-
    if Bool
useRoot
      then do
        root <- Cli (Branch IO)
Cli.getCurrentProjectRoot
        let root0 = Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
root
        let 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 = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
suffixify Names
names)
        pure (names, pped)
      else do
        names <- Cli Names
Cli.currentNames
        let pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
10 Names
names) (Names -> Suffixifier
suffixify Names
names)
        pure (names, pped)
  let suffixifiedPPE = PrettyPrintEnvDecl -> PrettyPrintEnv
PPE.suffixifiedPPE PrettyPrintEnvDecl
pped
  let 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
  latestTypecheckedFile <- Cli.getLatestTypecheckedFile
  case addWatch (Text.unpack (HQ.toText hq)) 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
      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 = 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
      tm <- RuntimeUtils.evalUnisonTerm Sandboxed (PPE.biasTo bias $ suffixifiedPPE) True tm
      doDisplay outputLoc names (Term.unannotate 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
      (_, 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 ((Pretty ColorText -> Pretty ColorText) -> Error -> Output
Output.EvaluationFailure Pretty ColorText -> Pretty ColorText
forall a. a -> a
id Error
err)
      (_, _, _, _, tm, _) <-
        Map.lookup toDisplay watches & onNothing (error $ "Evaluation dropped a watch expression: " <> Text.unpack (HQ.toText hq))
      let ns = TypecheckedUnisonFile Symbol Ann -> Names -> Names
forall v a. Var v => TypecheckedUnisonFile v a -> Names -> Names
UF.addNamesFromTypeCheckedUnisonFile TypecheckedUnisonFile Symbol Ann
unisonFile Names
names
      doDisplay outputLoc ns 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
  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
      namesInFile <- Cli Names
Cli.getNamesFromLatestFile
      case Names.lookupHQTerm Names.IncludeSuffixes dotDoc 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
  lexed <- Text -> Text -> Cli (Text, [Token Lexeme])
lexedSource (String -> Text
Text.pack String
input) (String -> Text
Text.pack String
src)
  names <- Cli.currentNames
  let parsingEnv =
        Parser.ParsingEnv
          { uniqueNames :: UniqueName
uniqueNames = UniqueName
forall a. Monoid a => a
mempty,
            uniqueTypeGuid :: 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
names :: Names
names,
            maybeNamespace :: Maybe Name
maybeNamespace = Maybe Name
forall a. Maybe a
Nothing,
            localNamespacePrefixedTypesAndConstructors :: Names
localNamespacePrefixedTypesAndConstructors = Names
forall a. Monoid a => a
mempty
          }
  typ <-
    Parsers.parseType (Text.unpack (fst lexed)) parsingEnv & 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)

  Type.bindNames Name.unsafeParseVar Name.toVar Set.empty names (Type.generalizeLowercase mempty typ) & 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, HasCallStack) =>
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
    pp <- BranchRelativePath -> Cli ProjectPath
ProjectUtils.resolveBranchRelativePath BranchRelativePath
brp
    Cli.Env {codebase} <- ask
    fromMaybe Branch.empty <$> liftIO (Codebase.getBranchAtProjectPath codebase pp)