More logical indexing pipeline

CloogleDB.dcl

@@ -88,6 +88,12 @@ derive JSONDecode CloogleEntry
 	| Builtin !Name ![CleanLangReportLocation] //* A language builtin
 	| NoLocation //* Only used internally
 
+/**
+ * Wrapper around {{`Location`}} for use in {{`CloogleDBFactory`}} to avoid
+ * name clashes with {{`Module`}} in the compiler.
+ */
+location :: !Library !String !FilePath !LineNr !LineNr !Name -> Location
+
 /**
  * Not-type information that is often associated with things that have a type
  */

CloogleDB.icl

@@ -145,6 +145,9 @@ where
 	m [c:p]        [x:s] = c == x && m p s
 	m _            _     = False
 
+location :: !Library !String !FilePath !LineNr !LineNr !Name -> Location
+location lib mod fp dcl icl name = Location lib mod fp dcl icl name
+
 instance getLocation FunctionEntry where getLocation fe  = Just fe.fe_loc
 instance getLocation TypeDefEntry  where getLocation tde = Just tde.tde_loc
 instance getLocation ModuleEntry   where getLocation me  = Just me.me_loc

CloogleDBFactory.dcl

@@ -13,23 +13,45 @@ import CloogleDB
 newTemporaryDB :: TemporaryDB
 finaliseDB :: ![CloogleEntry] !TemporaryDB -> *CloogleDB
 
+/**
+ * Something to index (typically, a library).
+ */
+:: IndexItem =
+	{ name            :: !String              //* The name of the library
+	, fetch_url       :: !SourceURL           //* Where to find the code to index
+	, info_url        :: !Maybe String        //* Where to find more information
+	, path            :: !Maybe String        //* The path to the root
+	, pattern_exclude :: !Maybe [PathPattern] //* Modules to exclude
+	, pattern_core    :: !Maybe [PathPattern] //* Modules that should be marked as core
+	, pattern_app     :: !Maybe [PathPattern] //* Modules that should be marked as app
+	}
+
+/**
+ * A place to get a Clean library.
+ */
+:: SourceURL
+	= SVN               !String
+	| Git               !String
+	| CleanDistribution !String
+
+/**
+ * Patterns on file paths.
+ */
+:: PathPattern
+	= PStartsWith !String
+	| PNot !PathPattern
+	| PWildcard
+
 /**
  * Find all modules that could be indexed
  *
- * @param Excluded modules. If the path contains any of the strings in this
- *   parameter, a module will not be considered.
  * @param The root of the library directory (typically $CLEAN_HOME/lib).
- * @param The library to look in.
- * @param Some auxiliary value to store with the modules.
- * @param A part of the module hierarchy to look for. The empty string to look
- *   in the whole library, otherwise e.g. Crypto.Hash to only include modules
- *   in that hierarchy.
+ * @param The {{`IndexItem`}} to look in.
+ * @param The base path to look in.
  * @param The World.
- * @result A list of modules found (library, module, whether it is part of the
- *   library core, whether it is an app).
+ * @result A list of modules found.
  */
-findModules :: ![String] !String !Library !a !String !*World
-	-> *(![(Library, Module, a)], !*World)
+findModules :: !String !IndexItem !String !*World -> *(![ModuleEntry], !*World)
 
 /**
  * Update a database with all the information found in a module
@@ -37,14 +59,11 @@ findModules :: ![String] !String !Library !a !String !*World
  * @param Whether local definitions (that only exist in the icl) should be indexed.
  * @param The root of the library directory (typically $CLEAN_HOME/lib).
  * @param The module to index.
- * @param The library the module to index is in.
  * @param A function to update module information (to set me_is_core, me_is_app).
  * @param The old database.
  * @result The new database.
  */
-indexModule :: !Bool !String !Module !Library
-	!(String ModuleEntry -> ModuleEntry) !TemporaryDB !*World
-	-> *(!TemporaryDB, !*World)
+indexModule :: !Bool !String !ModuleEntry !TemporaryDB !*World -> *(!TemporaryDB, !*World)
 
 :: LocationInModule =
 	{ dcl_line :: Maybe Int

CloogleDBFactory.icl

@@ -26,7 +26,8 @@ import qualified Data.Set as S
 import Data.Tuple
 import System.Directory
 import System.FilePath
-from Text import class Text(concat,indexOf,replaceSubString), instance Text String, <+
+from Text import class Text(concat,indexOf,replaceSubString,startsWith),
+	instance Text String, <+
 
 import CleanPrettyPrint
 
@@ -71,7 +72,8 @@ from NGramIndex import :: NGramIndex, newNGramIndex, index
 from TypeTree import :: TypeTree, instance zero (TypeTree v), addType
 from CloogleDB import
 	:: CloogleDB{..}, :: AnnotationKey,
-	:: Location(Location,Builtin,NoLocation),
+	:: Library,
+	:: Location(Builtin,NoLocation),
 	:: CleanLangReportLocation,
 	:: CloogleEntry(..),
 	:: ModuleEntry{..},
@@ -84,7 +86,8 @@ from CloogleDB import
 	:: DeriveEntry{..},
 	instance zero FunctionEntry, instance zero ModuleEntry,
 	class getLocation, instance getLocation CloogleEntry,
-	instance == Location
+	instance == Location,
+	location
 from Cloogle import instance == FunctionKind
 from Doc import :: ModuleDoc, :: FunctionDoc{..}, :: ClassDoc, :: TypeDoc{..},
 	:: ConstructorDoc, :: ClassMemberDoc, :: Description,
@@ -127,11 +130,11 @@ where
 
 instance < Location
 where
-	< (Location l1 m1 _ d1 i1 n1) (Location l2 m2 _ d2 i2 n2)
+	< ('CDB'.Location l1 m1 _ d1 i1 n1) ('CDB'.Location l2 m2 _ d2 i2 n2)
 		= ((l1,m1,n1),(d1,i1)) < ((l2,m2,n2), (d2,i2))
-	< (Location _ _ _ _ _ _) _
+	< ('CDB'.Location _ _ _ _ _ _) _
 		= True
-	< _ (Location _ _ _ _ _ _)
+	< _ ('CDB'.Location _ _ _ _ _ _)
 		= False
 	< (Builtin a _) (Builtin b _)
 		= a < b
@@ -140,6 +143,21 @@ where
 	< _ _
 		= False
 
+class match a :: !a !FilePath -> Bool
+
+instance match PathPattern
+where
+	match (PStartsWith s) fp = startsWith s fp
+	match (PNot p) fp = not (match p fp)
+	match PWildcard _ = True
+
+instance match (Maybe m) | match m
+where
+	match Nothing  s = False
+	match (Just m) s = match m s
+
+instance match [PathPattern] where match ps fp = any (flip match fp) ps
+
 finaliseDB :: ![CloogleEntry] !TemporaryDB -> *'CDB'.CloogleDB
 finaliseDB extra tdb =
 	{ db = 'DB'.mapInPlace link $ newDB entries
@@ -349,29 +367,38 @@ where
 		[('T'.td_name $ 'CDB'.getTypeDef tde, ()) \\ TypeDefEntry tde <- entries | 'T'.td_uniq $ 'CDB'.getTypeDef tde]
 	alwaysUnique = isJust o flip 'M'.get always_unique
 
-//             Exclude   Root    Library        Aux Base module
-findModules :: ![String] !String !'CDB'.Library !a !String !*World
-	-> *(![('CDB'.Library, 'CDB'.Module, a)], !*World)
-findModules ex root lib aux base w
-| any ((<>) -1 o flip indexOf path) ex = ([], w)
-#! (fps, w)   = readDirectory path w
+findModules :: !String !IndexItem !String !*World -> *(!['CDB'.ModuleEntry], !*World)
+findModules root item base w
+| match item.pattern_exclude path = ([], w)
+#! (fps, w)   = readDirectory fullpath w
 | isError fps = ([], w)
 #! (Ok fps)   = fps
-#! mods       = map (\s -> let mod = basedot +++ s % (0, size s - 5) in
-	(lib, mod, aux)) $ filter included $ filter isIclModule fps
-#! (moremodss,w) = mapSt (findModules ex root lib aux o ((+++) basedot)) (filter isDirectory fps) w
-= (removeDupBy (\(l,m,_)->(l,m)) (mods ++ flatten moremodss), w)
+#! mods       = map makeEntry $ filter included $ filter isIclModule fps
+#! (moremodss,w) = mapSt (findModules root item o ((+++) basedot)) (filter isDirectory fps) w
+= (removeDupBy (\m -> 'CDB'.getName m.me_loc) (mods ++ flatten moremodss), w)
 where
 	basedot = if (base == "") "" (base +++ ".")
-	path = root </?> lib </?> replaceSubString "." {pathSeparator} base
+	path = replaceSubString "." {pathSeparator} base
+	fullpath = root </?> item.IndexItem.name </?> path
+
+	(</?>) infixr 5 :: !FilePath !FilePath -> FilePath
+	(</?>) "" p  = p
+	(</?>) p  "" = p
+	(</?>) p1 p2 = p1 </> p2
+
+	makeEntry :: String -> 'CDB'.ModuleEntry
+	makeEntry fn =
+		{ me_loc           = location item.IndexItem.name modname (base </?> fn) (Just 1) (Just 1) modname
+		, me_is_core       = match item.pattern_core (path </> fn)
+		, me_is_app        = match item.pattern_app  (path </> fn)
+		, me_documentation = Nothing
+		, me_usages        = []
+		}
 	where
-		(</?>) infixr 5 :: !FilePath !FilePath -> FilePath
-		(</?>) "" p  = p
-		(</?>) p  "" = p
-		(</?>) p1 p2 = p1 </> p2
+		modname = basedot +++ fn % (0, size fn - 5)
 
 	included :: String -> Bool
-	included s = not (any ((<>) -1 o flip indexOf (path </> s)) ex)
+	included s = not (match item.pattern_exclude (path </> s))
 
 	isIclModule :: String -> Bool
 	isIclModule s = s % (size s - 4, size s - 1) == ".icl"
@@ -383,14 +410,13 @@ where
 	removeDupBy f [x:xs] = [x:removeDupBy f (filter ((<>) (f x) o f) xs)]
 	removeDupBy _ []     = []
 
-indexModule :: !Bool !String !'CDB'.Module !'CDB'.Library
-	!(String 'CDB'.ModuleEntry -> 'CDB'.ModuleEntry) !TemporaryDB !*World
+indexModule :: !Bool !String !'CDB'.ModuleEntry !TemporaryDB !*World
 	-> *(!TemporaryDB, !*World)
-indexModule include_locals root mod lib modf db w
-#! (functions,macros,generics,typedefs,clss,insts,derivs,clsderivs,(modname,modentry,imports),w)
-	= findModuleContents include_locals (root </> lib </> mkdir mod) w
+indexModule include_locals root mod db w
+#! (functions,macros,generics,typedefs,clss,insts,derivs,clsderivs,(modname,_,imports),w)
+	= findModuleContents include_locals (root </> lib </> mkdir ('CDB'.getName mod.me_loc)) w
 #! typedefs = [{td & tde_loc=castLoc modname loc} \\ (loc,td) <- typedefs]
-#! lib = lib % (0, size lib - size modname + size mod - 1)
+#! lib = lib % (0, size lib - size modname + size ('CDB'.getName mod.me_loc) - 1)
 #! db  =
 	{ db
 	& temp_functions =
@@ -403,17 +429,19 @@ indexModule include_locals root mod lib modf db w
 	, temp_instances = [castLocThd3 modname insts:db.temp_instances]
 	, temp_derivations = [map (appSnd (castLocThd3 modname)) derivs:db.temp_derivations]
 	, temp_class_derivations = [castLocFrth modname clsderivs:db.temp_class_derivations]
-	, temp_modules = [(modf mod {modentry & me_loc=Location lib modname dclpath (Just 1) (Just 1) modname},imports):db.temp_modules]
+	, temp_modules = [(mod,imports):db.temp_modules]
 	}
 = (db,w)
 where
+	lib = fromJust ('CDB'.getLibrary mod.me_loc)
+
 	castLocThd3 :: String -> ([(a, b, LocationInModule)] -> [(a, b, 'CDB'.Location)])
 	castLocThd3 m = map (appThd3 (castLoc m))
 	castLocFrth m = map (\(a,b,c,l) -> (a,b,c,castLoc m l))
 
 	castLoc :: String LocationInModule -> 'CDB'.Location
-	castLoc m l = 'CDB'.Location lib m dclpath l.dcl_line l.icl_line $ fromMaybe "" l.name
-	dclpath = mkdir mod +++ ".dcl"
+	castLoc m l = location lib m dclpath l.dcl_line l.icl_line $ fromMaybe "" l.LocationInModule.name
+	dclpath = mkdir ('CDB'.getName mod.me_loc) +++ ".dcl"
 
 	mkdir :: String -> String
 	mkdir s = { if (c == '.') '/' c \\ c <-: s }
@@ -463,7 +491,7 @@ findModuleContents include_locals path w
 	, filter (not o isEmpty o snd) (map (appSnd (filter (hasDcl o thd3))) derivs)
 	, filter (hasDcl o (\(_,_,_,x)->x)) clsderivs
 	) with hasDcl loc = isJust loc.dcl_line
-#! rules = filter (\(r,_,_) -> not $ any (\(l,_,_)->fromJust l.name == fromJust r.name) functions) rules
+#! rules = filter (\(r,_,_) -> not $ any (\(l,_,_)->fromJust l.LocationInModule.name == fromJust r.LocationInModule.name) functions) rules
 = (functions,rules,generics,typedefs,clss,insts,derivs,clsderivs,(modname,pd_module dcl,imports),w)
 where
 	combine :: (a a -> Bool) (a a -> a)
@@ -483,7 +511,7 @@ where
 		(found,xs) -> let (foundys,ys`) = partition (eq y) ys in
 			[foldr join y (found ++ foundys):unionBy eq join xs ys`]
 
-	cmpLoc x y = x.name == y.name
+	cmpLoc x y = x.LocationInModule.name == y.LocationInModule.name
 
 	cmpLocFst :: ((LocationInModule, a) (LocationInModule, a) -> Bool)
 	cmpLocFst = cmpLoc `on` fst
@@ -521,9 +549,9 @@ where
 
 	joinLoc :: LocationInModule LocationInModule -> LocationInModule
 	joinLoc a b =
-		{ dcl_line = a.dcl_line <|> b.dcl_line
-		, icl_line = a.icl_line <|> b.icl_line
-		, name     = a.name     <|> b.name
+		{ dcl_line = a.dcl_line              <|> b.dcl_line
+		, icl_line = a.icl_line              <|> b.icl_line
+		, name     = a.LocationInModule.name <|> b.LocationInModule.name
 		}
 
 	pd_module :: ![ParsedDefinition] -> ModuleEntry
@@ -535,7 +563,7 @@ where
 
 	pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
 	pd_rewriterules dcl defs st
-		= [( setLine dcl pos {zero & name=Just id.id_name}
+		= [( setLine dcl pos {LocationInModule | zero & name=Just id.id_name}
 		   , let doc = findDoc hideIsUsedReturn id st in
 		     trace_type_warning id
 		     { zero
@@ -578,7 +606,7 @@ where
 
 	pd_generics :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
 	pd_generics dcl defs st
-		= [( setLine dcl gen_pos {zero & name=Just id_name}
+		= [( setLine dcl gen_pos {LocationInModule | zero & name=Just id_name}
 		   , { zero
 		     & fe_type=Just $ 'T'.toType gen_type
 		     , fe_generic_vars=Just $ map 'T'.toTypeVar gen_vars
@@ -591,7 +619,7 @@ where
 
 	pd_typespecs :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.FunctionEntry, 'S'.Set String)]
 	pd_typespecs dcl defs st
-		= [( setLine dcl pos {zero & name=Just id_name}
+		= [( setLine dcl pos {LocationInModule | zero & name=Just id_name}
 		   , { zero
 		     & fe_type=Just $ 'T'.toType t
 		     , fe_priority = 'T'.toMaybePriority p
@@ -618,7 +646,7 @@ where
 	pd_classes dcl defs st
 		= [ let
 		      typespecs = pd_typespecs True clsdefs st
-		      macros = [(n,(r,ids)) \\ ({name=Just n},{fe_representation=Just r},ids) <- pd_rewriterules dcl clsdefs st]
+		      macros = [(n,(r,ids)) \\ ({LocationInModule | name=Just n},{fe_representation=Just r},ids) <- pd_rewriterules dcl clsdefs st]
 		      updateRepresentation n fe
 		        = { fe
 		          & fe_kind=if (isNothing $ lookup n macros) fe.fe_kind Macro
@@ -627,8 +655,8 @@ where
 		              ((\d -> {FunctionDoc | d & vars=[]}) <$> findDoc hideIsUsedReturn id st)
 		              fe.fe_documentation
 		          }
-		      members = [(f,updateRepresentation f et,ids) \\ ({name=Just f}, et, ids) <- typespecs]
-		    in ( setLine dcl class_pos {zero & name=Just id_name}
+		      members = [(f,updateRepresentation f et,ids) \\ ({LocationInModule | name=Just f}, et, ids) <- typespecs]
+		    in ( setLine dcl class_pos {LocationInModule | zero & name=Just id_name}
 		       , 'CDB'.toClass
 		         NoLocation
 		         (map 'T'.toTypeVar class_args)
@@ -655,7 +683,7 @@ where
 
 		isSingleFunction :: [(LocationInModule, 'CDB'.FunctionEntry, a)] Ident -> Bool
 		isSingleFunction members id = length members == 1
-			&& fromJust (fst3 $ hd members).name == id.id_name
+			&& fromJust (fst3 $ hd members).LocationInModule.name == id.id_name
 
 		// Hide warnings about @result and @param on single function classes
 		hideFunctionOnClass (IllegalField "param")  = False
@@ -665,7 +693,7 @@ where
 	pd_types :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'CDB'.TypeDefEntry)]
 	pd_types dcl defs st
 		= [let name = 'T'.td_name td in
-			( setLine dcl ptd.td_pos {zero & name=Just name}
+			( setLine dcl ptd.td_pos {LocationInModule | zero & name=Just name}
 			, 'CDB'.toTypeDefEntry NoLocation td $ Just $ findRhsDoc ptd $ fromMaybe gDefault{|*|} $
 				findDoc (const True) ptd.td_ident st
 			) \\ PD_Type ptd <- defs, td <- ['T'.toTypeDef ptd]]