Add current branch, current names, and current PPED cache

unison-cli/src/Unison/Cli/Monad.hs

@@ -14,6 +14,7 @@ module Unison.Cli.Monad
     -- * Immutable state
     LoopState (..),
     loopState0,
+    modifyLoopStateRootBranch,
 
     -- * Lifting IO actions
     ioE,
@@ -43,7 +44,8 @@ module Unison.Cli.Monad
   )
 where
 
-import Control.Lens (lens, (.=))
+import Control.Concurrent.Extra (once)
+import Control.Lens (lens, (.=), (^.))
 import Control.Monad.Reader (MonadReader (..), ReaderT (ReaderT))
 import Control.Monad.State.Strict (MonadState, StateT (StateT))
 import Control.Monad.Trans.Cont
@@ -62,14 +64,20 @@ import Unison.Auth.CredentialManager (CredentialManager)
 import Unison.Auth.HTTPClient (AuthenticatedHttpClient)
 import Unison.Codebase (Codebase)
 import Unison.Codebase.Branch (Branch)
+import qualified Unison.Codebase.Branch as Branch
+import qualified Unison.Codebase.Branch.Names as Branch
 import Unison.Codebase.Editor.Input (Input)
 import Unison.Codebase.Editor.Output (NumberedArgs, NumberedOutput, Output)
 import Unison.Codebase.Editor.UCMVersion (UCMVersion)
 import qualified Unison.Codebase.Path as Path
 import Unison.Codebase.Runtime (Runtime)
 import qualified Unison.Debug as Debug
+import Unison.Names (Names)
+import qualified Unison.NamesWithHistory as NamesWithHistory
 import Unison.Parser.Ann (Ann)
 import Unison.Prelude
+import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
+import qualified Unison.PrettyPrintEnvDecl.Names as PPED
 import qualified Unison.Server.CodebaseServer as Server
 import Unison.Symbol (Symbol)
 import qualified Unison.Syntax.Parser as Parser
@@ -151,6 +159,11 @@ data LoopState = LoopState
     lastSavedRootHash :: V2Branch.CausalHash,
     -- the current position in the namespace
     currentPathStack :: List.NonEmpty Path.Absolute,
+    currentBranch :: IO (Branch IO),
+    currentNames :: IO Names,
+    currentPPED :: IO PrettyPrintEnvDecl,
+    -- Hash length to use when generating ppes
+    hashLength :: Int,
     -- TBD
     -- , _activeEdits :: Set Branch.EditGuid
 
@@ -185,19 +198,52 @@ instance
           loopState {currentPathStack = path List.NonEmpty.:| paths}
       )
 
+modifyLoopStateRootBranch :: (Branch IO -> Branch IO) -> (LoopState -> IO (LoopState, Branch IO))
+modifyLoopStateRootBranch f ls = do
+  let rootVar = root ls
+  newRoot <- atomically do
+    root <- takeTMVar rootVar
+    let newRoot = f root
+    putTMVar rootVar $! newRoot
+    pure newRoot
+  ls' <- updateDerivedValues ls
+  pure (ls', newRoot)
+
+updateDerivedValues :: LoopState -> IO LoopState
+updateDerivedValues ls = do
+  let currentPath = ls ^. #currentPath
+  currentBranch <- once do
+    atomically do
+      rootBranch <- readTMVar (root ls)
+      pure $ Branch.getAt' (Path.unabsolute currentPath) rootBranch
+  let currentNames = Branch.toNames . Branch.head <$> currentBranch
+  let currentPPED = PPED.fromNamesDecl (hashLength ls) . NamesWithHistory.fromCurrentNames <$> currentNames
+  pure $ ls {currentBranch = currentBranch, currentNames = currentNames, currentPPED = currentPPED}
+
 -- | Create an initial loop state given a root branch and the current path.
-loopState0 :: V2Branch.CausalHash -> TMVar (Branch IO) -> Path.Absolute -> LoopState
-loopState0 lastSavedRootHash b p = do
-  LoopState
-    { root = b,
-      lastSavedRootHash = lastSavedRootHash,
-      currentPathStack = pure p,
-      latestFile = Nothing,
-      latestTypecheckedFile = Nothing,
-      lastInput = Nothing,
-      numberedArgs = [],
-      lastRunResult = Nothing
-    }
+loopState0 :: Int -> V2Branch.CausalHash -> TMVar (Branch IO) -> Path.Absolute -> IO LoopState
+loopState0 hashLength lastSavedRootHash b p = do
+  currentBranch <- once do
+    atomically do
+      rootBranch <- readTMVar b
+      pure $ Branch.getAt' (Path.unabsolute p) rootBranch
+  let currentNames = Branch.toNames . Branch.head <$> currentBranch
+  let currentPPED = PPED.fromNamesDecl hashLength . NamesWithHistory.fromCurrentNames <$> currentNames
+  pure $
+    LoopState
+      { root = b,
+        lastSavedRootHash = lastSavedRootHash,
+        currentPathStack = pure p,
+        currentBranch,
+        currentNames,
+        currentPPED,
+        hashLength,
+        latestFile = Nothing,
+        latestTypecheckedFile = Nothing,
+        lastInput = Nothing,
+        numberedArgs = [],
+        lastRunResult = Nothing
+      }
 
 -- | Run a @Cli@ action down to @IO@.
 runCli :: Env -> LoopState -> Cli a a -> IO (ReturnType a, LoopState)

unison-cli/src/Unison/Cli/MonadUtils.hs

@@ -22,6 +22,8 @@ module Unison.Cli.MonadUtils
     getRootBranch0,
     getCurrentBranch,
     getCurrentBranch0,
+    getCurrentNames,
+    getCurrentPPED,
     getBranchAt,
     getBranch0At,
     getLastSavedRootHash,
@@ -79,7 +81,7 @@ import qualified Data.Configurator.Types as Configurator
 import qualified Data.Set as Set
 import qualified U.Codebase.Branch as V2Branch
 import qualified U.Codebase.Causal as V2Causal
-import Unison.Cli.Monad (Cli)
+import Unison.Cli.Monad (Cli, LoopState)
 import qualified Unison.Cli.Monad as Cli
 import qualified Unison.Codebase as Codebase
 import Unison.Codebase.Branch (Branch (..), Branch0 (..))
@@ -97,8 +99,10 @@ import qualified Unison.Codebase.ShortBranchHash as SBH
 import qualified Unison.Codebase.SqliteCodebase.Conversions as Cv
 import qualified Unison.HashQualified' as HQ'
 import Unison.NameSegment (NameSegment)
+import Unison.Names (Names)
 import Unison.Parser.Ann (Ann (..))
 import Unison.Prelude
+import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
 import Unison.Reference (TypeReference)
 import Unison.Referent (Referent)
 import Unison.Symbol (Symbol)
@@ -182,18 +186,25 @@ setRootBranch b = do
 -- | Get the root branch.
 modifyRootBranch :: (Branch IO -> Branch IO) -> Cli r (Branch IO)
 modifyRootBranch f = do
-  rootVar <- use #root
-  atomically do
-    root <- takeTMVar rootVar
-    let newRoot = f root
-    putTMVar rootVar $! newRoot
-    pure newRoot
+  ls <- get
+  (ls', b) <- liftIO $ Cli.modifyLoopStateRootBranch f ls
+  put ls'
+  pure b
 
 -- | Get the current branch.
 getCurrentBranch :: Cli r (Branch IO)
 getCurrentBranch = do
-  path <- getCurrentPath
-  getBranchAt path
+  use #currentBranch >>= liftIO
+
+-- | Get the names for the current branch.
+getCurrentNames :: (MonadState LoopState m, MonadIO m) => m Names
+getCurrentNames = do
+  use #currentNames >>= liftIO
+
+-- | Get the names for the current branch.
+getCurrentPPED :: (MonadState LoopState m, MonadIO m) => m PrettyPrintEnvDecl
+getCurrentPPED = do
+  use #currentPPED >>= liftIO
 
 -- | Get the current branch0.
 getCurrentBranch0 :: Cli r (Branch0 IO)

unison-cli/src/Unison/Codebase/TranscriptParser.hs

@@ -235,9 +235,14 @@ run dir stanzas codebase runtime sbRuntime config ucmVersion baseURL = UnliftIO.
       ]
   initialRootCausalHash <- Codebase.getRootCausalHash codebase
   rootVar <- newEmptyTMVarIO
+  currentBranchVar <- newEmptyTMVarIO
+  currentPPEDVar <- newEmptyTMVarIO
   void $ Ki.fork scope do
     root <- Codebase.getRootBranch codebase
-    atomically $ putTMVar rootVar root
+    atomically $ do
+      putTMVar rootVar root
+      putTMVar currentBranchVar root
+      putTMVar currentPPEDVar root
   mayShareAccessToken <- fmap Text.pack <$> lookupEnv accessTokenEnvVarKey
   credMan <- AuthN.newCredentialManager
   let tokenProvider :: AuthN.TokenProvider
@@ -485,7 +490,9 @@ run dir stanzas codebase runtime sbRuntime config ucmVersion baseURL = UnliftIO.
             texts <- readIORef out
             pure $ Text.concat (Text.pack <$> toList (texts :: Seq String))
 
-  loop (Cli.loopState0 initialRootCausalHash rootVar initialPath)
+  hashLen <- Codebase.hashLength codebase
+  initState <- liftIO (Cli.loopState0 hashLen initialRootCausalHash rootVar initialPath)
+  loop initState
 
 transcriptFailure :: IORef (Seq String) -> Text -> IO b
 transcriptFailure out msg = do

unison-cli/src/Unison/CommandLine/Main.hs

@@ -117,7 +117,8 @@ main dir welcome initialPath (config, cancelConfig) initialInputs runtime sbRunt
     -- This might be overly aggressive, maybe we should just evaluate the top level but avoid
     -- recursive "deep*" things.
     void $ UnliftIO.evaluate root
-  let initialState = Cli.loopState0 initialRootCausalHash rootVar initialPath
+  hashLen <- Codebase.hashLength codebase
+  initialState <- liftIO (Cli.loopState0 hashLen initialRootCausalHash rootVar initialPath)
   Ki.fork_ scope $ do
     let loop lastRoot = do
           -- This doesn't necessarily notify on _every_ update, but the LSP only needs the

unison-cli/src/Unison/LSP/Types.hs

@@ -77,11 +77,11 @@ data FileAnalysis = FileAnalysis
   { fileUri :: !Uri,
     fileVersion :: !FileVersion,
     lexedSource :: LexedSource,
-    parsedFile :: ~Maybe (UF.UnisonFile Symbol Ann),
-    typecheckedFile :: ~Maybe (UF.TypecheckedUnisonFile Symbol Ann),
-    notes :: ~Seq (Note Symbol Ann),
-    diagnostics :: ~IntervalMap Position [Diagnostic],
-    codeActions :: ~IntervalMap Position [CodeAction]
+    parsedFile :: Maybe (UF.UnisonFile Symbol Ann),
+    typecheckedFile :: Maybe (UF.TypecheckedUnisonFile Symbol Ann),
+    notes :: Seq (Note Symbol Ann),
+    diagnostics :: IntervalMap Position [Diagnostic],
+    codeActions :: IntervalMap Position [CodeAction]
   }
   deriving (Show)