Search.icl 14.9 KB
Newer Older
1
implementation module Cloogle.Search
2
3
4
5
6
7
8
9
10
11
12
13

import StdArray
import StdBool
from StdFunc import const, id, flip, o
import StdList
import StdOrdList
import StdString
import StdTuple

import Control.Applicative
import Control.Monad
import qualified Data.Foldable as Foldable
Camil Staps's avatar
Camil Staps committed
14
from Data.Func import $, on, `on`, instance Functor ((->) r), mapSt
15
16
import Data.Functor
import Data.List
17
import qualified Data.Map as M
18
import Data.Maybe
19
import Data.Maybe.Ord
20
import Data.Tuple
21
from Database.Native import :: Entry{value}
22
23
24
from Text import class Text(concat,indexOf,toLowerCase,split),
	instance Text String, instance + String

25
26
27
28
29
30
31
32
33
import Clean.Types
import Clean.Types.Parse
import Clean.Types.Unify
import Clean.Types.Util

import Clean.Doc

import Cloogle.API
import Cloogle.DB
34
import Cloogle.Search.Rank
35

Camil Staps's avatar
Camil Staps committed
36
37
38
39
40
41
:: SearchStrategy
	= SSIdentity
	| SSName String
	| SSUnify Type
	| SSTypeName String
	| SSClassName String
42
	| SSUsing (*CloogleDB -> *CloogleDB) [String]
Camil Staps's avatar
Camil Staps committed
43
44
45
46
47
48
49
50
51
52
53
54
	| SSAnd SearchStrategy SearchStrategy

addStrategy :: (Maybe SearchStrategy) SearchStrategy -> SearchStrategy
addStrategy Nothing  strat = strat
addStrategy (Just s) strat = SSAnd strat s

searchStrategy :: !SearchStrategy !*CloogleDB -> *CloogleDB
searchStrategy SSIdentity      db = db
searchStrategy (SSName n)      db = filterName n db
searchStrategy (SSUnify t)     db = filterUnifying t db
searchStrategy (SSTypeName  n) db = filterDB (\ce->ce=:(TypeDefEntry _))  $ filterExactName n db
searchStrategy (SSClassName n) db = filterDB (\ce->ce=:(ClassEntry _)) $ filterExactName n db
55
searchStrategy (SSUsing f ns)  db = filterUsages f ns db
Camil Staps's avatar
Camil Staps committed
56
57
searchStrategy (SSAnd a b)     db = searchStrategy b $ searchStrategy a db

58
59
60
61
62
63
64
65
66
67
search :: !RankSettings !Request !*CloogleDB -> *([Result], *CloogleDB)
search rsets req cdb
# (mbType,allsyns,usedsyns,entries,cdb) = search` req cdb
# (es,cdb) = mapSt (makeResult rsets mbType allsyns usedsyns) entries cdb
= (sort $ catMaybes es, cdb)

search` :: !Request !*CloogleDB ->
	*(!Maybe Type
	, !(Map String [TypeDef])
	, ![TypeDef]
68
	, ![(!CloogleEntry, ![Annotation])]
69
70
71
	, !*CloogleDB
	)
search` {unify,name,className,typeName,using,modules,libraries,page,include_builtins,include_core,include_apps} cdb
Camil Staps's avatar
Camil Staps committed
72
73
74
75
# include_builtins = fromMaybe DEFAULT_INCLUDE_BUILTINS include_builtins
# include_core = fromMaybe DEFAULT_INCLUDE_CORE include_core
# include_apps = fromMaybe DEFAULT_INCLUDE_APPS include_apps
// Initial filters
76
77
78
79
80
81
82
# initfilter =
	if include_core id excludeCore o
	if include_apps id excludeApps o
	(case libraries of Just ls -> filterLibraries ls; Nothing -> id) o
	(case modules   of Just ms -> filterModules   ms; Nothing -> id) o
	if include_builtins includeBuiltins excludeBuiltins
# cdb = initfilter cdb
Camil Staps's avatar
Camil Staps committed
83
// Search strategy
Camil Staps's avatar
Camil Staps committed
84
85
86
87
88
89
90
# strat = SSIdentity
// Name search
# strat = addStrategy (SSName <$> name) strat
# strat = addStrategy (SSTypeName <$> typeName) strat
# strat = addStrategy (SSClassName <$> className) strat
// Unification search
# (allsyns,cdb) = allTypeSynonyms cdb
91
92
# (alwaysUnique,cdb) = alwaysUniquePredicate cdb
# mbPreppedType = prepare_unification True alwaysUnique allsyns <$> (unify >>= parseType o fromString)
93
# usedsyns = 'Foldable'.concat (fst <$> mbPreppedType)
Camil Staps's avatar
Camil Staps committed
94
95
96
# mbType = snd <$> mbPreppedType
# strat = addStrategy (SSUnify <$> mbType) strat
// Usage search
97
# strat = addStrategy (SSUsing initfilter <$> using) strat
Camil Staps's avatar
Camil Staps committed
98
99
// Search and return results
# cdb = searchStrategy strat cdb
100
# cdb = removeContainedEntries cdb
Camil Staps's avatar
Camil Staps committed
101
# (es,cdb) = getEntries cdb
102
103
104
105
106
= (mbType,allsyns,usedsyns,es,cdb)

unifyInformation :: !(Maybe Type) !(Map String [TypeDef]) ![TypeDef] !FunctionEntry !*CloogleDB
	-> *(!Maybe Unifier, ![TypeDef], !Maybe [(!String, ![LocationResult])], !*CloogleDB)
unifyInformation orgsearchtype allsyns usedsyns fe db
107
| isNothing fe.fe_type = (Nothing, usedsyns, Nothing, db)
108
# (alwaysUnique,db) = alwaysUniquePredicate db
109
110
111
112
113
# (usedsyns,fe_type) = appFst (flip (++) usedsyns) $ prep alwaysUnique $ fromJust fe.fe_type
# tvas = orgsearchtype >>= unify fe_type
| isNothing tvas = (Nothing, usedsyns, Nothing, db)
# tvas = fromJust tvas
# unif = finish_unification usedsyns tvas
114
115
// Required Context
# (ownContext,db) = ownContext fe db
116
117
# (required_context,db) = findContext ownContext fe_type tvas db
= (Just unif,usedsyns,required_context,db)
118
where
119
120
	prep alwaysUnique = prepare_unification False alwaysUnique allsyns

121
122
123
	ownContext :: FunctionEntry *CloogleDB -> *([TypeRestriction], *CloogleDB)
	ownContext fe db
	| isJust fe.fe_generic_vars =
124
		([Derivation (getName fe.fe_loc) (snd $ prep (const False) $ Var v) \\ v <- fromJust fe.fe_generic_vars], db)
125
126
127
	= case fe.fe_class of
		Nothing -> ([], db)
		Just ci -> let ({value=ClassEntry ce},db`) = getIndex ci db in
128
			([Instance (getName ce.ce_loc) (map (snd o prep (const False) o Var) ce.ce_vars)], db`)
129

130
131
	findContext :: [TypeRestriction] Type [TVAssignment] *CloogleDB -> *(Maybe [(String, [LocationResult])], *CloogleDB)
	findContext trs t tvas db
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
	# trs = removeDup (concatMap applyUnifToTR (getTC t ++ trs))
	= appFst Just $
		mapSt (\tr -> appFst (tuple (concat $ print False tr) o map locResult) o findLocations tr) trs db
	where
		getTC :: Type -> TypeContext
		getTC (Func _ _ tc)   = tc
		getTC (Forall _ _ tc) = tc
		getTC _               = []

		applyUnifToTR :: TypeRestriction -> [TypeRestriction]
		applyUnifToTR (Instance c ts) = maybeToList $ Instance c <$> mapM uni ts
		applyUnifToTR (Derivation g t)
		| any isFunc subts = [Derivation g (Arrow Nothing):derivs]
		| otherwise        = derivs
		where
			subts = [st \\ ut <- maybeToList (uni t), st <- subtypes ut]
			derivs = [Derivation g (Type st []) \\ Type st _ <- subts]

		uni :: (Type -> Maybe Type)
151
152
153
154
155
156
157
158
159
160
161
		uni = fmap (remove_var_prefixes o norm) o assignAll tvas
		where
			remove_var_prefixes :: !Type -> Type
			remove_var_prefixes (Var v)         = Var (v % (1,size v-1))
			remove_var_prefixes (Cons c ts)     = Cons (c % (1,size c-1)) (map remove_var_prefixes ts)
			remove_var_prefixes (Type t ts)     = Type t (map remove_var_prefixes ts)
			remove_var_prefixes (Func is r c)   = Func (map remove_var_prefixes is) (remove_var_prefixes r) c
			remove_var_prefixes (Uniq t)        = Uniq $ remove_var_prefixes t
			remove_var_prefixes (Forall vs t c) = Forall (map remove_var_prefixes vs) (remove_var_prefixes t) c
			remove_var_prefixes (Arrow mt)      = Arrow $ remove_var_prefixes <$> mt
			remove_var_prefixes (Strict t)      = Strict $ remove_var_prefixes t
162
163
164
165
166
167
168
169
170
171
172
173
174
175

		norm :: (Type -> Type)
		norm = snd o resolve_synonyms allsyns

		findLocations :: TypeRestriction *CloogleDB -> *([Location], *CloogleDB)
		findLocations (Instance c ts) db
		# (ies,db) = getInstances c db
		= (removeDup $ flatten
			[ ie.ie_locations \\ ie <- ies
			| and [norm t1 generalises t2 \\ t1 <- map fst ie.ie_types & t2 <- ts]], db)
		findLocations (Derivation g t) db
		# (des,db) = getDerivations g db
		= (removeDup $ flatten
			[de.de_locations \\ de <- des | norm de.de_type generalises t], db)
176

177
makeResult :: !RankSettings !(Maybe Type) !(Map String [TypeDef]) ![TypeDef]
178
	!(!CloogleEntry, ![Annotation]) !*CloogleDB
179
180
	-> *(!Maybe Result, !*CloogleDB)
makeResult rsets orgsearchtype allsyns usedsyns (entry, annots) db
181
182
| entry =: (FunctionEntry _)
	# (FunctionEntry fe) = entry
Camil Staps's avatar
Camil Staps committed
183
	// Parent class
184
185
186
187
	# (cls,db) = case fe.fe_class of
		Nothing -> (Nothing, db)
		Just i  -> case getIndex i db of
			({value=ClassEntry ce}, db) -> (Just {cls_name=getName ce.ce_loc, cls_vars=ce.ce_vars}, db)
Camil Staps's avatar
Camil Staps committed
188
	// Unifier
189
	# (unif,usedsyns,required_context,db) = unifyInformation orgsearchtype allsyns usedsyns fe db
190
191
192
193
	# annots = [RequiredContext required_context,UsedSynonyms (length usedsyns):annots]
	# annots = case unif of
		Just unif -> [Unifier unif:annots]
		Nothing   -> annots
194
195
196
197
	// Derivations
	# (derivs,db) = case fe.fe_derivations of
		Nothing -> (Nothing, db)
		Just ds -> appFst Just $ getIndices ds db
Camil Staps's avatar
Camil Staps committed
198
	= (Just $ FunctionResult (
Camil Staps's avatar
Camil Staps committed
199
		{ general
200
		& distance = distance rsets entry annots
Camil Staps's avatar
Camil Staps committed
201
		, documentation = docDescription =<< fe.fe_documentation
Camil Staps's avatar
Camil Staps committed
202
		},
203
		{ kind = fe.fe_kind
204
		, func = fromJust (fe.fe_representation <|> pure (concat $ print False (name,fe)))
Camil Staps's avatar
Camil Staps committed
205
206
		, unifier = toStrUnifier <$> unif
		, required_context = required_context
207
		, cls = cls
Camil Staps's avatar
Camil Staps committed
208
209
210
211
212
213
		, constructor_of = case fe.fe_kind of
			Constructor -> let (Just (Func _ r _)) = fe.fe_type in Just $ concat $ print False r
			_           -> Nothing
		, recordfield_of = case fe.fe_kind of
			RecordField -> let (Just (Func [t:_] _ _)) = fe.fe_type in Just $ concat $ print False t
			_           -> Nothing
214
215
		, generic_derivations = sortBy ((<) `on` fst) <$>
			map (\{value=DeriveEntry de} -> (de.de_type_representation, map locResult de.de_locations)) <$> derivs
Camil Staps's avatar
Camil Staps committed
216
		, param_doc = map toString <$> docParams <$> fe.fe_documentation
Camil Staps's avatar
Camil Staps committed
217
218
219
		, generic_var_doc = docVars <$> fe.fe_documentation
		, result_doc = docResults <$> fe.fe_documentation
		, type_doc = concat <$> print False <$> (docType =<< fe.fe_documentation)
220
		, throws_doc = docThrows <$> fe.fe_documentation
221
		}), db)
Camil Staps's avatar
Camil Staps committed
222
223
224
225
226
227
228
229
230
231
232
233
234
235
	with
		toStrUnifier :: Unifier -> StrUnifier
		toStrUnifier unif =
			{ StrUnifier
			| left_to_right = map toStr [a \\ LeftToRight a <- unif.assignments]
			, right_to_left = map toStr [a \\ RightToLeft a <- unif.assignments]
			, used_synonyms = [
				( concat $ [td.td_name," ":intersperse " " $ print False td.td_args]
				, concat $ print False s)
				\\ td=:{td_rhs=TDRSynonym s} <- unif.Unifier.used_synonyms]
			}
		where
			toStr (var, type) = (var, concat $ print False type)

236
237
| entry =: (TypeDefEntry _)
	# (TypeDefEntry tde) = entry
Camil Staps's avatar
Camil Staps committed
238
	# (insts,db) = getIndices tde.tde_instances db
239
	# (derivs,db) = getIndices tde.tde_derivations db
Camil Staps's avatar
Camil Staps committed
240
	= (Just $ TypeResult (
Camil Staps's avatar
Camil Staps committed
241
242
243
		{ general
		& documentation = docDescription =<< tde.tde_doc
		},
244
		{ type = concat $ print False tde.tde_typedef
Camil Staps's avatar
Camil Staps committed
245
246
247
		, type_instances = sortBy ((<) `on` fst3)
			[(ie.ie_class, map snd ie.ie_types, map locResult ie.ie_locations)
			\\ {value=InstanceEntry ie} <- insts]
248
249
		, type_derivations = sortBy ((<) `on` fst)
			[(de.de_generic, map locResult de.de_locations) \\ {value=DeriveEntry de} <- derivs]
Camil Staps's avatar
Camil Staps committed
250
251
252
		, type_field_doc          = docFields =<< tde.tde_doc
		, type_constructor_doc    = map ((=<<) docDescription) <$> (docConstructors =<< tde.tde_doc)
		, type_representation_doc = join (docRepresentation =<< tde.tde_doc)
253
		}), db)
Camil Staps's avatar
Camil Staps committed
254

255
256
| entry =: (ModuleEntry _)
	# (ModuleEntry me) = entry
Camil Staps's avatar
Camil Staps committed
257
	= (Just $ ModuleResult (
Camil Staps's avatar
Camil Staps committed
258
259
260
		{ general
		& documentation = docDescription =<< me.me_documentation
		},
Camil Staps's avatar
Camil Staps committed
261
		{ module_is_core = me.me_is_core
262
		}), db)
Camil Staps's avatar
Camil Staps committed
263

264
265
| entry =: (ClassEntry _)
	# (ClassEntry ce) = entry
Camil Staps's avatar
Camil Staps committed
266
	# (ies,db) = getIndices ce.ce_instances db
Camil Staps's avatar
Camil Staps committed
267
	# (mems,db) = getIndices ce.ce_members db
Camil Staps's avatar
Camil Staps committed
268
	= (Just $ ClassResult (
Camil Staps's avatar
Camil Staps committed
269
270
271
		{ general
		& documentation = docDescription =<< ce.ce_documentation
		},
272
273
274
		{ class_name = name
		, class_heading = foldl ((+) o (flip (+) " ")) name ce.ce_vars +
			if (isEmpty ce.ce_context) "" " | " + concat (print False ce.ce_context)
Camil Staps's avatar
Camil Staps committed
275
		, class_funs = [fromJust fe.fe_representation \\ {value=FunctionEntry fe} <- mems]
276
		, class_fun_doc = Just [printDoc <$> fe.fe_documentation \\ {value=FunctionEntry fe} <- mems]
Camil Staps's avatar
Camil Staps committed
277
278
279
		, class_instances = sortBy ((<) `on` fst)
			[(map snd ie.ie_types, map locResult ie.ie_locations)
				\\ {value=InstanceEntry ie} <- ies]
280
		}), db)
Camil Staps's avatar
Camil Staps committed
281

Camil Staps's avatar
Camil Staps committed
282
283
| entry =: (SyntaxEntry _)
	# (SyntaxEntry se) = entry
Camil Staps's avatar
Camil Staps committed
284
	= (Just $ SyntaxResult (
Camil Staps's avatar
Camil Staps committed
285
		{ general
Camil Staps's avatar
Camil Staps committed
286
		& documentation = Just se.syntax_description
Camil Staps's avatar
Camil Staps committed
287
288
289
290
291
292
		},
		{ SyntaxResultExtras
		| syntax_title    = se.SyntaxEntry.syntax_title
		, syntax_code     = se.SyntaxEntry.syntax_code
		, syntax_examples = se.SyntaxEntry.syntax_examples
		}), db)
Camil Staps's avatar
Camil Staps committed
293
294
295
296
297
298
299
300
301
302
303

| entry =: (ABCInstructionEntry _)
	# (ABCInstructionEntry aie) = entry
	= (Just $ ABCInstructionResult (
		{ general
		& documentation = Just aie.aie_description
		},
		{ abc_instruction = aie.aie_instruction
		, abc_arguments   = aie.aie_arguments
		}), db)

Camil Staps's avatar
Camil Staps committed
304
305
| otherwise // InstanceEntry / DeriveEntry cannot be returned
	= (Nothing, db)
306
where
307
	mbLoc = getLocation entry
308
	name = getName $ fromJust mbLoc
309
310
311
312
313
314
	general =
		{ library  = fromMaybe "" (getLibrary =<< mbLoc)
		, modul    = fromMaybe "" (getModule =<< mbLoc)
		, filename = fromMaybe "" (getFilename =<< mbLoc)
		, dcl_line = getDclLine =<< mbLoc
		, icl_line = getIclLine =<< mbLoc
Camil Staps's avatar
Camil Staps committed
315
		, name     = fromMaybe "" (getName <$> mbLoc)
316
		, distance = distance rsets entry annots
Camil Staps's avatar
Camil Staps committed
317
318
319
		, builtin  = case mbLoc of
			Just (Builtin _ _) -> Just True
			_                  -> Nothing
Camil Staps's avatar
Camil Staps committed
320
321
322
323
		, documentation = Nothing // Added after pattern match on Entry type
		, langrep_documentation = case mbLoc of
			Just (Builtin _ d) -> Just d
			_                  -> Nothing
324
325
		}

326
327
328
searchWithSuggestions :: !RankSettings !Request !*CloogleDB -> *([Result], [(Request,[Result])], *CloogleDB)
searchWithSuggestions rsets req db
# (res,db) = search rsets req db
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
# (suggs,db) = suggestions req res db
= (res,suggs,db)
where
	suggestions :: !Request ![Result] !*CloogleDB -> *([(Request, [Result])], *CloogleDB)
	suggestions {page=Just n} _ db | n > 0 = ([], db)
	suggestions orgreq orgresults db
	# (swapped, db)     = swap db
	# (capitalized, db) = capitalize db
	# (withapps, db)    = addapps db
	= (flatten [swapped, capitalized, withapps], db)
	where
		orgtype = orgreq.unify >>= parseType o fromString

		swap db = case orgtype of
			Just (Func is r cc) | length is < 3
344
				-> appFst (filter enough) $ mapSt (\r -> appFst (tuple r) o search rsets r o resetDB) reqs db
345
346
347
348
349
350
351
352
353
354
355
356
357
358
				with
					reqs = [{orgreq & unify=Just $ concat $ print False $ Func is` r cc}
						\\ is` <- permutations is | is` <> is]
			_ -> ([], db)
		where
			enough :: (Request, [Result]) -> Bool
			enough (_, res) = enough` (length orgresults) res
			where
				enough` 0 _      = True
				enough` _ []     = False
				enough` n [_:xs] = enough` (n-1) xs

		capitalize db = case t` of
			Just t` | fromJust orgtype <> t`
359
				-> appFst (\res -> [(req,res)]) $ search rsets req $ resetDB db
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
					with req = {orgreq & unify=Just $ concat $ print False t`}
			_                 -> ([], db)
		where
			t` = assignAll
				[ ("int",     Type "Int" [])
				, ("bool",    Type "Bool" [])
				, ("char",    Type "Char" [])
				, ("real",    Type "Real" [])
				, ("file",    Type "File" [])
				, ("string",  Type "String" [])
				, ("dynamic", Type "Dynamic" [])
				, ("world",   Uniq (Type "World" []))
				] =<< orgtype

		addapps db
375
		| isJust orgreq.unify = ([], db) // unification search can be slow
376
377
		| fromMaybe DEFAULT_INCLUDE_APPS orgreq.include_apps == DEFAULT_INCLUDE_APPS
			# req = {orgreq & include_apps=Just (not DEFAULT_INCLUDE_APPS)}
378
			# (res,db) = search rsets req $ resetDB db
379
380
381
382
383
384
385
386
			| isEmpty res = ([], db)
			| isEmpty orgresults = ([(req,res)], db)
			# orghddistance = (fromJust (getBasicResult (hd orgresults))).distance
			| all (\r -> (fromJust (getBasicResult r)).distance < orghddistance) $ take 3 res
				= ([(req,res)], db)
				= ([], db)
		| otherwise = ([], db)

Camil Staps's avatar
Camil Staps committed
387
388
389
locResult :: Location -> LocationResult
locResult (Location lib mod filename dcl icl _) = (lib,mod,filename,dcl,icl)

390
isModMatch :: ![String] Location -> Bool
Camil Staps's avatar
Camil Staps committed
391
392
isModMatch mods (Location _ mod _ _ _ _) = isMember mod mods
isModMatch _    (Builtin _ _)            = False
393
394

isLibMatch :: ![String] Location -> Bool
395
isLibMatch libs (Location lib _ _ _ _ _) = isMember lib libs
Camil Staps's avatar
Camil Staps committed
396
isLibMatch _    (Builtin _ _)            = True