wip on getting end-to-end unison2 executable working

am working through InputPatterns2, fixing compile errors

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

@@ -19,7 +19,6 @@ data Event
 type Source = Text -- "id x = x\nconst a b = a"
 type SourceName = Text -- "foo.u" or "buffer 7"
 
-
 data Input
   -- names stuff:
     -- directory ops

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

@@ -162,6 +162,7 @@ minimalCodebaseStructure root =
   , typesDir root
   , branchesDir root
   , branchHeadDir root
+  , editsDir root
   ]
 
 -- checks if a minimal codebase structure exists at `path`

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

@@ -64,11 +64,18 @@ type HQSplitAbsolute = (Absolute, HQSegment)
 -- import .........apps.Notepad as Notepad
 -- Option1: a mix of . and /
 -- Option2: some / followed by some .
-parsePath :: Text -> Either String Path'
-parsePath = error "todo"
+parsePath' :: String -> Either String Path'
+parsePath' = error "todo"
+
+parseSplit' :: String -> Either String Split'
+parseSplit' = error "todo"
+
+parseHQSplit' :: String -> Either String HQSplit'
+parseHQSplit' = error "todo"
+
+parseHQ'Split' :: String -> Either String HQ'Split'
+parseHQ'Split' = error "todo"
 
-parseHashQualified :: Text -> Either String HQSplit'
-parseHashQualified = error "todo"
 -- this might be useful in implementing the above
 -- hqToPathSeg :: HashQualified -> (Path.Path', HQSegment)
 -- hqToPathSeg = \case
@@ -91,7 +98,10 @@ fromAbsoluteSplit :: (Absolute, a) -> (Path, a)
 fromAbsoluteSplit (Absolute p, a) = (p, a)
 
 absoluteEmpty :: Absolute
-absoluteEmpty = Absolute (Path mempty)
+absoluteEmpty = Absolute empty
+
+relativeEmpty' :: Path'
+relativeEmpty' = Path' (Right (Relative empty))
 
 toAbsolutePath :: Absolute -> Path' -> Absolute
 toAbsolutePath (Absolute cur) (Path' p) = case p of

parser-typechecker/src/Unison/CommandLine.hs

@@ -195,6 +195,16 @@ autoCompleteHashQualified b (HQ.fromString -> query) =
   makeCompletion (sr, p) =
     prettyCompletion (HQ.toString . SR.name $ sr, p)
 
+autoCompleteHashQualifiedTerm :: Branch0 -> String -> [Line.Completion]
+autoCompleteHashQualifiedTerm b (HQ.fromString -> query) =
+  [ prettyCompletion (HQ.toString . SR.name $ sr, p)
+  | (sr@(SR.Tm _), p) <- Find.prefixFindInBranch b query ]
+
+autoCompleteHashQualifiedType :: Branch0 -> String -> [Line.Completion]
+autoCompleteHashQualifiedType b (HQ.fromString -> query) =
+  [ prettyCompletion (HQ.toString . SR.name $ sr, p)
+  | (sr@(SR.Tp _), p) <- Find.prefixFindInBranch b query ]
+
 parseInput
   :: Map String InputPattern -> [String] -> Either (P.Pretty CT.ColorText) Input
 parseInput patterns ss = case ss of

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

@@ -0,0 +1,92 @@
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections       #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE ViewPatterns        #-}
+{-# LANGUAGE DoAndIfThenElse     #-}
+
+
+module Unison.CommandLine.InputPattern2 where
+
+import qualified System.Console.Haskeline       as Line
+import           Unison.Codebase                (Codebase)
+import           Unison.Codebase.Branch2        (Branch)
+import           Unison.Codebase.Editor.Input   (Input (..))
+import qualified Unison.Util.ColorText          as CT
+import qualified Unison.Util.Pretty             as P
+
+-- InputPatterns accept some fixed number of Required arguments of various
+-- types, followed by a variable number of a single type of argument.
+data IsOptional
+  = Required -- 1, at the start
+  | Optional -- 0 or 1, at the end
+  | ZeroPlus -- 0 or more, at the end
+  | OnePlus -- 1 or more, at the end
+  deriving Show
+
+data InputPattern = InputPattern
+  { patternName :: String
+  , aliases     :: [String]
+  , args        :: [(IsOptional, ArgumentType)]
+  , help        :: P.Pretty CT.ColorText
+  , parse       :: [String] -> Either (P.Pretty CT.ColorText) Input
+  }
+
+data ArgumentType = ArgumentType
+  { typeName :: String
+  , suggestions :: forall m v a . Monad m
+                => String
+                -> Codebase m v a
+                -> Branch m
+                -> m [Line.Completion]
+  }
+instance Show ArgumentType where
+  show at = "ArgumentType " <> typeName at
+
+-- `argType` gets called when the user tries to autocomplete an `i`th argument (zero-indexed).
+-- todo: would be nice if we could alert the user if they try to autocomplete
+-- past the end.  It would also be nice if
+argType :: InputPattern -> Int -> Maybe ArgumentType
+argType ip i = go (i, args ip) where
+  -- Strategy: all of these input patterns take some number of arguments.
+  -- If it takes no arguments, then don't autocomplete.
+  go (_, []) = Nothing
+  -- If requesting the 0th of >=1 arguments, return it.
+  go (0, (_, t) : _) = Just t
+  -- If requesting a later parameter, decrement and drop one.
+  go (n, (Required, _) : args) = go (n - 1, args)
+  -- Vararg parameters should appear at the end of the arg list, and work for
+  -- any later argument number.
+  go (_, (ZeroPlus, t) : []) = Just t
+  go (_, (OnePlus, t) : []) = Just t
+  -- Optional parameters only work at position 0, under this countdown scheme.
+  go (_, (Optional, _): []) = Nothing
+  -- The argument list spec is invalid if something follows optional or vararg
+  go _ = error $ "Input pattern " <> show (patternName ip)
+    <> " has an invalid argument list: " <> (show . fmap fst) (args ip)
+
+minArgs :: InputPattern -> Int
+minArgs ip@(fmap fst . args -> args) = go args where
+  go [] = 0
+  go (Required : args) = 1 + go args
+  go (_ : []) = 0
+  go _ = error $ "Invalid args for InputPattern ("
+                  <> show (patternName ip) <> "): " <> show args
+
+maxArgs :: InputPattern -> Maybe Int
+maxArgs ip@(fmap fst . args -> args) = go args where
+  go [] = Just 0
+  go (Required : args) = (1 +) <$> go args
+  go (Optional : []) = Just 0
+  go (_ : []) = Nothing
+  go _ = error $ "Invalid args for InputPattern ("
+                  <> show (patternName ip) <> "): " <> show args
+
+
+
+noSuggestions ::
+  Monad m => String -> Codebase m v a -> Branch m -> m [Line.Completion]
+noSuggestions _ _ _ = pure []
+

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

@@ -11,22 +11,25 @@
 module Unison.CommandLine.InputPatterns2 where
 
 -- import Debug.Trace
-import           Data.List                       (intercalate)
-import qualified Data.Set                        as Set
-import           Data.String                     (fromString)
-import qualified Data.Text                       as Text
-import qualified Unison.Codebase                 as Codebase
-import qualified Unison.Codebase.Branch          as Branch
-import           Unison.Codebase.Editor          (Input (..))
-import qualified Unison.Codebase.Editor          as E
-import           Unison.CommandLine
-import           Unison.CommandLine.InputPattern (ArgumentType (ArgumentType), InputPattern (InputPattern), IsOptional(Optional,Required,ZeroPlus,OnePlus))
-import qualified Unison.CommandLine.InputPattern as I
+import Data.Bifunctor (first)
+import Data.List (intercalate)
+import Data.String (fromString)
+import Unison.Codebase.Editor.Input (Input)
+import Unison.CommandLine
+import Unison.CommandLine.InputPattern2 (ArgumentType (ArgumentType), InputPattern (InputPattern), IsOptional(Optional,Required,ZeroPlus,OnePlus))
+import Unison.Util.Monoid (intercalateMap)
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+import qualified Unison.Codebase as Codebase
+import qualified Unison.Codebase.Branch2 as Branch
+import qualified Unison.Codebase.Editor.HandleInput as HI
+import qualified Unison.Codebase.Editor.Input as Input
+import qualified Unison.Codebase.Path as Path
+import qualified Unison.CommandLine.InputPattern2 as I
 import qualified Unison.HashQualified as HQ
-import qualified Unison.Names                    as Names
-import qualified Unison.Util.ColorText           as CT
-import           Unison.Util.Monoid              (intercalateMap)
-import qualified Unison.Util.Pretty              as P
+import qualified Unison.Names as Names
+import qualified Unison.Util.ColorText as CT
+import qualified Unison.Util.Pretty as P
 
 showPatternHelp :: InputPattern -> P.Pretty CT.ColorText
 showPatternHelp i = P.lines [
@@ -55,32 +58,48 @@ helpFor p = I.parse help [I.patternName p]
 updateBuiltins :: InputPattern
 updateBuiltins = InputPattern "builtins.update" [] []
   "Adds all the builtins that are missing from this branch, and deprecate the ones that don't exist in this version of Unison."
-  (const . pure $ UpdateBuiltinsI)
+  (const . pure $ Input.UpdateBuiltinsI)
 
 todo :: InputPattern
-todo = InputPattern "todo" [] []
+todo = InputPattern "todo"
+  []
+  [(Required, patchPathArg), (Optional, branchPathArg)]
   "`todo` lists the work remaining in the current branch to complete an ongoing refactoring."
-  (\ws -> if not $ null ws
-             then Left $ warn "`todo` doesn't take any arguments."
-             else pure $ TodoI)
+  (\ws -> case ws of
+    patchStr : ws -> first fromString $ do
+      patch <- Path.parseSplit' patchStr
+      branch <- case ws of
+        [pathStr] -> Path.parsePath' pathStr
+        _ -> pure Path.relativeEmpty'
+      pure $ Input.TodoI patch branch
+    [] -> Left $ warn "`todo` takes a patch and an optional path")
 
 add :: InputPattern
-add = InputPattern "add" [] []
+add = InputPattern "add" [] [(ZeroPlus, noCompletions)]
  "`add` adds to the codebase all the definitions from the most recently typechecked file."
- (\ws -> if not $ null ws
-   then Left $ warn "`add` doesn't take any arguments."
-   else pure $ SlurpFileI False)
+ (\ws -> pure $ Input.AddI (HQ.fromString <$> ws))
+
+update :: InputPattern
+update = InputPattern "update"
+  []
+  [(ZeroPlus, noCompletions)]
+  "`update` works like `add`, except if a definition in the file has the same name as an existing definition, the name gets updated to point to the new definition. If the old definition has any dependents, `update` will add those dependents to a refactoring session."
+  (\ws -> case ws of
+    patchStr : ws -> first fromString $ do
+      patch <- Path.parseSplit' patchStr
+      pure $ Input.UpdateI patch (HQ.fromString <$> ws)
+    [] -> Left $ warn "`update` takes a patch and an optional list of definitions")
 
 view :: InputPattern
 view = InputPattern "view" [] [(OnePlus, exactDefinitionQueryArg)]
       "`view foo` prints the definition of `foo`."
-      (pure . ShowDefinitionI E.ConsoleLocation)
+      (pure . Input.ShowDefinitionI Input.ConsoleLocation)
 
 viewByPrefix :: InputPattern
 viewByPrefix
   = InputPattern "view.recursive" [] [(OnePlus, exactDefinitionQueryArg)]
     "`view.recursive Foo` prints the definitions of `Foo` and `Foo.blah`."
-    (pure . ShowDefinitionRecursiveI E.ConsoleLocation)
+    (pure . Input.ShowDefinitionByPrefixI Input.ConsoleLocation)
 
 find :: InputPattern
 find = InputPattern "find" [] [(ZeroPlus, fuzzyDefinitionQueryArg)]
@@ -95,64 +114,58 @@ find = InputPattern "find" [] [(ZeroPlus, fuzzyDefinitionQueryArg)]
         , "lists all definitions with a name similar to 'foo' or 'bar' in the current branch, along with their hashes and aliases.")
       ]
     )
-    (pure . SearchByNameI)
+    (pure . Input.SearchByNameI)
 
-rename :: InputPattern
-rename = InputPattern "rename" ["mv"]
-    [(Required, exactDefinitionQueryArg)
+renameTerm :: InputPattern
+renameTerm = InputPattern "rename.term" []
+    [(Required, exactDefinitionTermQueryArg)
     ,(Required, noCompletions)]
-    "`rename foo bar` renames `foo` to `bar`."
+    "`rename.term foo bar` renames `foo` to `bar`."
     (\case
-      [oldName, newName] -> Right $ RenameUnconflictedI
-        allTargets
-        (fromString oldName)
-        (fromString newName)
+      [oldName, newName] -> first fromString $ do
+        src <- Path.parseHQ'Split' oldName
+        target <- Path.parseSplit' newName
+        pure $ Input.MoveTermI src target
       _ -> Left . P.warnCallout $ P.wrap
-        "`rename` takes two arguments, like `rename oldname newname`.")
+        "`rename.term` takes two arguments, like `rename oldname newname`.")
 
-unname :: InputPattern
-unname = InputPattern "unname" ["rm"]
-    [(OnePlus, exactDefinitionQueryArg)]
-    "`unname foo` removes the name `foo` from the namespace."
+deleteTerm :: InputPattern
+deleteTerm = InputPattern "delete.term" []
+    [(OnePlus, exactDefinitionTermQueryArg)]
+    "`delete.term foo` removes the term name `foo` from the namespace."
     (\case
-      [] -> Left . P.warnCallout $ P.wrap
-        "`unname` takes one or more arguments, like `unname name`."
-      (Set.fromList . fmap HQ.fromString -> query) -> Right $ UnnameAllI query
+      [query] -> first fromString $ do
+        p <- Path.parseHQ'Split' query
+        pure $ Input.DeleteTermI p
+      _ -> Left . P.warnCallout $ P.wrap
+        "`delete.term` takes one or more arguments, like `delete.term name`."
     )
 
-alias :: InputPattern
-alias = InputPattern "alias" ["cp"]
-    [(Required, exactDefinitionQueryArg), (Required, noCompletions)]
-    "`alias foo bar` introduces `bar` with the same definition as `foo`."
+aliasTerm :: InputPattern
+aliasTerm = InputPattern "alias.term" []
+    [(Required, exactDefinitionTermQueryArg), (Required, noCompletions)]
+    "`alias.term foo bar` introduces `bar` with the same definition as `foo`."
     (\case
-      [oldName, newName] -> Right $ AliasUnconflictedI
-        allTargets
-        (fromString oldName)
-        (fromString newName)
+      [oldName, newName] -> first fromString $ do
+        source <- Path.parseHQSplit' oldName
+        target <- Path.parseSplit' newName
+        pure $ Input.AliasTermI source target
       _ -> Left . warn $ P.wrap
-        "`alias` takes two arguments, like `alias oldname newname`."
+        "`alias.term` takes two arguments, like `alias.term oldname newname`."
     )
 
-update :: InputPattern
-update = InputPattern "update" [] []
-    "`update` works like `add`, except if a definition in the file has the same name as an existing definition, the name gets updated to point to the new definition. If the old definition has any dependents, `update` will add those dependents to a refactoring session."
-    (\ws -> if not $ null ws
-      then Left $ warn "`update` doesn't take any arguments."
-      else pure $ SlurpFileI True
-    )
-
-branch :: InputPattern
-branch = InputPattern "branch" [] [(Optional, branchArg)]
+cd :: InputPattern
+cd = InputPattern "cd" [] [(Required, branchArg)]
     (P.wrapColumn2
-      [ ("`branch`",     "lists all branches in the codebase.")
-      , ("`branch foo`", "switches to the branch named 'foo', creating it first if it doesn't exist.")
-      ]
-    )
+      [ ("`cd foo.bar`",
+          "descends into foo.bar from the current path.")
+      , ("`cd .cat.dog",
+          "sets the current path to the abolute path .cat.dog.") ])
     (\case
-      []  -> pure ListBranchesI
-      [b] -> pure . SwitchBranchI $ Text.pack b
-      _ -> Left . warn . P.wrap $  "Use `branch` to list all branches "
-             <> "or `branch foo` to switch to or create the branch 'foo'."
+      [p] -> first fromString $ do
+        p <- Path.parsePath' p
+        pure . Input.SwitchBranchI $ p
+      _ -> Left (I.help cd)
     )
 
 deleteBranch,replace,resolve :: InputPattern
@@ -205,8 +218,8 @@ validInputs =
   , view
   , InputPattern "edit" [] [(OnePlus, exactDefinitionQueryArg)]
       "`edit foo` prepends the definition of `foo` to the top of the most recently saved file."
-      (pure . ShowDefinitionI E.LatestFileLocation)
-  , rename
+      (pure . ShowDefinitionI Input.LatestFileLocation)
+  , renameTerm
   , unname
   , alias
   , update
@@ -262,5 +275,23 @@ exactDefinitionQueryArg =
   ArgumentType "definition query" $ \q _ (Branch.head -> b) -> do
     pure $ autoCompleteHashQualified b q
 
+exactDefinitionTypeQueryArg :: ArgumentType
+exactDefinitionTypeQueryArg =
+  ArgumentType "term definition query" $ \q _ (Branch.head -> b) -> do
+    pure $ autoCompleteHashQualifiedType b q
+
+exactDefinitionTermQueryArg :: ArgumentType
+exactDefinitionTermQueryArg =
+  ArgumentType "term definition query" $ \q _ (Branch.head -> b) -> do
+    pure $ autoCompleteHashQualifiedTerm b q
+
+patchPathArg :: ArgumentType
+patchPathArg = noCompletions { I.typeName = "patch" }
+  -- todo - better autocomplete provider here
+  -- ArgumentType "patch" $ \q ->
+
+branchPathArg :: ArgumentType
+branchPathArg = noCompletions { I.typeName = "branch" }
+
 noCompletions :: ArgumentType
 noCompletions = ArgumentType "word" I.noSuggestions

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

@@ -0,0 +1,158 @@
+{-# LANGUAGE DoAndIfThenElse     #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections       #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE ViewPatterns #-}
+
+
+module Unison.CommandLine.Main2 where
+
+import Control.Concurrent.STM (atomically)
+import Control.Exception (finally)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.State (runStateT)
+import Control.Monad.Trans (lift)
+import Control.Monad.Trans.Maybe (runMaybeT)
+import Data.IORef
+import Data.Map (Map)
+import Data.Maybe (fromMaybe)
+import Data.String (fromString)
+import Prelude hiding (readFile, writeFile)
+import Safe
+import Unison.Codebase.Branch (Branch)
+import Unison.Codebase.Editor (BranchName, Input (..))
+import Unison.Codebase.Runtime (Runtime)
+import Unison.Codebase2 (Codebase)
+import Unison.CommandLine
+import Unison.CommandLine.InputPattern (ArgumentType (suggestions), InputPattern (aliases, patternName))
+import Unison.CommandLine.InputPatterns2 (validInputs)
+import Unison.CommandLine.OutputMessages (notifyUser)
+import Unison.Parser (Ann)
+import Unison.Var (Var)
+import qualified Control.Concurrent.Async as Async
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+import qualified System.Console.Haskeline as Line
+import qualified Unison.Codebase.Editor as E
+import qualified Unison.Codebase.Editor.Actions as Actions
+import qualified Unison.Codebase.Runtime as Runtime
+import qualified Unison.Codebase2 as Codebase
+import qualified Unison.CommandLine.InputPattern2 as IP
+import qualified Unison.Util.Free as Free
+import qualified Unison.Util.Pretty as P
+import qualified Unison.Util.TQueue as Q
+
+getUserInput
+  :: (MonadIO m, Line.MonadException m)
+  => Map String InputPattern
+  -> Codebase m v a
+  -> Branch
+  -> BranchName
+  -> [String]
+  -> m Input
+getUserInput patterns codebase branch branchName numberedArgs =
+  Line.runInputT settings $ do
+    line <- Line.getInputLine $
+      P.toANSI 80 (P.green (P.text branchName <> fromString prompt))
+    case line of
+      Nothing -> pure QuitI
+      Just l -> case parseInput patterns . fmap expandNumber . words $ l of
+        Left msg -> lift $ do
+          liftIO $ putPrettyLn msg
+          getUserInput patterns codebase branch branchName numberedArgs
+        Right i -> pure i
+ where
+  expandNumber s = case readMay s of
+    Just i -> case atMay numberedArgs (i - 1) of
+      Just s -> s
+      Nothing -> show i
+    Nothing -> s
+  settings    = Line.Settings tabComplete (Just ".unisonHistory") True
+  tabComplete = Line.completeWordWithPrev Nothing " " $ \prev word ->
+    -- User hasn't finished a command name, complete from command names
+    if null prev
+      then pure $ fuzzyComplete word (Map.keys patterns)
+    -- User has finished a command name; use completions for that command
+      else case words $ reverse prev of
+        h : t -> fromMaybe (pure []) $ do
+          p       <- Map.lookup h patterns
+          argType <- IP.argType p (length t)
+          pure $ suggestions argType word codebase branch
+        _ -> pure []
+
+main
+  :: forall v
+   . Var v
+  => FilePath
+  -> BranchName
+  -> Maybe FilePath
+  -> IO (Runtime v)
+  -> Codebase IO v Ann
+  -> IO ()
+main dir currentBranchName _initialFile startRuntime codebase =
+  undefined
+  --do
+  --currentBranch <- Codebase.getBranch codebase currentBranchName
+  --eventQueue    <- Q.newIO
+  --currentBranch <- case currentBranch of
+  --  Nothing ->
+  --    Codebase.syncBranch codebase
+  --                        currentBranchName
+  --                        E.builtinBranch
+  --      <* (  putStrLn
+  --         $  "☝️  I found no branch named '"
+  --         <> Text.unpack currentBranchName
+  --         <> "' so I've created it for you."
+  --         )
+  --  Just b -> pure b
+  --do
+  --  runtime                  <- startRuntime
+  --  branchRef                <- newIORef (currentBranch, currentBranchName)
+  --  numberedArgsRef          <- newIORef []
+  --  cancelFileSystemWatch    <- watchFileSystem eventQueue dir
+  --  cancelWatchBranchUpdates <- watchBranchUpdates (readIORef branchRef)
+  --                                                 eventQueue
+  --                                                 codebase
+  --  let patternMap =
+  --        Map.fromList
+  --          $   validInputs
+  --          >>= (\p -> [(patternName p, p)] ++ ((, p) <$> aliases p))
+  --      getInput = do
+  --        (branch, branchName) <- readIORef branchRef
+  --        numberedArgs <- readIORef numberedArgsRef
+  --        getUserInput patternMap codebase branch branchName numberedArgs
+  --  let
+  --    awaitInput = do
+  --      -- Race the user input and file watch.
+  --      Async.race (atomically $ Q.peek eventQueue) getInput >>= \case
+  --        Left _ -> Left <$> atomically (Q.dequeue eventQueue)
+  --        x      -> pure x
+  --    cleanup = do
+  --      Runtime.terminate runtime
+  --      cancelFileSystemWatch
+  --      cancelWatchBranchUpdates
+  --    loop :: Actions.LoopState v -> IO ()
+  --    loop state = do
+  --      writeIORef
+  --        branchRef
+  --        (Actions._currentBranch state, Actions._currentBranchName state)
+  --      let free
+  --            :: Free.Free
+  --                 (E.Command (Either E.Event Input) v)
+  --                 (Maybe (), Actions.LoopState v)
+  --          free = runStateT (runMaybeT Actions.loop) state
+  --      (o, state') <- E.commandLine awaitInput
+  --                                   runtime
+  --                                   (notifyUser dir)
+  --                                   codebase
+  --                                   free
+  --      case o of
+  --        Nothing -> pure ()
+  --        Just () -> do
+  --          writeIORef numberedArgsRef (Actions._numberedArgs state')
+  --          loop state'
+  --  (`finally` cleanup)
+  --    $ loop (Actions.loopState0 currentBranch currentBranchName)

parser-typechecker/unison-parser-typechecker.cabal

@@ -75,8 +75,11 @@ library
     Unison.Codebase.Watch
     Unison.CommandLine
     Unison.CommandLine.InputPattern
+    Unison.CommandLine.InputPattern2
     Unison.CommandLine.InputPatterns
+    Unison.CommandLine.InputPatterns2
     Unison.CommandLine.Main
+    Unison.CommandLine.Main2
     Unison.CommandLine.OutputMessages
     Unison.CommandLine.OutputMessages2
     Unison.ConstructorType
@@ -237,6 +240,16 @@ executable unison
     safe,
     unison-parser-typechecker
 
+executable unison2
+  main-is: Main.hs
+  hs-source-dirs: unison2
+  ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures
+  build-depends:
+    base,
+    containers,
+    safe,
+    unison-parser-typechecker
+
 executable prettyprintdemo
   main-is: Main.hs
   hs-source-dirs: prettyprintdemo

parser-typechecker/unison2/Main.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Control.Monad ( when )
+import Safe ( headMay )
+import System.Environment ( getArgs )
+import Unison.Codebase.Serialization.V0 ( formatSymbol )
+import Unison.Parser ( Ann(External) )
+import qualified Unison.Codebase.Editor.HandleInput as HandleInput
+import qualified Unison.Codebase.FileCodebase2 as FileCodebase
+import qualified Unison.Codebase.Serialization as S
+import qualified Unison.CommandLine.Main2 as CommandLine
+import qualified Unison.Runtime.Rt1IO as Rt1
+
+main :: IO ()
+main = do
+  args <- getArgs
+  -- hSetBuffering stdout NoBuffering -- cool
+  let codebasePath  = ".unison/v0"
+      initialBranchName = "master"
+      scratchFilePath   = "."
+      theCodebase =
+        FileCodebase.codebase1 External formatSymbol formatAnn codebasePath
+      launch = CommandLine.main
+        scratchFilePath
+        initialBranchName
+        (headMay args)
+        (pure Rt1.runtime)
+        theCodebase
+  exists <- FileCodebase.exists codebasePath
+  when (not exists) $ do
+    putStrLn $ "☝️  No codebase exists here so I'm initializing one in: " <> codebasePath
+    FileCodebase.initialize codebasePath
+  -- Editor.initializeCodebase theCodebase
+  launch
+
+formatAnn :: S.Format Ann
+formatAnn = S.Format (pure External) (\_ -> pure ())