Fix records to print with fieldnames

We were attempting to determine a type being a records, by looking
number of accessors and seeing if they matched a freshly generated
number of them. This was not working as we too eagerly removed type
prefixed names thus causing a mismatch.

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

@@ -312,7 +312,7 @@ displayDoc pped terms typeOf evaluated types = go
     Referent.Con r _ _ -> prettyType r
   prettyType r = let ppe = PPE.declarationPPE pped r in types r >>= \case
     Nothing -> pure $ "😶  Missing type source for: " <> typeName ppe r
-    Just ty -> pure . P.syntaxToColor $ P.group $ DP.prettyDecl ppe r (PPE.typeName ppe r) ty
+    Just ty -> pure . P.syntaxToColor $ P.group $ DP.prettyDecl pped r (PPE.typeName ppe r) ty
 
 termName :: PPE.PrettyPrintEnv -> Referent -> Pretty
 termName ppe r = P.syntaxToColor $

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

@@ -1150,7 +1150,7 @@ displayDefinitions' ppe0 types terms = P.syntaxToColor $ P.sep "\n\n" (prettyTyp
       BuiltinObject _ -> builtin n
       UserObject decl -> case decl of
         Left d  -> DeclPrinter.prettyEffectDecl (ppeBody r) r n d
-        Right d -> DeclPrinter.prettyDataDecl (ppeBody r) r n d
+        Right d -> DeclPrinter.prettyDataDecl (PPE.declarationPPEDecl ppe0 r) r n d
   builtin n = P.wrap $ "--" <> prettyHashQualified n <> " is built-in."
   missing n r = P.wrap (
     "-- The name " <> prettyHashQualified n <> " is assigned to the "

parser-typechecker/src/Unison/DeclPrinter.hs

@@ -19,6 +19,7 @@ import qualified Unison.Name                   as Name
 import           Unison.Name                    ( Name )
 import           Unison.NamePrinter             ( styleHashQualified'' )
 import           Unison.PrettyPrintEnv          ( PrettyPrintEnv )
+import           Unison.PrettyPrintEnvDecl     ( PrettyPrintEnvDecl(..) )
 import qualified Unison.PrettyPrintEnv         as PPE
 import qualified Unison.Referent               as Referent
 import           Unison.Reference               ( Reference(DerivedId) )
@@ -35,13 +36,13 @@ type SyntaxText = S.SyntaxText' Reference
 
 prettyDecl
   :: Var v
-  => PrettyPrintEnv
+  => PrettyPrintEnvDecl
   -> Reference
   -> HashQualified Name
   -> DD.Decl v a
   -> Pretty SyntaxText
-prettyDecl ppe r hq d = case d of
-  Left e -> prettyEffectDecl ppe r hq e
+prettyDecl ppe@(PrettyPrintEnvDecl unsuffixifiedPPE _) r hq d = case d of
+  Left e -> prettyEffectDecl unsuffixifiedPPE r hq e
   Right dd -> prettyDataDecl ppe r hq dd
 
 prettyEffectDecl
@@ -88,12 +89,12 @@ prettyPattern env ctorType ref namespace cid = styleHashQualified''
 
 prettyDataDecl
   :: Var v
-  => PrettyPrintEnv
+  => PrettyPrintEnvDecl
   -> Reference
   -> HashQualified Name
   -> DataDeclaration v a
   -> Pretty SyntaxText
-prettyDataDecl env r name dd =
+prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd =
   (header <>) . P.sep (fmt S.DelimiterChar (" | " `P.orElse` "\n  | ")) $ constructor <$> zip
     [0 ..]
     (DD.constructors' dd)
@@ -101,16 +102,16 @@ prettyDataDecl env r name dd =
   constructor (n, (_, _, (Type.ForallsNamed' _ t))) = constructor' n t
   constructor (n, (_, _, t)                       ) = constructor' n t
   constructor' n t = case Type.unArrows t of
-    Nothing -> prettyPattern env CT.Data r name n
-    Just ts -> case fieldNames env r name dd of
-      Nothing -> P.group . P.hang' (prettyPattern env CT.Data r name n) "      "
-               $ P.spaced (TypePrinter.prettyRaw env Map.empty 10 <$> init ts)
+    Nothing -> prettyPattern suffixifiedPPE CT.Data r name n
+    Just ts -> case fieldNames unsuffixifiedPPE r name dd of
+      Nothing -> P.group . P.hang' (prettyPattern suffixifiedPPE CT.Data r name n) "      "
+               $ P.spaced (TypePrinter.prettyRaw suffixifiedPPE Map.empty 10 <$> init ts)
       Just fs -> P.group $ (fmt S.DelimiterChar "{ ")
                         <> P.sep ((fmt S.DelimiterChar ",") <> " " `P.orElse` "\n      ")
                                  (field <$> zip fs (init ts))
                         <> (fmt S.DelimiterChar " }")
   field (fname, typ) = P.group $ styleHashQualified'' (fmt (S.Reference r)) fname <>
-    (fmt S.TypeAscriptionColon " :") `P.hang` TypePrinter.prettyRaw env Map.empty (-1) typ
+    (fmt S.TypeAscriptionColon " :") `P.hang` TypePrinter.prettyRaw suffixifiedPPE Map.empty (-1) typ
   header = prettyDataHeader name dd <> (fmt S.DelimiterChar (" = " `P.orElse` "\n  = "))
 
 -- Comes up with field names for a data declaration which has the form of a
@@ -144,12 +145,11 @@ fieldNames env r name dd = case DD.constructors dd of
     fieldNames = Map.fromList
       [ (r, f) | (r, n) <- names
                , typename <- pure (HQ.toString name)
-               , typename `isPrefixOf` n
-               -- drop the typename and the following '.'
+               , typename `isPrefixOf` (traceShowId n)
                , rest <- pure $ drop (length typename + 1) n
                , (f, rest) <- pure $ span (/= '.') rest
                , rest `elem` ["",".set",".modify"] ]
-    in if Map.size fieldNames == length names then
+    in if traceShowId (Map.size fieldNames) == traceShowId (length names) then
          Just [ HQ.unsafeFromString name
               | v <- vars
               , Just (ref, _) <- [Map.lookup (Var.namespaced [HQ.toVar name, v]) hashes]

parser-typechecker/src/Unison/PrettyPrintEnv/Util.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Unison.PrettyPrintEnv.Util (declarationPPE) where
+module Unison.PrettyPrintEnv.Util (declarationPPE, declarationPPEDecl) where
 
 import qualified Data.Set as Set
 import Unison.PrettyPrintEnv (PrettyPrintEnv (..))
@@ -29,3 +29,8 @@ declarationPPE ppe rd = PrettyPrintEnv tm ty
       if Set.member r comp
         then types (unsuffixifiedPPE ppe) r
         else types (suffixifiedPPE ppe) r
+
+-- The suffixed names uses the fully-qualified name for `r`
+declarationPPEDecl ::  PrettyPrintEnvDecl -> Reference -> PrettyPrintEnvDecl
+declarationPPEDecl ppe r = 
+   ppe { suffixifiedPPE = declarationPPE ppe r }

parser-typechecker/src/Unison/PrettyPrintEnvDecl.hs

@@ -2,7 +2,7 @@
 
 module Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl(..)) where
 
-import Unison.PrettyPrintEnv (PrettyPrintEnv)
+import Unison.PrettyPrintEnv (PrettyPrintEnv(..))
 
 -- A pair of PrettyPrintEnvs:
 --   - suffixifiedPPE uses the shortest unique suffix
@@ -16,3 +16,4 @@ data PrettyPrintEnvDecl = PrettyPrintEnvDecl {
   unsuffixifiedPPE :: PrettyPrintEnv,
   suffixifiedPPE :: PrettyPrintEnv
   } deriving Show
+

parser-typechecker/src/Unison/Server/Backend.hs

@@ -890,9 +890,6 @@ typesToSyntax suff width ppe0 types =
     (first (PPE.typeName ppeDecl) . dupe)
     types
  where
-  ppeBody r = if suffixified suff
-    then PPE.suffixifiedPPE ppe0
-    else PPE.declarationPPE ppe0 r
   ppeDecl = if suffixified suff
     then PPE.suffixifiedPPE ppe0
     else PPE.unsuffixifiedPPE ppe0
@@ -900,7 +897,7 @@ typesToSyntax suff width ppe0 types =
     BuiltinObject _ -> BuiltinObject (formatTypeName' ppeDecl r)
     MissingObject sh -> MissingObject sh
     UserObject d -> UserObject . Pretty.render width $
-      DeclPrinter.prettyDecl (ppeBody r) r n d
+      DeclPrinter.prettyDecl (PPE.declarationPPEDecl ppe0 r) r n d
 
 loadSearchResults
   :: (Var v, Applicative m)

parser-typechecker/src/Unison/Server/Doc.hs

@@ -244,7 +244,7 @@ renderDoc pped terms typeOf eval types tm = eval tm >>= \case
             Just decl ->
               pure $ DO.UserObject (Src folded full)
               where
-                full = formatPretty (DeclPrinter.prettyDecl ppe r (PPE.typeName ppe r) decl)
+                full = formatPretty (DeclPrinter.prettyDecl pped r (PPE.typeName ppe r) decl)
                 folded = formatPretty (DeclPrinter.prettyDeclHeader (PPE.typeName ppe r) decl)
 
         go :: (Set.Set Reference, [Ref (UnisonHash, DisplayObject SyntaxText Src)])

unison-src/transcripts/records.output.md

@@ -0,0 +1,65 @@
+Ensure that Records keep their syntax after being added to the codebase 
+
+## Record with 1 field
+
+```unison
+unique type Record1 = { a : Text }
+```
+
+```ucm
+.> view Record1
+
+  unique type Record1 = { a : Text }
+
+```
+## Record with 2 fields
+
+```unison
+unique type Record2 = { a : Text, b : Int }
+```
+
+```ucm
+.> view Record2
+
+  unique type Record2 = { a : Text, b : Int }
+
+```
+## Record with 3 fields
+
+```unison
+unique type Record3 = { a : Text, b : Int, c : Nat }
+```
+
+```ucm
+.> view Record3
+
+  unique type Record3 = { a : Text, b : Int, c : Nat }
+
+```
+## Record with many fields
+
+```unison
+unique type Record4 = 
+  { a : Text
+  , b : Int
+  , c : Nat
+  , d : Bytes
+  , e : Text
+  , f : Nat
+  , g : [Nat]
+  }
+```
+
+```ucm
+.> view Record4
+
+  unique type Record4
+    = { a : Text,
+        b : Int,
+        c : Nat,
+        d : Bytes,
+        e : Text,
+        f : Nat,
+        g : [Nat] }
+
+```