Human-centric let-rec, constructor and ability orderings

lib/unison-prelude/src/Unison/Util/List.hs

@@ -2,6 +2,8 @@ module Unison.Util.List where
 
 import Data.List qualified as List
 import Data.List.Extra qualified as List
+import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as NEL
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Unison.Prelude
@@ -13,23 +15,23 @@ multimap kvs =
   where
     step m (k, v) = Map.insertWith (++) k [v] m
 
-groupBy :: (Foldable f, Ord k) => (v -> k) -> f v -> Map k [v]
-groupBy f vs = reverse <$> foldl' step Map.empty vs
+groupBy :: (Foldable f, Ord k) => (v -> k) -> f v -> Map k (NonEmpty v)
+groupBy f vs = NEL.reverse <$> foldl' step Map.empty vs
   where
-    step m v = Map.insertWith (++) (f v) [v] m
+    step m v = Map.insertWith (<>) (f v) (NEL.singleton v) m
 
 -- | group _consecutive_ elements by a key.
 -- e.g.
 -- >>> groupMap (\n -> (odd n, show n)) [1, 3, 4, 6, 7]
 -- [(True,["1","3"]),(False,["4","6"]),(True,["7"])]
-groupMap :: (Foldable f, Eq k) => (a -> (k, b)) -> f a -> [(k, [b])]
+groupMap :: (Foldable f, Eq k) => (a -> (k, b)) -> f a -> [(k, NonEmpty b)]
 groupMap f xs =
   xs
     & toList
     & fmap f
     & List.groupOn fst
     -- head is okay since groupOn only returns populated lists.
-    <&> \grp -> (fst . head $ grp, snd <$> grp)
+    <&> \grp -> (fst . head $ grp, NEL.fromList (snd <$> grp))
 
 -- returns the subset of `f a` which maps to unique `b`s.
 -- prefers earlier copies, if many `a` map to some `b`.

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

@@ -99,6 +99,7 @@ module Unison.Codebase.Branch
 where
 
 import Control.Lens hiding (children, cons, transform, uncons)
+import Data.Foldable qualified as Foldable
 import Data.Map qualified as Map
 import Data.Monoid (Any (..))
 import Data.Semialign qualified as Align
@@ -508,7 +509,10 @@ batchUpdatesM ::
 batchUpdatesM (toList -> actions) curBranch = foldM execActions curBranch (groupActionsByLocation actions)
   where
     groupActionsByLocation :: [(Path, b)] -> [(ActionLocation, [(Path, b)])]
-    groupActionsByLocation = List.groupMap \(p, act) -> (pathLocation p, (p, act))
+    groupActionsByLocation xs =
+      xs
+        & List.groupMap (\(p, act) -> (pathLocation p, (p, act)))
+        <&> second Foldable.toList
 
     execActions ::
       ( Branch0 m ->

parser-typechecker/src/Unison/Syntax/DeclPrinter.hs

@@ -10,7 +10,9 @@ module Unison.Syntax.DeclPrinter
 where
 
 import Control.Monad.Writer (Writer, runWriter, tell)
+import Data.List qualified as List
 import Data.List.NonEmpty (pattern (:|))
+import Data.List.NonEmpty.Extra qualified as NEL
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Text qualified as Text
@@ -38,6 +40,7 @@ import Unison.Syntax.TypePrinter (runPretty)
 import Unison.Syntax.TypePrinter qualified as TypePrinter
 import Unison.Syntax.Var qualified as Var (namespaced)
 import Unison.Type qualified as Type
+import Unison.Util.List qualified as List
 import Unison.Util.Pretty (Pretty)
 import Unison.Util.Pretty qualified as P
 import Unison.Util.SyntaxText qualified as S
@@ -86,6 +89,7 @@ prettyEffectDecl ::
 prettyEffectDecl ppe guid r name = prettyGADT ppe guid CT.Effect r name . toDataDecl
 
 prettyGADT ::
+  forall v a.
   (Var v) =>
   PrettyPrintEnvDecl ->
   RenderUniqueTypeGuids ->
@@ -95,11 +99,12 @@ prettyGADT ::
   DataDeclaration v a ->
   Pretty SyntaxText
 prettyGADT env guid ctorType r name dd =
-  header <> P.newline <> P.indentN 2 constructors
+  header <> P.newline <> P.indentN 2 prettyConstructors
   where
-    constructors = P.lines (constructor <$> zip [0 ..] (DD.constructors' dd))
-    constructor (n, (_, _, t)) =
-      prettyPattern (PPED.unsuffixifiedPPE env) ctorType name (ConstructorReference r n)
+    prettyConstructors = P.lines (printConstructor <$> orderConstructors unsuffixifiedPPE r dd ctorType)
+    unsuffixifiedPPE = PPED.unsuffixifiedPPE env
+    printConstructor (n, (_, _, t)) =
+      prettyPattern unsuffixifiedPPE ctorType name (ConstructorReference r n)
         <> fmt S.TypeAscriptionColon " :"
           `P.hang` TypePrinter.prettySyntax (PPED.suffixifiedPPE env) t
     header = prettyEffectHeader guid name (DD.EffectDeclaration dd) <> fmt S.ControlKeyword " where"
@@ -122,7 +127,33 @@ prettyPattern env ctorType namespace ref =
   where
     conRef = Referent.Con ref ctorType
 
+-- Order Constructors alphabetically by name,
+-- regardless of their original order in the declaration.
+-- This is both nice for readability and ensures stable output in diffs, since otherwise
+-- constructors will jump around in order based on their hash.
+-- They'll be re-ordered by hash when parsed.
+orderConstructors :: (Var v) => PrettyPrintEnv -> TypeReference -> DataDeclaration v a -> CT.ConstructorType -> [(Word64, (a, v, Type.Type v a))]
+orderConstructors ppe r dd ctype =
+  zip [0 ..] (DD.constructors' dd)
+    -- First we sort by type to ensure that identical types are adjacent.
+    & List.sortOn (\(_n, (_a, _v, typ)) -> typ)
+    -- Now we group by type, we need to leave identical types in their constructor order to avoid things like
+    -- swapping identical constructors, e.g. False turning into True and vice versa.
+    & List.groupMap (\con@(_, (_, _, typ)) -> (typ, con))
+    -- Then we can sort those _groups_ by the name of the first constructor in the group.
+    & List.sortOn
+      ( \(_typ, group) ->
+          group
+            & NEL.sortOn fst
+            & \case
+              (n, (_, _, _)) :| _rest ->
+                PPE.termName ppe (Referent.Con (ConstructorReference r n) ctype)
+      )
+    -- Then we flatten back out to a list of constructors.
+    & foldMap (toList . snd)
+
 prettyDataDecl ::
+  forall v a.
   (Var v) =>
   PrettyPrintEnvDecl ->
   RenderUniqueTypeGuids ->
@@ -132,7 +163,7 @@ prettyDataDecl ::
   Writer (Set AccessorName) (Pretty SyntaxText)
 prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) guid r name dd =
   (header <>) . P.sep (fmt S.DelimiterChar (" | " `P.orElse` "\n  | "))
-    <$> constructor `traverse` zip [0 ..] (DD.constructors' dd)
+    <$> constructor `traverse` (orderConstructors unsuffixifiedPPE r dd CT.Data)
   where
     constructor (n, (_, _, Type.ForallsNamed' _ t)) = constructor' n t
     constructor (n, (_, _, t)) = constructor' n t

parser-typechecker/src/Unison/Syntax/TermPrinter.hs

@@ -695,8 +695,12 @@ printLetBindings ::
 printLetBindings context = \case
   LetBindings bindings -> traverse (printLetBinding context) bindings
   LetrecBindings bindings ->
-    let boundVars = map fst bindings
-     in traverse (printLetrecBinding context boundVars) bindings
+    -- We order let-rec bindings alphabetically rather than hash-ordered when printing
+    -- improve diffing alignment (and sanity). They'll be re-ordered back to hash order when
+    -- parsed.
+    let orderedBindings = sort bindings
+        boundVars = map fst orderedBindings
+     in traverse (printLetrecBinding context boundVars) orderedBindings
 
 printLetBinding :: (MonadPretty v m) => AmbientContext -> (v, Term3 v PrintAnnotation) -> m (Pretty SyntaxText)
 printLetBinding context (v, binding)

parser-typechecker/src/Unison/Syntax/TypePrinter.hs

@@ -18,6 +18,7 @@ module Unison.Syntax.TypePrinter
 where
 
 import Control.Monad.Reader (ask)
+import Data.List qualified as List
 import Data.Map qualified as Map
 import Unison.Builtin.Decls qualified as DD
 import Unison.HashQualified (HashQualified)
@@ -137,10 +138,16 @@ prettyRaw im p tp = go im p tp
                 <$> ((<>) <$> go im 0 fst <*> arrows False False rest)
         _ -> pure . fromString $ "bug: unexpected Arrow form in prettyRaw: " <> show t
       _ -> pure . fromString $ "bug: unexpected form in prettyRaw: " <> show tp
+    -- Sort effects in effect lists by how they're printed rather than hash,
+    -- this helps with both readability and diff alignment.
+    orderEffects :: [Type v a] -> [Type v a]
+    orderEffects = List.sort
+
+    effects :: Maybe [Type v a] -> m (Pretty (S.SyntaxText' Reference))
     effects Nothing = pure mempty
     effects (Just es) =
       PP.group . (fmt S.AbilityBraces "{" <>) . (<> fmt S.AbilityBraces "}")
-        <$> (PP.commas <$> traverse (go im 0) es)
+        <$> (PP.commas <$> traverse (go im 0) (orderEffects es))
     -- `first`: is this the first argument?
     -- `mes`: list of effects
     arrow delay first mes = do

unison-src/transcripts-using-base/all-base-hashes.output.md

@@ -3580,22 +3580,22 @@ This transcript is intended to make visible accidental changes to the hashing al
         ->{IO} [(Link.Term, Code)]
         
   991.  -- #srpc2uag5p1grvshbcm3urjntakgi3g3dthfse2cp38sd6uestd5neseces5ue7kum2ca0gsg9i0cilkl0gn8dn3q5dn86v4r8lbha0
-        compose : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g1, g} o
+        compose : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g, g1} o
         
   992.  -- #stnrk323b8mm7dknlonfl70epd9f9ede60iom7sgok31mmggnic7etgi0are2uccs9g429qo3ruaeb9tk90bh35obnce1038p5qe6co
         compose2 : (i2 ->{g2} o)
         -> (i1 ->{g1} i ->{g} i2)
         -> i1
         -> i
-        ->{g2, g1, g} o
+        ->{g, g1, g2} o
         
   993.  -- #mrc183aovjcae3i03r1a0ia26crmmkcf2e723pda860ps6q11rancsenjoqhc3fn0eraih1mobcvt245jr77l27uoujqa452utq8p68
         compose3 : (i3 ->{g3} o)
         -> (i2 ->{g2} i1 ->{g1} i ->{g} i3)
         -> i2
         -> i1
         -> i
-        ->{g3, g2, g1, g} o
+        ->{g, g1, g2, g3} o
         
   994.  -- #ilkeid6l866bmq90d2v1ilqp9dsjo6ucmf8udgrokq3nr3mo9skl2vao2mo7ish136as52rsf19u9v3jkmd85bl08gnmamo4e5v2fqo
         contains : Text -> Text -> Boolean
@@ -3954,7 +3954,7 @@ This transcript is intended to make visible accidental changes to the hashing al
         Throw.throw : e ->{Throw e} a
         
   1100. -- #f6pkvs6ukf8ngh2j8lm935p1bqadso76o7e3t0j1ukupjh1rg0m1rhtp7u492sq17p3bkbintbnjehc1cqs33qlhnfkoihf5uee4ug0
-        uncurry : (i1 ->{g1} i ->{g} o) -> (i1, i) ->{g1, g} o
+        uncurry : (i1 ->{g1} i ->{g} o) -> (i1, i) ->{g, g1} o
         
   1101. -- #u1o44hd0cdlfa8racf458sahdmgea409k8baajgc5k7bqukf2ak5ggs2ped0u3h85v99pgefgb9r7ct2dv4nn9eihjghnqf30p4l57g
         Value.transitiveDeps : Value ->{IO} [(Link.Term, Code)]

unison-src/transcripts-using-base/doc.output.md

@@ -342,7 +342,7 @@ and the rendered output using `display`:
 
     Unison definitions can be included in docs. For instance:
 
-        structural type Optional a = Some a | None
+        structural type Optional a = None | Some a
 
         sqr : Nat -> Nat
         sqr x =
@@ -351,7 +351,7 @@ and the rendered output using `display`:
 
     Some rendering targets also support folded source:
 
-        structural type Optional a = Some a | None
+        structural type Optional a = None | Some a
 
         sqr : Nat -> Nat
         sqr x =
@@ -658,7 +658,7 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub
 
       Unison definitions can be included in docs. For instance:
 
-          structural type Optional a = Some a | None
+          structural type Optional a = None | Some a
 
           sqr : Nat -> Nat
           sqr x =
@@ -667,7 +667,7 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub
 
       Some rendering targets also support folded source:
 
-          structural type Optional a = Some a | None
+          structural type Optional a = None | Some a
 
           sqr : Nat -> Nat
           sqr x =

unison-src/transcripts-using-base/serial-test-00.output.md

@@ -81,7 +81,7 @@ mkTestCase = do
                  -> (r ->{g2} r ->{g1} r)
                  -> (a ->{g} r)
                  -> Tree a
-                 ->{g2, g1, g} r
+                 ->{g, g1, g2} r
   + mkTestCase : '{IO, Exception} ()
   + tree0      : Tree Nat
   + tree1      : Tree Nat

unison-src/transcripts/idempotent/affine-handlers.md

@@ -145,7 +145,7 @@ count'test = do
   + looped       : '{g} r -> Nat ->{g} ()
   + now          : '{IO, Exception} TimeSpec
   + provide      : e -> Request {Env e} r -> r
-  + repeated     : Request {Repeat, g} () ->{g} ()
+  + repeated     : Request {g, Repeat} () ->{g} ()
   + testPerf     : '() ->{IO, Exception} Result
 
   Run `update` to apply these changes to your codebase.

unison-src/transcripts/idempotent/bug-strange-closure.md

@@ -101,7 +101,7 @@ We can display the guide before and after adding it to the codebase:
 
       Unison definitions can be included in docs. For instance:
 
-          structural type Optional a = Some a | None
+          structural type Optional a = None | Some a
 
           sqr : Nat -> Nat
           sqr x =
@@ -110,7 +110,7 @@ We can display the guide before and after adding it to the codebase:
 
       Some rendering targets also support folded source:
 
-          structural type Optional a = Some a | None
+          structural type Optional a = None | Some a
 
           sqr : Nat -> Nat
           sqr x =
@@ -306,7 +306,7 @@ We can display the guide before and after adding it to the codebase:
 
       Unison definitions can be included in docs. For instance:
 
-          structural type Optional a = Some a | None
+          structural type Optional a = None | Some a
 
           sqr : Nat -> Nat
           sqr x =
@@ -315,7 +315,7 @@ We can display the guide before and after adding it to the codebase:
 
       Some rendering targets also support folded source:
 
-          structural type Optional a = Some a | None
+          structural type Optional a = None | Some a
 
           sqr : Nat -> Nat
           sqr x =
@@ -520,7 +520,7 @@ rendered = Pretty.get (docFormatConsole doc.guide)
 
       Unison definitions can be included in docs. For instance:
 
-          structural type Optional a = Some a | None
+          structural type Optional a = None | Some a
 
           sqr : Nat -> Nat
           sqr x =
@@ -529,7 +529,7 @@ rendered = Pretty.get (docFormatConsole doc.guide)
 
       Some rendering targets also support folded source:
 
-          structural type Optional a = Some a | None
+          structural type Optional a = None | Some a
 
           sqr : Nat -> Nat
           sqr x =
@@ -725,7 +725,7 @@ rendered = Pretty.get (docFormatConsole doc.guide)
 
       Unison definitions can be included in docs. For instance:
 
-          structural type Optional a = Some a | None
+          structural type Optional a = None | Some a
 
           sqr : Nat -> Nat
           sqr x =
@@ -734,7 +734,7 @@ rendered = Pretty.get (docFormatConsole doc.guide)
 
       Some rendering targets also support folded source:
 
-          structural type Optional a = Some a | None
+          structural type Optional a = None | Some a
 
           sqr : Nat -> Nat
           sqr x =

unison-src/transcripts/idempotent/doc1.md

@@ -11,11 +11,11 @@ Unison documentation is written in Unison. Documentation is a value of the follo
 
   type lib.builtins.Doc
     = Blob Text
+    | Join [Doc]
     | Link Link
     | Source Link
     | Signature Link.Term
     | Evaluate Link.Term
-    | Join [Doc]
 ```
 
 You can create these `Doc` values with ordinary code, or you can use the special syntax. A value of structural type `Doc` can be created via syntax like:

unison-src/transcripts/idempotent/fix1063.md

@@ -15,7 +15,7 @@ noop = not `.` not
 ``` ucm :added-by-ucm
   Loading changes detected in scratch.u.
 
-  + (`.`) : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g1, g} o
+  + (`.`) : (i1 ->{g1} o) -> (i ->{g} i1) -> i ->{g, g1} o
   + noop  : Boolean -> Boolean
 
   Run `update` to apply these changes to your codebase.

unison-src/transcripts/idempotent/fix2254.md

@@ -80,15 +80,15 @@ scratch/a2> update
 scratch/a2> view A NeedsA f f2 f3 g
 
   type A a b c d
-    = E a d
+    = A a
     | B b
-    | A a
-    | D d
     | C c
+    | D d
+    | E a d
 
   structural type NeedsA a b
-    = Zoink Text
-    | NeedsA (A a b Nat Nat)
+    = NeedsA (A a b Nat Nat)
+    | Zoink Text
 
   f : A Nat Nat Nat Nat -> Nat
   f = cases