@@ -2,15 +2,16 @@ module Spago.Search.Index where
22
33import Prelude
44
5−import Spago.Search.Declarations (ChildDeclType(..), ChildIndexEntry, DeclType(..), Declarations(..), IndexEntry(..))
5+import Spago.Search.TypeParser (Constraint, FunDeps, Kind, Type, TypeArgument)
6+import Spago.Search.Declarations (ChildDeclType(..), ChildIndexEntry(..), DeclType(..), Declarations(..), IndexEntry(..))
67
8+import Control.Alt ((<|>))
79import Data.Array ((!!))
8−import Data.Array as Array
910import Data.Foldable (foldr)
1011import Data.List (List, (:))
1112import Data.List as List
1213import Data.Maybe (Maybe(..), fromMaybe)
13−import Data.Newtype (class Newtype, unwrap)
14+import Data.Newtype (class Newtype)
1415import Data.Search.Trie (Trie, alter)
1516import Data.String.CodeUnits (stripPrefix, stripSuffix, toCharArray)
1617import Data.String.Common (toLower)
@@ -21,16 +22,31 @@ newtype SearchIndex = SearchIndex (Trie Char (List SearchResult))
2122
2223derive instance newtypeSearchIndex :: Newtype SearchIndex _
2324
25+data ResultInfo
26+ = DataResult { typeArguments :: Array TypeArgument }
27+ | ExternDataResult { kind :: Kind }
28+ | TypeSynonymResult { type :: Type }
29+ | DataConstructorResult { arguments :: Array Type }
30+ | TypeClassMemberResult { type :: Type }
31+ | TypeClassResult { fundeps :: FunDeps
32+ , arguments :: Array TypeArgument
33+ , superclasses :: Array Constraint }
34+ | ValueResult { type :: Type }
35+ | ValueAliasResult
36+ | TypeAliasResult
37+ | ExternKindResult
38+
2439newtype SearchResult
2540 = SearchResult { name :: String
2641 , comments :: Maybe String
2742 , hashAnchor :: String
2843 , moduleName :: String
2944 , packageName :: String
30− , sourceSpan :: { start :: Array Int
31− , end :: Array Int
32− , name :: String
33− }
45+ , sourceSpan :: Maybe { start :: Array Int
46+ , end :: Array Int
47+ , name :: String
48+ }
49+ , info :: ResultInfo
3450 }
3551
3652derive instance newtypeSearchResult :: Newtype SearchResult _
@@ -40,16 +56,16 @@ mkSearchIndex = SearchIndex <<< foldr insertDeclarations mempty
4056
4157insertDeclarations
4258 :: Declarations
43− -> Trie Char (List SearchResult)
44− -> Trie Char (List SearchResult)
59+ -> Trie Char (List SearchResult)
60+ -> Trie Char (List SearchResult)
4561insertDeclarations (Declarations { name, declarations }) trie
4662 = foldr (insertIndexEntry name) trie declarations
4763
4864insertIndexEntry
4965 :: String
50− -> IndexEntry
51− -> Trie Char (List SearchResult)
52− -> Trie Char (List SearchResult)
66+ -> IndexEntry
67+ -> Trie Char (List SearchResult)
68+ -> Trie Char (List SearchResult)
5369insertIndexEntry moduleName entry@(IndexEntry { title }) trie
5470 = foldr insertSearchResult trie (resultsForEntry moduleName entry)
5571
@@ -76,60 +92,101 @@ resultsForEntry
7692 -> List { path :: String
7793 , result :: SearchResult
7894 }
79−resultsForEntry moduleName (IndexEntry { title
80− , comments
81− , info
82− , sourceSpan
83− , children }) =
84− let { name, hashAnchor } = extractHashAnchor info.declType title
95+resultsForEntry moduleName ie@(IndexEntry entry@{info, title, sourceSpan, comments, children}) =
96+ let { name, declLevel } = getLevelAndName info.declType title
8597 packageName = extractPackageName sourceSpan.name
86− in
87− { path: name
88− , result: SearchResult { name: title
89− , comments
90− , hashAnchor
91− , moduleName
92− , sourceSpan
93− , packageName
94− }
95− } : (
96− List.fromFoldable $
97− extractChildren sourceSpan packageName moduleName children
98− )
99−
100−extractHashAnchor
98+ in case mkInfo declLevel ie of
99+ Nothing -> mempty
100+ Just info' -> (
101+ List.singleton $
102+ { path: name
103+ , result: SearchResult { name: title
104+ , comments
105+ , hashAnchor: declLevelToHashAnchor declLevel
106+ , moduleName
107+ , sourceSpan: Just sourceSpan
108+ , packageName
109+ , info: info'
110+ }
111+ }
112+ ) <>
113+ ( List.fromFoldable children >>=
114+ resultsForChildIndexEntry packageName moduleName
115+ )
116+
117+mkInfo :: DeclLevel -> IndexEntry -> Maybe ResultInfo
118+mkInfo declLevel (IndexEntry { info, title }) =
119+ case info.declType of
120+
121+ DeclValue ->
122+ info.type <#>
123+ \ty -> ValueResult { type: ty }
124+
125+ DeclData ->
126+ info.typeArguments <#>
127+ \typeArguments -> DataResult { typeArguments }
128+
129+ DeclExternData ->
130+ info.kind <#>
131+ \kind -> ExternDataResult { kind }
132+
133+ DeclTypeSynonym ->
134+ info.type <#>
135+ \ty -> TypeSynonymResult { type: ty }
136+
137+ DeclTypeClass ->
138+ case info.fundeps, info.arguments, info.superclasses of
139+ Just fundeps, Just arguments, Just superclasses ->
140+ Just $ TypeClassResult { fundeps, arguments, superclasses }
141+ _, _, _ -> Nothing
142+
143+ DeclAlias ->
144+ case declLevel of
145+ TypeLevel -> Just TypeAliasResult
146+ ValueLevel -> Just ValueAliasResult
147+ _ -> Nothing
148+
149+ DeclExternKind ->
150+ Just ExternKindResult
151+
152+-- | Level of a declaration, used to determine which URI hash anchor to use in
153+-- | links ("v", "t" or "k").
154+data DeclLevel = ValueLevel | TypeLevel | KindLevel
155+
156+declLevelToHashAnchor :: DeclLevel -> String
157+declLevelToHashAnchor = case _ of
158+ ValueLevel -> "v"
159+ TypeLevel -> "t"
160+ KindLevel -> "k"
161+
162+getLevelAndName
101163 :: DeclType
102164 -> String
103− -> { hashAnchor :: String
165+ -> { declLevel :: DeclLevel
104166 , name :: String
105167 }
106−extractHashAnchor DeclValue name = { name, hashAnchor: "v" }
107−extractHashAnchor DeclData name = { name, hashAnchor: "t" }
108−extractHashAnchor DeclTypeSynonym name = { name, hashAnchor: "t" }
109−extractHashAnchor DeclTypeClass name = { name, hashAnchor: "v" }
110−extractHashAnchor DeclAlias title =
111− case stripPrefix (Pattern "(") title of
112− Just rest ->
113− case stripSuffix (Pattern ")") rest of
114− -- An infix operator
115− Just name -> { name, hashAnchor: "v" }
116− -- Impossible
117− Nothing -> { name: title, hashAnchor: "v" }
118− Nothing ->
119− case stripPrefix (Pattern "type (") title of
120− Nothing ->
121− { name: title, hashAnchor: "v" }
122− -- An infix type operator
123− Just rest ->
124− case stripSuffix (Pattern ")") rest of
125− Just name ->
126− { name, hashAnchor: "t" }
127− Nothing ->
128− { name: title, hashAnchor: "v" }
129−extractHashAnchor DeclExternData name = { name, hashAnchor: "t" }
130−extractHashAnchor DeclExternKind name = { name, hashAnchor: "k" }
131−
132−
168+getLevelAndName DeclValue name = { name, declLevel: ValueLevel }
169+getLevelAndName DeclData name = { name, declLevel: TypeLevel }
170+getLevelAndName DeclTypeSynonym name = { name, declLevel: TypeLevel }
171+getLevelAndName DeclTypeClass name = { name, declLevel: ValueLevel }
172+-- "declType": "alias" does not specify the level of the declaration.
173+-- But for type aliases, name of the declaration is always wrapped into
174+-- "type (" and ")".
175+getLevelAndName DeclAlias title =
176+ fromMaybe (withAnchor ValueLevel title) $
177+ (withAnchor ValueLevel <$>
178+ (stripPrefix (Pattern "(") >=>
179+ stripSuffix (Pattern ")")) title) <|>
180+ (withAnchor TypeLevel <$>
181+ (stripPrefix (Pattern "type (") >=>
182+ stripSuffix (Pattern ")")) title)
183+ where
184+ withAnchor declLevel name = { declLevel, name }
185+getLevelAndName DeclExternData name = { name, declLevel: TypeLevel }
186+getLevelAndName DeclExternKind name = { name, declLevel: KindLevel }
187+
188+-- | Extract package name from `sourceSpan.name`, which contains path to
189+-- | the source file.
133190extractPackageName :: String -> String
134191extractPackageName name =
135192 let chunks = String.split (Pattern "/") name in
@@ -141,33 +198,34 @@ extractPackageName name =
141198 else
142199 Just "<local package>"
143200
144−extractChildren
145− :: { end :: Array Int
146− , name :: String
147− , start :: Array Int
148− }
149− -> String
201+resultsForChildIndexEntry
202+ :: String
150203 -> String
151− -> Array ChildIndexEntry
152− -> Array { path :: String
153− , result :: SearchResult
154− }
155−extractChildren sourceSpan' packageName moduleName =
156− Array.concatMap $ unwrap >>>
157− \ { title, comments, info, mbSourceSpan } ->
158−
159− let sourceSpan = fromMaybe sourceSpan' mbSourceSpan in
160− if info.declType == ChildDeclInstance
161− then mempty
162− else
163− -- `info.declType` is either `ChildDeclDataConstructor` or
164− -- `ChildDeclTypeClassMember`.
165− [ { path: title
166− , result: SearchResult { name: title
167− , comments
168− , hashAnchor: "v"
169− , moduleName
170− , packageName
171− , sourceSpan }
172− }
173− ]
204+ -> ChildIndexEntry
205+ -> List { path :: String, result :: SearchResult }
206+resultsForChildIndexEntry packageName moduleName
207+ cie@(ChildIndexEntry { title, info, comments, mbSourceSpan }) =
208+ case mkChildInfo cie of
209+ Nothing -> mempty
210+ Just resultInfo ->
211+ { path: title
212+ , result: SearchResult { name: title
213+ , comments
214+ , hashAnchor: "v"
215+ , moduleName
216+ , sourceSpan: mbSourceSpan
217+ , packageName
218+ , info: resultInfo
219+ }
220+ } # List.singleton
221+
222+mkChildInfo :: ChildIndexEntry -> Maybe ResultInfo
223+mkChildInfo (ChildIndexEntry { info } ) =
224+ case info.declType of
225+ ChildDeclDataConstructor ->
226+ info.arguments <#>
227+ \arguments -> DataConstructorResult { arguments }
228+ ChildDeclTypeClassMember ->
229+ info.type <#>
230+ \ty -> TypeClassMemberResult { type: ty }
231+ ChildDeclInstance -> Nothing