Merge branch 'wip/branchless' of github.com:unisonweb/unison into wip/branchless

parser-typechecker/src/Unison/Builtin2.hs

@@ -12,6 +12,7 @@ module Unison.Builtin2 where
 import           Control.Applicative            ( liftA2
                                                 -- , (<|>)
                                                 )
+import           Data.Bifunctor                 ( second )
 import           Data.Foldable                  ( foldl' )
 import           Data.Map                       ( Map )
 import qualified Data.Map                      as Map
@@ -98,7 +99,11 @@ parseType = error "todo" -- is `Names` something we want to keep using?
 
 names0 :: Names0
 names0 = Names terms types where
-  terms = Rel.mapRan Referent.Ref $ Rel.fromMap termNameRefs
+  terms = Rel.mapRan Referent.Ref (Rel.fromMap termNameRefs) <>
+    Rel.fromList [ (Name.fromVar vc, Referent.Con r cid)
+                 | (_,(r,decl)) <- builtinDataDecls @Symbol <>
+                    ((second . second) DD.toDataDecl <$> builtinEffectDecls)
+                 , ((_,vc,_), cid) <- DD.constructors' decl `zip` [0..]]
   types = Rel.fromList builtinTypes <>
     Rel.fromList [ (Name.fromVar v, r) | (v,(r,_)) <- builtinDataDecls @Symbol ] <>
     Rel.fromList [ (Name.fromVar v, r) | (v,(r,_)) <- builtinEffectDecls @Symbol ]

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

@@ -607,9 +607,9 @@ loop = do
       -- UpdateBuiltinsI -> do
       --   stepAt updateBuiltins
       --   checkTodo
-      -- ListEditsI -> do
-      --   (Branch.head -> b) <- use currentBranch
-      --   respond $ ListEdits b
+      ListEditsI (Path.toAbsoluteSplit currentPath' -> (p,seg)) -> do
+        patch <- eval . Eval . Branch.getPatch seg . Branch.head =<< getAt p
+        respond $ ListEdits patch (Branch.toNames0 currentBranch0)
       PullRemoteBranchI repo path -> do
         loadRemoteBranchAt repo $ Path.toAbsolutePath currentPath' path
         success

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

@@ -56,7 +56,7 @@ data Input
     | UpdateI EditPath [HashQualified]
     | TodoI EditPath Path'
     | PropagateI EditPath Path'
-    | ListEditsI EditPath Path'
+    | ListEditsI EditPath
     -- -- create and remove update directives
     | DeprecateTermI EditPath Path.HQ'Split'
     | DeprecateTypeI EditPath Path.HQ'Split'

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

@@ -96,7 +96,7 @@ data Output v
                        (Map Reference (DisplayThing (Term v Ann)))
   | TodoOutput Names0 (TodoOutput v Ann)
   | CantUndo UndoFailureReason
-  -- | ListEdits Edits Names
+  | ListEdits Patch Names0
 
   -- new/unrepresented references followed by old/removed
   -- todo: eventually replace these sets with [SearchResult' v Ann]

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

@@ -424,9 +424,14 @@ validInputs =
                else pure . Input.ExecuteI $ unwords ws)
   , quit
   , updateBuiltins
---  , InputPattern "edit.list" [] []
---      "Lists all the edits in the current branch."
---      (const . pure $ Input.ListEditsI)
+ , InputPattern "view.patch" [] [(Required, patchPathArg)]
+     "Lists all the edits in the given patch."
+     (\case
+       patchStr : [] -> first fromString $ do
+         patch <- Path.parseSplit' Path.wordyNameSegment patchStr
+         Right $ Input.ListEditsI patch
+       _ -> Left $ warn "`view.patch` takes a patch and that's it."
+       )
   ]
 
 allTargets :: Set.Set Names.NameTarget

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

@@ -235,6 +235,32 @@ notifyUser dir o = case o of
                     putPrettyLn' . P.wrap $ "I couldn't do a git checkout of "
                     <> P.text t <> ". Make sure there's a branch or commit "
                     <> "with that name."
+  ListEdits patch names0 -> do
+    let
+      ppe = PPE.fromNames0 names0
+      types = Patch._typeEdits patch
+      terms = Patch._termEdits patch
+
+      prettyTermEdit (r, TermEdit.Deprecate) =
+        (prettyHashQualified . PPE.termName ppe . Referent.Ref $ r
+        , "-> (deprecated)")
+      prettyTermEdit (r, TermEdit.Replace r' _typing) =
+        (prettyHashQualified . PPE.termName ppe . Referent.Ref $ r
+        , "-> " <> (prettyHashQualified . PPE.termName ppe . Referent.Ref $ r'))
+      prettyTypeEdit (r, TypeEdit.Deprecate) =
+        (prettyHashQualified $ PPE.typeName ppe r
+        , "-> (deprecated)")
+      prettyTypeEdit (r, TypeEdit.Replace r') =
+        (prettyHashQualified $ PPE.typeName ppe r
+        , "-> " <> (prettyHashQualified . PPE.typeName ppe $ r'))
+    when (not $ R.null types) $
+       putPrettyLn $ "Edited Types:" `P.hang`
+        P.column2 (prettyTypeEdit <$> R.toList types)
+    when (not $ R.null terms) $
+       putPrettyLn $ "Edited Terms:" `P.hang`
+        P.column2 (prettyTermEdit <$> R.toList terms)
+    when (R.null types && R.null terms)
+         (putPrettyLn "This patch is empty.")
   BustedBuiltins (Set.toList -> new) (Set.toList -> old) ->
     -- todo: this could be prettier!  Have a nice list like `find` gives, but
     -- that requires querying the codebase to determine term types.  Probably

unison-src/Base.u

@@ -19,6 +19,27 @@ andThen f g x = g (f x)
 const : a -> b -> a
 const a _ = a
 
+use Sequence take at size drop snoc cons ++
+
+use Nat + / 
+
+use Universal compare
+
+use Pair Pair
+
+namespace Tuple where
+  at1 : Pair a b -> a
+  at1 p = case p of Pair.Pair a b -> a
+
+  at2 : Pair a (Pair b c) -> b
+  at2 p = case p of (_, (b, _)) -> b
+
+  at3 : Pair a (Pair b (Pair c d)) -> c
+  at3 p = case p of (_, (_, (c, _))) -> c
+
+  at4 : Pair a (Pair b (Pair c (Pair d e))) -> d
+  at4 p = case p of (_, (_, (_, (d, _)))) -> d
+
 namespace Sequence where
 
   map : (a -> b) -> [a] -> [b]
@@ -73,7 +94,7 @@ namespace Sequence where
 
   sortBy : (a -> b) -> [a] -> [a]
   sortBy f as =
-    tweak p = (f (Tuple.at1 p), Tuple.at2 p, Tuple.at1 p)
+    tweak p = case p of (p1,p2) -> (f p1, p2, p1)
     Heap.sort (map tweak (indexed as)) |> map Tuple.at3
 
   halve : [a] -> ([a], [a])
@@ -95,7 +116,7 @@ namespace Sequence where
 
   unsnoc : [a] -> Optional ([a], a)
   unsnoc as =
-    i = size as `drop` 1
+    i = size (drop 1 as)
     case at i as of
       None -> None
       Some a -> Some (take i as, a)
@@ -168,20 +189,6 @@ namespace Search where
 -- > Sequence.map (e -> indexOf e ex) ex
 -- > lubIndexOf 193 ex
 
-use Pair Pair
-
-namespace Tuple where
-  at1 : Pair a b -> a
-  at1 p = case p of Pair a _ -> a
-
-  at2 : Pair a (Pair b c) -> b
-  at2 p = case p of Pair _ (Pair b _) -> b
-
-  at3 : Pair a (Pair b (Pair c d)) -> c
-  at3 p = case p of Pair _ (Pair _ (Pair c _)) -> c
-
-  at4 : Pair a (Pair b (Pair c (Pair d e))) -> d
-  at4 p = case p of Pair _ (Pair _ (Pair _ (Pair d _))) -> d
 
 (|>) : a -> (a -> b) -> b
 a |> f = f a
@@ -379,7 +386,8 @@ namespace Heap where
       Some a -> case b of
         None -> Some a
         Some b -> Some (union a b)
-    single kv = Some (singleton (Tuple.at1 kv) (Tuple.at2 kv))
+    single kv = case kv of 
+      (k, v) -> Some (singleton k v)
     Sequence.foldb single op None kvs
 
   fromKeys : [a] -> Optional (Heap a a)