Merge pull request #1294 from unisonweb/topic/back

implements the `back` command using a stack of currentNamespace

parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs

@@ -16,7 +16,7 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE EmptyCase #-}
 
-module Unison.Codebase.Editor.HandleInput (loop, loopState0, LoopState(..), parseSearchType) where
+module Unison.Codebase.Editor.HandleInput (loop, loopState0, LoopState(..), currentPath, parseSearchType) where
 
 import Unison.Prelude
 
@@ -126,6 +126,8 @@ import qualified Unison.CommandLine.DisplayValues as DisplayValues
 import qualified Control.Error.Util as ErrorUtil
 import Unison.Codebase.GitError (GitError)
 import Unison.Util.Monoid (intercalateMap)
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as Nel
 
 type F m i v = Free (Command m i v)
 type Term v a = Term.AnnotatedTerm v a
@@ -140,7 +142,7 @@ data LoopState m v
   = LoopState
       { _root :: Branch m
       -- the current position in the namespace
-      , _currentPath :: Path.Absolute
+      , _currentPathStack :: NonEmpty Path.Absolute
 
       -- TBD
       -- , _activeEdits :: Set Branch.EditGuid
@@ -166,8 +168,12 @@ type InputDescription = Text
 
 makeLenses ''LoopState
 
+-- replacing the old read/write scalar Lens with "peek" Getter for the NonEmpty
+currentPath :: Getter (LoopState m v) Path.Absolute
+currentPath = currentPathStack . to Nel.head
+
 loopState0 :: Branch m -> Path.Absolute -> LoopState m v
-loopState0 b p = LoopState b p Nothing Nothing Nothing []
+loopState0 b p = LoopState b (pure p) Nothing Nothing Nothing []
 
 type Action' m v = Action m (Either Event Input) v
 
@@ -349,6 +355,7 @@ loop = do
           PreviewMergeLocalBranchI{} -> wat
           DiffNamespaceI{} -> wat
           SwitchBranchI{} -> wat
+          PopBranchI{} -> wat
           NamesI{} -> wat
           TodoI{} -> wat
           ListEditsI{} -> wat
@@ -678,10 +685,14 @@ loop = do
 
       SwitchBranchI path' -> do
         let path = resolveToAbsolute path'
-        currentPath .= path
+        currentPathStack %= Nel.cons path
         branch' <- getAt path
         when (Branch.isEmpty branch') (respond $ CreatedNewBranch path)
 
+      PopBranchI -> use (currentPathStack . to Nel.uncons) >>= \case
+        (_, Nothing) -> respond StartOfCurrentPathHistory
+        (_, Just t) -> currentPathStack .= t
+
       HistoryI resultsCap diffCap from -> case from of
         Left hash -> resolveShortBranchHash hash >>= \case
           Left output -> respond output

parser-typechecker/src/Unison/Codebase/Editor/Input.hs

@@ -54,6 +54,7 @@ data Input
     --          Does it make sense to fork from not-the-root of a Github repo?
     -- change directory
     | SwitchBranchI Path'
+    | PopBranchI
     -- > names foo
     -- > names foo.bar
     -- > names .foo.bar

parser-typechecker/src/Unison/Codebase/Editor/Output.hs

@@ -181,6 +181,7 @@ data Output v
   | PatchNeedsToBeConflictFree
   | PatchInvolvesExternalDependents PPE.PrettyPrintEnv (Set Reference)
   | WarnIncomingRootBranch (Set ShortBranchHash)
+  | StartOfCurrentPathHistory
   | History (Maybe Int) [(ShortBranchHash, Names.Diff)] HistoryTail
   | ShowReflog [ReflogEntry]
   | PullAlreadyUpToDate RemoteNamespace Path'
@@ -305,6 +306,7 @@ isFailure o = case o of
   NothingToPatch{} -> False
   WarnIncomingRootBranch{} -> False
   History{} -> False
+  StartOfCurrentPathHistory -> True
   NotImplemented -> True
   DumpNumberedArgs{} -> False
   DumpBitBooster{} -> False

parser-typechecker/src/Unison/Codebase/TranscriptParser.hs

@@ -44,6 +44,7 @@ import qualified Unison.Runtime.Rt1IO as Rt1
 import qualified Unison.Util.Pretty as P
 import qualified Unison.Util.TQueue as Q
 import qualified Unison.Codebase.Editor.Output as Output
+import Control.Lens (view)
 
 type ExpectingError = Bool
 data Hidden = Shown | HideOutput | HideAll
@@ -254,7 +255,7 @@ run dir configFile stanzas codebase = do
           "Run `ucm -codebase " <> Text.pack dir <> "` " <> "to do more work with it."]
 
       loop state = do
-        writeIORef pathRef (HandleInput._currentPath state)
+        writeIORef pathRef (view HandleInput.currentPath state)
         let free = runStateT (runMaybeT HandleInput.loop) state
             rng i = pure $ Random.drgNewSeed (Random.seedFromInteger (fromIntegral i)) 
         (o, state') <- HandleCommand.commandLine config awaitInput

parser-typechecker/src/Unison/CommandLine/InputPatterns.hs

@@ -474,6 +474,17 @@ cd = InputPattern "namespace" ["cd", "j"] [(Required, pathArg)]
       _ -> Left (I.help cd)
     )
 
+back :: InputPattern
+back = InputPattern "back" ["popd"] []
+    (P.wrapColumn2
+      [ (makeExample back [],
+          "undoes the last" <> makeExample' cd <> "command.")
+      ])
+    (\case
+      [] -> pure Input.PopBranchI
+      _ -> Left (I.help cd)
+    )
+
 deleteBranch :: InputPattern
 deleteBranch = InputPattern "delete.namespace" [] [(Required, pathArg)]
   "`delete.namespace <foo>` deletes the namespace `foo`"
@@ -1136,6 +1147,7 @@ validInputs =
   , createPullRequest
   , loadPullRequest
   , cd
+  , back
   , deleteBranch
   , renameBranch
   , deletePatch

parser-typechecker/src/Unison/CommandLine/Main.hs

@@ -45,6 +45,7 @@ import qualified Unison.CommandLine.InputPattern as IP
 import qualified Unison.Util.Pretty as P
 import qualified Unison.Util.TQueue as Q
 import Text.Regex.TDFA
+import Control.Lens (view)
 
 -- Expand a numeric argument like `1` or a range like `3-9`
 expandNumber :: [String] -> String -> [String]
@@ -232,7 +233,7 @@ main dir initialPath configFile initialInputs startRuntime codebase = do
         cancelFileSystemWatch
         cancelWatchBranchUpdates
       loop state = do
-        writeIORef pathRef (HandleInput._currentPath state)
+        writeIORef pathRef (view HandleInput.currentPath state)
         let free = runStateT (runMaybeT HandleInput.loop) state
         
         (o, state') <- HandleCommand.commandLine config awaitInput

parser-typechecker/src/Unison/CommandLine/OutputMessages.hs

@@ -873,7 +873,8 @@ notifyUser dir o = case o of
       ]
     ex = "Use" <> IP.makeExample IP.history ["#som3n4m3space"]
                <> "to view history starting from a given namespace hash."
-
+  StartOfCurrentPathHistory -> pure $
+    P.wrap "You're already at the very beginning! 🙂"
   PullAlreadyUpToDate ns dest -> pure . P.callout "😶" $
     P.wrap $ prettyPath' dest <> "was already up-to-date with"
           <> P.group (prettyRemoteNamespace ns <> ".")

unison-src/transcripts/cd-back.md

@@ -0,0 +1,46 @@
+## Switching between namespaces / projects / branches / modules
+
+Unison uses the same organizational element to represent directories, projects, sub-projects, forks, modules, etc.; currently called a "namespace".
+
+Namespaces are trees that contain definitions of "types" and "terms", "patches", and other child namespaces.
+
+We're still working out what a nice codebase layout might be (feel free to write up a blog post if you find one that works well for you), but in this example, we have these, along with their children (not shown):
+
+> .libs.base
+> .libs.megaparser.master
+> .libs.megaparser.v1
+> .libs.megaparser.v2
+> .arya.base
+> .arya.myproject
+> .pullrequests.runarorama.base_3.base
+> .pullrequests.runarorama.base_3.head
+> .pullrequests.runarorama.base_3.merged
+> .temp
+
+```ucm:hide
+.> builtins.merge
+.> move.namespace builtin .arya.base
+```
+
+```ucm
+.> cd arya.base
+.arya.base> find Boolean
+```
+```ucm:hide
+.arya.base> cd .arya.myproject
+```
+
+blah blah blah more stuff about project management and patches and the value of working from the appropriate namespace, and what that is in any given case
+
+We can pop back to the previous namespace with the `back` command.
+
+```ucm:hide
+.arya.myproject> back
+```
+```ucm:hide
+.arya.base> back
+```
+```ucm:error
+.> back
+```
+😬 Right, ok.

unison-src/transcripts/cd-back.output.md

@@ -0,0 +1,40 @@
+## Switching between namespaces / projects / branches / modules
+
+Unison uses the same organizational element to represent directories, projects, sub-projects, forks, modules, etc.; currently called a "namespace".
+
+Namespaces are trees that contain definitions of "types" and "terms", "patches", and other child namespaces.
+
+We're still working out what a nice codebase layout might be (feel free to write up a blog post if you find one that works well for you), but in this example, we have these, along with their children (not shown):
+
+> .libs.base
+> .libs.megaparser.master
+> .libs.megaparser.v1
+> .libs.megaparser.v2
+> .arya.base
+> .arya.myproject
+> .pullrequests.runarorama.base_3.base
+> .pullrequests.runarorama.base_3.head
+> .pullrequests.runarorama.base_3.merged
+> .temp
+
+```ucm
+.> cd arya.base
+
+.arya.base> find Boolean
+
+  1. builtin type Boolean
+  2. Boolean.not : Boolean -> Boolean
+  
+
+```
+blah blah blah more stuff about project management and patches and the value of working from the appropriate namespace, and what that is in any given case
+
+We can pop back to the previous namespace with the `back` command.
+
+```ucm
+.> back
+
+  You're already at the very beginning! 🙂
+
+```
+😬 Right, ok.