Prettify data constructor output

Author: purefunctor

src/Docs/Search/Declarations.purs

@@ -11,7 +11,7 @@ import Prim hiding (Type)
 import Control.Alt ((<|>))
 import Data.Array ((!!))
 import Data.Array as Array
-import Data.Foldable (foldr)
+import Data.Foldable (foldl, foldr)
 import Data.List (List, (:))
 import Data.List as List
 import Data.Maybe (Maybe(..), fromMaybe)
@@ -244,8 +244,33 @@ mkChildInfo
   (SearchResult { info: parentInfo, moduleName, name: resultName })
   (ChildDeclaration { info } )
 
-  | ChildDeclDataConstructor <- info.declType =
-      info.arguments <#> \arguments -> DataConstructorResult { arguments }
+  | ChildDeclDataConstructor <- info.declType
+  , DataResult { dataDeclType, typeArguments } <- parentInfo =
+      let
+        parentTypeCtor :: Type
+        parentTypeCtor = TypeConstructor
+          $ QualifiedName { moduleNameParts:
+                            String.split (wrap ".") (unwrap moduleName)
+                          , name: resultName }
+
+        parentTypeArgs :: Array Type
+        parentTypeArgs = typeArguments <#> unwrap >>> \{ name } -> TypeVar name
+
+        parentType :: Type
+        parentType = foldl TypeApp parentTypeCtor parentTypeArgs
+
+        typeArrow :: Type -> Type
+        typeArrow =
+          TypeApp (TypeConstructor (QualifiedName { moduleNameParts: [ "Prim" ]
+                                                  , name: Identifier "Function" }))
+
+        makeType :: Array Type -> Type
+        makeType = foldr (\a b -> TypeApp (typeArrow a) b) parentType
+      in
+       info.arguments <#> \arguments ->
+         DataConstructorResult { dataDeclType
+                               , "type": makeType arguments
+                               }
 
   | ChildDeclTypeClassMember <- info.declType
   , TypeClassResult { arguments } <- parentInfo =

src/Docs/Search/Interactive.purs

@@ -194,6 +194,9 @@ showSignature result@{ name, info } =
     ValueAliasResult ->
       yellow ("(" <> unwrap name <> ")")
 
+    DataConstructorResult info' ->
+      showDataConstructorSignature info' result
+
     _ -> yellow $ unwrap name
 
 
@@ -299,6 +302,29 @@ showExternDataSignature { kind } { name } =
   showType kind
 
 
+showDataConstructorSignature
+  :: forall rest
+  .  { dataDeclType :: DataDeclType
+     , "type" :: Type
+     }
+  -> { name :: Identifier
+     | rest
+     }
+  -> String
+showDataConstructorSignature { dataDeclType, type: ctorType } { name } =
+  ( keyword
+    case dataDeclType of
+      NewtypeDataDecl -> "newtype constructor"
+      DataDataDecl -> "data constructor"
+  ) <>
+  space <>
+  yellow (unwrap name) <>
+  space <>
+  syntax "::" <>
+  space <>
+  showType ctorType
+
+
 leftShift :: Int -> String -> String
 leftShift shift str =
   Array.intercalate "\n" $

src/Docs/Search/SearchResult.purs

@@ -22,7 +22,8 @@ data ResultInfo
   | ExternDataResult      { kind :: Type }
   | TypeSynonymResult     { arguments :: Array TypeArgument
                           , type :: Type }
-  | DataConstructorResult { arguments :: Array Type }
+  | DataConstructorResult { dataDeclType :: DataDeclType
+                          , type :: Type }
   | TypeClassMemberResult { type :: Type
                           , typeClass :: QualifiedName
                           , typeClassArguments :: Array TypeArgument }