checkpoint noncompiling trying to add extra field to BuiltinObject for type signature

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

@@ -5,10 +5,10 @@ module Unison.Codebase.Editor.DisplayObject where
 import Unison.Prelude
 import Unison.ShortHash
 
-data DisplayObject a = BuiltinObject | MissingObject ShortHash | UserObject a
+data DisplayObject b a = BuiltinObject b | MissingObject ShortHash | UserObject a
   deriving (Eq, Ord, Show, Functor, Generic)
 
-toMaybe :: DisplayObject a -> Maybe a
+toMaybe :: DisplayObject b a -> Maybe a
 toMaybe = \case
   UserObject a -> Just a
   _ -> Nothing

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

@@ -24,10 +24,10 @@ data TodoOutput v a = TodoOutput
   { todoScore :: Score
   , todoFrontier ::
         ( [(Reference, Maybe (Type v a))]
-        , [(Reference, DisplayObject (Decl v a))])
+        , [(Reference, DisplayObject () (Decl v a))])
   , todoFrontierDependents ::
         ( [(Score, Reference, Maybe (Type v a))]
-        , [(Score, Reference, DisplayObject (Decl v a))])
+        , [(Score, Reference, DisplayObject () (Decl v a))])
   , nameConflicts :: Names0
   , editConflicts :: Patch
   } deriving (Show)

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

@@ -48,6 +48,7 @@ import Unison.Name as Name
   ( unsafeFromText,
   )
 import qualified Unison.Name as Name
+import qualified Unison.NamePrinter as NP
 import Unison.NameSegment (NameSegment(..))
 import qualified Unison.NameSegment as NameSegment
 import qualified Unison.Names2 as Names
@@ -81,8 +82,7 @@ import Unison.Util.Pretty (Width)
 import qualified Unison.Util.Pretty as Pretty
 import qualified Unison.Util.Relation as R
 import qualified Unison.Util.Star3 as Star3
-import Unison.Util.SyntaxText (SyntaxText)
-import qualified Unison.Util.SyntaxText as SyntaxText
+import qualified Unison.Util.SyntaxText as UST
 import Unison.Var (Var)
 import qualified Unison.Server.Doc as Doc
 import qualified Unison.UnisonFile as UF
@@ -267,19 +267,26 @@ typeDeclHeader
   => Codebase m v Ann
   -> PPE.PrettyPrintEnv
   -> Reference
-  -> Backend m (DisplayObject Syntax.SyntaxText)
+  -> Backend m (DisplayObject Syntax.SyntaxText Syntax.SyntaxText)
 typeDeclHeader code ppe r = case Reference.toId r of
   Just rid ->
     (lift $ Codebase.getTypeDeclaration code rid) <&> \case
       Nothing -> DisplayObject.MissingObject (Reference.toShortHash r)
       Just decl ->
-        DisplayObject.UserObject pretty
-        where
-          name = PPE.typeName ppe r
-          pretty = Syntax.convertElement <$>
-                   Pretty.render defaultWidth (DeclPrinter.prettyDeclHeader name decl)
+        DisplayObject.UserObject $
+          Syntax.convertElement <$>
+            Pretty.render defaultWidth (DeclPrinter.prettyDeclHeader name decl)
   Nothing ->
-    pure DisplayObject.BuiltinObject
+    pure (DisplayObject.BuiltinObject (formatTypeName ppe r))
+  where
+    name = PPE.typeName ppe r
+
+formatTypeName :: Var v => PPE.PrettyPrintEnv -> Reference -> Syntax.SyntaxText
+formatTypeName ppe r =
+  fmap Syntax.convertElement .
+  Pretty.renderUnbroken .
+  NP.styleHashQualified id $
+  PPE.typeName ppe r
 
 termEntryToNamedTerm
   :: Var v => PPE.PrettyPrintEnv -> Maybe Width -> TermEntry v a -> NamedTerm
@@ -510,8 +517,8 @@ hqNameQuerySuffixify = hqNameQuery' True
 -- TODO: Move this to its own module
 data DefinitionResults v =
   DefinitionResults
-    { termResults :: Map Reference (DisplayObject (Term v Ann))
-    , typeResults :: Map Reference (DisplayObject (DD.Decl v Ann))
+    { termResults :: Map Reference (DisplayObject (Type v Ann) (Term v Ann))
+    , typeResults :: Map Reference (DisplayObject () (DD.Decl v Ann))
     , noResults :: [HQ.HashQualified Name]
     }
 
@@ -553,7 +560,7 @@ prettyType width ppe =
     (-1)
 
 mungeSyntaxText
-  :: Functor g => g (SyntaxText.Element Reference) -> g Syntax.Element
+  :: Functor g => g (UST.Element Reference) -> g Syntax.Element
 mungeSyntaxText = fmap Syntax.convertElement
 
 prettyDefinitionsBySuffixes
@@ -696,7 +703,7 @@ bestNameForTerm
 bestNameForTerm ppe width =
   Text.pack
     . Pretty.render width
-    . fmap SyntaxText.toPlain
+    . fmap UST.toPlain
     . TermPrinter.pretty0 @v ppe TermPrinter.emptyAc
     . Term.fromReferent mempty
 
@@ -705,7 +712,7 @@ bestNameForType
 bestNameForType ppe width =
   Text.pack
     . Pretty.render width
-    . fmap SyntaxText.toPlain
+    . fmap UST.toPlain
     . TypePrinter.pretty0 @v ppe mempty (-1)
     . Type.ref ()
 
@@ -761,13 +768,15 @@ definitionsBySuffixes relativeTo branch codebase query = do
         Just (tm, typ) -> case tm of
           Term.Ann' _ _ -> UserObject tm
           _             -> UserObject (Term.ann (ABT.annotation tm) tm typ)
-    r@(Reference.Builtin _) -> pure (r, BuiltinObject)
+    r@(Reference.Builtin _) -> pure $ (r,) $ case Map.lookup r B.termRefTypes of
+      Nothing -> MissingObject $ Reference.toShortHash r
+      Just typ -> BuiltinObject (mempty <$ typ)
   let loadedDisplayTypes = Map.fromList . (`fmap` toList collatedTypes) $ \case
         r@(Reference.DerivedId i) ->
           (r, )
             . maybe (MissingObject $ Reference.idToShortHash i) UserObject
             $ Map.lookup i loadedDerivedTypes
-        r@(Reference.Builtin _) -> (r, BuiltinObject)
+        r@(Reference.Builtin _) -> (r, BuiltinObject ())
   pure $ DefinitionResults loadedDisplayTerms loadedDisplayTypes misses
 
 termsToSyntax
@@ -776,8 +785,8 @@ termsToSyntax
   => Suffixify
   -> Width
   -> PPE.PrettyPrintEnvDecl
-  -> Map Reference.Reference (DisplayObject (Term v a))
-  -> Map Reference.Reference (DisplayObject SyntaxText)
+  -> Map Reference.Reference (DisplayObject (Type v a) (Term v a))
+  -> Map Reference.Reference (DisplayObject UST.SyntaxText UST.SyntaxText)
 termsToSyntax suff width ppe0 terms =
   Map.fromList . map go . Map.toList $ Map.mapKeys
     (first (PPE.termName ppeDecl . Referent.Ref) . dupe)
@@ -788,8 +797,11 @@ termsToSyntax suff width ppe0 terms =
     else PPE.declarationPPE ppe0 r
   ppeDecl =
     (if suffixified suff then PPE.suffixifiedPPE else PPE.unsuffixifiedPPE) ppe0
-  go ((n, r), dt) =
-    (r, Pretty.render width . TermPrinter.prettyBinding (ppeBody r) n <$> dt)
+  go ((n, r), dt) = (r,) $ case dt of
+    DisplayObject.BuiltinObject _ -> error "todo" undefined
+    DisplayObject.MissingObject sh -> DisplayObject.MissingObject sh
+    DisplayObject.UserObject tm -> DisplayObject.UserObject .
+      Pretty.render width . TermPrinter.prettyBinding (ppeBody r) n $ tm
 
 typesToSyntax
   :: Var v
@@ -797,8 +809,8 @@ typesToSyntax
   => Suffixify
   -> Width
   -> PPE.PrettyPrintEnvDecl
-  -> Map Reference.Reference (DisplayObject (DD.Decl v a))
-  -> Map Reference.Reference (DisplayObject SyntaxText)
+  -> Map Reference.Reference (DisplayObject () (DD.Decl v a))
+  -> Map Reference.Reference (DisplayObject () UST.SyntaxText)
 typesToSyntax suff width ppe0 types =
   Map.fromList $ map go . Map.toList $ Map.mapKeys
     (first (PPE.typeName ppeDecl) . dupe)
@@ -840,9 +852,9 @@ loadTypeDisplayObject
   :: Applicative m
   => Codebase m v Ann
   -> Reference
-  -> m (DisplayObject (DD.Decl v Ann))
+  -> m (DisplayObject () (DD.Decl v Ann))
 loadTypeDisplayObject c = \case
-  Reference.Builtin _ -> pure BuiltinObject
+  Reference.Builtin _ -> pure (BuiltinObject ())
   Reference.DerivedId id ->
     maybe (MissingObject $ Reference.idToShortHash id) UserObject
       <$> Codebase.getTypeDeclaration c id

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

@@ -84,8 +84,8 @@ type UnisonHash = Text
 data Ref a = Term a | Type a deriving (Eq,Show,Generic,Functor,Foldable,Traversable)
 
 data SpecialForm
-  = Source [Ref (UnisonHash, DisplayObject Src)]
-  | FoldedSource [Ref (UnisonHash, DisplayObject Src)]
+  = Source [Ref (UnisonHash, DisplayObject SyntaxText Src)]
+  | FoldedSource [Ref (UnisonHash, DisplayObject SyntaxText Src)]
   | Example SyntaxText
   | ExampleBlock SyntaxText
   | Link SyntaxText
@@ -144,6 +144,7 @@ renderDoc pped terms typeOf eval types = go where
     _ -> mzero
 
   formatPretty = fmap Syntax.convertElement . P.render (P.Width 70)
+  formatPrettyType ppe typ = formatPretty (TypePrinter.prettySyntax ppe typ)
 
   source :: Term v () -> MaybeT m SyntaxText
   source tm = (pure . formatPretty . TermPrinter.prettyBlock' True (PPE.suffixifiedPPE pped)) tm
@@ -218,14 +219,17 @@ renderDoc pped terms typeOf eval types = go where
 
   evalErrMsg = "🆘  An error occured during evaluation"
 
-  goSrc :: [Term v ()] -> MaybeT m [Ref (UnisonHash, DisplayObject Src)]
+  goSrc :: [Term v ()] -> MaybeT m [Ref (UnisonHash, DisplayObject SyntaxText Src)]
   goSrc es = do
     let toRef (Term.Ref' r) = Set.singleton r
         toRef (Term.RequestOrCtor' r _) = Set.singleton r
         toRef _ = mempty
         ppe = PPE.suffixifiedPPE pped
-        goType :: Reference -> MaybeT m (Ref (UnisonHash, DisplayObject Src))
-        goType r@(Reference.Builtin _) = pure (Type (Reference.toText r, DO.BuiltinObject))
+        goType :: Reference -> MaybeT m (Ref (UnisonHash, DisplayObject SyntaxText Src))
+        goType r@(Reference.Builtin _) =
+          pure (Type (Reference.toText r, DO.BuiltinObject name))
+          where name = formatPretty . NP.styleHashQualified (NP.fmt (S.Reference r))
+                     . PPE.typeName ppe $ r
         goType r = Type . (Reference.toText r,) <$> do
           d <- lift (types r)
           case d of
@@ -236,9 +240,9 @@ renderDoc pped terms typeOf eval types = go where
                 full = formatPretty (DeclPrinter.prettyDecl ppe r (PPE.typeName ppe r) decl)
                 folded = formatPretty (DeclPrinter.prettyDeclHeader (PPE.typeName ppe r) decl)
 
-        go :: (Set.Set Reference, [Ref (UnisonHash, DisplayObject Src)])
+        go :: (Set.Set Reference, [Ref (UnisonHash, DisplayObject SyntaxText Src)])
            -> Term v ()
-           -> MaybeT m (Set.Set Reference, [Ref (UnisonHash, DisplayObject Src)])
+           -> MaybeT m (Set.Set Reference, [Ref (UnisonHash, DisplayObject SyntaxText Src)])
         go s1@(!seen,!acc) = \case
           -- we ignore the annotations; but this could be extended later
           DD.TupleTerm' [DD.EitherRight' (DD.Doc2Term tm), _anns] ->
@@ -246,7 +250,9 @@ renderDoc pped terms typeOf eval types = go where
             where
             acc' = case tm of
               Term.Ref' r | Set.notMember r seen -> (:acc) . Term . (Reference.toText r,) <$> case r of
-                Reference.Builtin _ -> pure DO.BuiltinObject
+                Reference.Builtin _ -> lift (typeOf (Referent.Ref r)) <&> \case
+                  Nothing -> DO.BuiltinObject ("🆘 missing type signature")
+                  Just ty -> DO.BuiltinObject (formatPrettyType ppe ty)
                 ref -> lift (terms ref) >>= \case
                   Nothing -> pure $ DO.MissingObject (SH.unsafeFromText $ Reference.toText ref)
                   Just tm -> do

parser-typechecker/src/Unison/Server/SearchResult'.hs

@@ -32,7 +32,7 @@ data TermResult' v a =
 
 data TypeResult' v a =
   TypeResult' (HQ'.HashQualified Name)
-              (DisplayObject (Decl v a))
+              (DisplayObject () (Decl v a))
               Reference
               (Set (HQ'.HashQualified Name))
   deriving (Eq, Show)

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

@@ -71,9 +71,9 @@ deriving instance ToParamSchema ShortBranchHash
 deriving via Int instance FromHttpApiData Width
 deriving instance ToParamSchema Width
 
-instance ToJSON a => ToJSON (DisplayObject a) where
+instance (ToJSON b, ToJSON a) => ToJSON (DisplayObject b a) where
    toEncoding = genericToEncoding defaultOptions
-deriving instance ToSchema a => ToSchema (DisplayObject a)
+deriving instance (ToSchema b, ToSchema a) => ToSchema (DisplayObject b a)
 
 instance ToJSON ShortHash where
    toEncoding = genericToEncoding defaultOptions
@@ -111,7 +111,7 @@ data TermDefinition = TermDefinition
   { termNames :: [HashQualifiedName]
   , bestTermName :: HashQualifiedName
   , defnTermTag :: Maybe TermTag
-  , termDefinition :: DisplayObject SyntaxText
+  , termDefinition :: DisplayObject SyntaxText SyntaxText
   , signature :: SyntaxText
   , termDocs :: [(HashQualifiedName, UnisonHash, Doc)]
   } deriving (Eq, Show, Generic)
@@ -120,7 +120,7 @@ data TypeDefinition = TypeDefinition
   { typeNames :: [HashQualifiedName]
   , bestTypeName :: HashQualifiedName
   , defnTypeTag :: Maybe TypeTag
-  , typeDefinition :: DisplayObject SyntaxText
+  , typeDefinition :: DisplayObject SyntaxText SyntaxText
   , typeDocs :: [(HashQualifiedName, UnisonHash, Doc)]
   } deriving (Eq, Show, Generic)
 

parser-typechecker/src/Unison/TypePrinter.hs

@@ -23,7 +23,10 @@ import qualified Unison.Var            as Var
 import qualified Unison.Builtin.Decls as DD
 
 pretty :: forall v a . (Var v) => PrettyPrintEnv -> Type v a -> Pretty ColorText
-pretty ppe = PP.syntaxToColor . pretty0 ppe mempty (-1)
+pretty ppe = PP.syntaxToColor . prettySyntax ppe
+
+prettySyntax :: forall v a . (Var v) => PrettyPrintEnv -> Type v a -> Pretty SyntaxText
+prettySyntax ppe = pretty0 ppe mempty (-1)
 
 pretty' :: Var v => Maybe Width -> PrettyPrintEnv -> Type v a -> String
 pretty' (Just width) n t =