@@ -2,9 +2,9 @@ module Spago.Search.Index where
22
33import Prelude
44
5−import Spago.Search.TypeShape (ShapeChunk, shapeOfType)
65import Spago.Search.DocsJson (ChildDeclType(..), ChildIndexEntry(..), DataDeclType, DeclType(..), Declarations(..), IndexEntry(..))
7−import Spago.Search.TypeDecoder (Constraint, FunDeps, Kind, Type, TypeArgument)
6+import Spago.Search.TypeDecoder (Constraint(..), FunDeps, Kind, QualifiedName(..), Type(..), TypeArgument)
7+import Spago.Search.TypeShape (ShapeChunk, joinForAlls, shapeOfType)
88
99import Control.Alt ((<|>))
1010import Data.Array ((!!))
@@ -12,7 +12,7 @@ import Data.Foldable (foldr)
1212import Data.List (List, (:))
1313import Data.List as List
1414import Data.Maybe (Maybe(..), fromMaybe)
15−import Data.Newtype (class Newtype, unwrap)
15+import Data.Newtype (class Newtype, unwrap, wrap)
1616import Data.Search.Trie (Trie, alter, entriesUnordered)
1717import Data.String.CodeUnits (stripPrefix, stripSuffix, toCharArray)
1818import Data.String.Common (toLower)
@@ -35,7 +35,7 @@ data ResultInfo
3535 , type :: Type }
3636 | DataConstructorResult { arguments :: Array Type }
3737 | TypeClassMemberResult { type :: Type
38− , typeClass :: String
38+ , typeClass :: QualifiedName
3939 , typeClassArguments :: Array String }
4040 | TypeClassResult { fundeps :: FunDeps
4141 , arguments :: Array TypeArgument
@@ -76,6 +76,7 @@ mkSearchIndex decls =
7676 TypeClassMemberResult dict ->
7777 -- TODO: fix missing foralls for type class members
7878 insertTypeResultsFor dict.type result
79+
7980 TypeSynonymResult dict ->
8081 insertTypeResultsFor dict.type result
8182 _ -> mempty
@@ -277,14 +278,41 @@ mkChildInfo parentResult (ChildIndexEntry { info } ) =
277278 info.arguments <#>
278279 \arguments -> DataConstructorResult { arguments }
279280 ChildDeclTypeClassMember ->
280− -- We need to get the name and the type arguments of a parent class.
281281 case (unwrap parentResult).info of
282282 TypeClassResult { arguments } ->
283+ -- We need to reconstruct a "real" type of a type class member.
284+ -- For example, if `unconstrainedType` is the type of `pure`, i.e. `forall a. a -> m a`,
285+ -- `restoredType` should be `forall m a. Control.Applicative.Applicative m => a -> m a`.
283286 info.type <#>
284− \ty -> TypeClassMemberResult
285− { type: ty
286− , typeClass: (unwrap parentResult).name
287− , typeClassArguments: arguments <#> unwrap >>> (_.name)
288− }
287+ \(unconstrainedType :: Type) ->
288+ let
289+ -- First, we get a list of nested `forall` quantifiers for `unconstrainedType`
290+ -- and a version of `unconstrainedType` without them (`ty`).
291+ { ty, binders } = joinForAlls unconstrainedType
292+
293+ -- Then we construct a qualified name of the type class.
294+ parentClassName =
295+ QualifiedName { moduleName: String.split (wrap ".") (unwrap parentResult).moduleName
296+ , name: (unwrap parentResult).name }
297+
298+ typeClassArguments = arguments <#> unwrap >>> _.name
299+
300+ -- We concatenate two lists:
301+ -- * list of type parameters of the type class, and
302+ -- * list of quantified variables of the unconstrained type
303+ allArguments =
304+ typeClassArguments <> (List.toUnfoldable binders <#> (_.var))
305+
306+ restoredType =
307+ foldr (\arg -> compose (\type'' -> ForAll arg type'' Nothing)) identity allArguments $
308+ ConstrainedType (Constraint { constraintClass: parentClassName
309+ , constraintArgs: typeClassArguments <#> TypeVar
310+ }) ty
311+
312+ in TypeClassMemberResult
313+ { type: restoredType
314+ , typeClass: parentClassName
315+ , typeClassArguments
316+ }
289317 _ -> Nothing
290318 ChildDeclInstance -> Nothing