@@ -2,19 +2,20 @@ module Spago.Search.Index where
22
33import Prelude
44
5−import Spago.Search.Declarations (Declarations(..), IndexEntry(..))
5+import Spago.Search.Declarations (ChildDeclType(..), ChildIndexEntry, DeclType(..), Declarations(..), IndexEntry(..))
66
7−import Data.Foldable (foldr)
87import Data.Array ((!!))
9−import Data.List (List)
8+import Data.Array as Array
9+import Data.Foldable (foldr)
10+import Data.List (List, (:))
1011import Data.List as List
1112import Data.Maybe (Maybe(..), fromMaybe)
12−import Data.String.Common as String
13−import Data.String.Pattern (Pattern(..))
14−import Data.Newtype (class Newtype)
13+import Data.Newtype (class Newtype, unwrap)
1514import Data.Search.Trie (Trie, alter)
16−import Data.String.CodeUnits (toCharArray)
15+import Data.String.CodeUnits (stripPrefix, stripSuffix, toCharArray)
1716import Data.String.Common (toLower)
17+import Data.String.Common as String
18+import Data.String.Pattern (Pattern(..))
1819
1920newtype SearchIndex = SearchIndex (Trie Char (List SearchResult))
2021
@@ -23,7 +24,7 @@ derive instance newtypeSearchIndex :: Newtype SearchIndex _
2324newtype SearchResult
2425 = SearchResult { name :: String
2526 , comments :: Maybe String
26− , declType :: String
27+ , hashAnchor :: String
2728 , moduleName :: String
2829 , packageName :: String
2930 , sourceSpan :: { start :: Array Int
@@ -36,57 +37,137 @@ derive instance newtypeSearchResult :: Newtype SearchResult _
3637
3738mkSearchIndex :: Array Declarations -> SearchIndex
3839mkSearchIndex = SearchIndex <<< foldr insertDeclarations mempty
39− where
40− insertDeclarations (Declarations { name, declarations }) trie
41− = foldr (insertIndexEntry name) trie declarations
42−
43− insertIndexEntry moduleName entry@(IndexEntry { title }) trie
44− = foldr insertSearchResult trie
45− (resultsForEntry moduleName entry)
46−
47− insertSearchResult :: { path :: String
48− , result :: SearchResult
49− } -> Trie Char (List SearchResult) -> Trie Char (List SearchResult)
50− insertSearchResult { path, result } trie =
51− let path' = List.fromFoldable $ toCharArray $ toLower path in
52− alter path' (updateResults result) trie
53−
54− updateResults result mbOldResults =
55− case mbOldResults of
56− Just oldResults ->
57− Just $ List.singleton result <> oldResults
40+
41+insertDeclarations
42+ :: Declarations
43+ -> Trie Char (List SearchResult)
44+ -> Trie Char (List SearchResult)
45+insertDeclarations (Declarations { name, declarations }) trie
46+ = foldr (insertIndexEntry name) trie declarations
47+
48+insertIndexEntry
49+ :: String
50+ -> IndexEntry
51+ -> Trie Char (List SearchResult)
52+ -> Trie Char (List SearchResult)
53+insertIndexEntry moduleName entry@(IndexEntry { title }) trie
54+ = foldr insertSearchResult trie (resultsForEntry moduleName entry)
55+
56+insertSearchResult
57+ :: { path :: String
58+ , result :: SearchResult
59+ }
60+ -> Trie Char (List SearchResult)
61+ -> Trie Char (List SearchResult)
62+insertSearchResult { path, result } trie =
63+ let path' = List.fromFoldable $ toCharArray $ toLower path in
64+ alter path' updateResults trie
65+ where
66+ updateResults mbOldResults =
67+ case mbOldResults of
68+ Just oldResults ->
69+ Just $ result : oldResults
70+ Nothing ->
71+ Just $ List.singleton result
72+
73+resultsForEntry
74+ :: String
75+ -> IndexEntry
76+ -> List { path :: String
77+ , result :: SearchResult
78+ }
79+resultsForEntry moduleName (IndexEntry { title
80+ , comments
81+ , info
82+ , sourceSpan
83+ , children }) =
84+ let { name, hashAnchor } = extractHashAnchor info.declType title
85+ 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
101+ :: DeclType
102+ -> String
103+ -> { hashAnchor :: String
104+ , name :: String
105+ }
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
58120 Nothing ->
59− Just $ List.singleton result
60−
61− resultsForEntry
62− :: String
63− -> IndexEntry
64− -> List { path :: String
65− , result :: SearchResult
66− }
67− resultsForEntry moduleName (IndexEntry { title
68− , comments
69− , info
70− , sourceSpan }) =
71− List.fromFoldable
72− [ { path: title
73− , result: SearchResult { name: title
74− , comments
75− , declType: info.declType
76− , moduleName
77− , sourceSpan
78− , packageName:
79− extractPackageName sourceSpan
80− }
81− }
82− ]
83−
84− extractPackageName { name } =
85− let chunks = String.split (Pattern "/") name in
86− fromMaybe "<unknown>" $
87− chunks !! 0 >>= \dir ->
88− -- TODO: is it safe to assume that directory name is ".spago"?
89− if dir == ".spago" then
90− chunks !! 1
91− else
92− Just "<local package>"
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+
133+extractPackageName :: String -> String
134+extractPackageName name =
135+ let chunks = String.split (Pattern "/") name in
136+ fromMaybe "<unknown>" $
137+ chunks !! 0 >>= \dir ->
138+ -- TODO: is it safe to assume that directory name is ".spago"?
139+ if dir == ".spago" then
140+ chunks !! 1
141+ else
142+ Just "<local package>"
143+
144+extractChildren
145+ :: { end :: Array Int
146+ , name :: String
147+ , start :: Array Int
148+ }
149+ -> String
150+ -> 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+ ]