Verified Commit 96f1ea60 authored by Camil Staps's avatar Camil Staps 🚀

More logical indexing pipeline

parent f700b326
......@@ -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
*/
......
......@@ -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
......
......@@ -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
......
......@@ -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
where
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
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
......@@ -523,7 +551,7 @@ where
joinLoc a b =
{ dcl_line = a.dcl_line <|> b.dcl_line
, icl_line = a.icl_line <|> b.icl_line
, name = a.name <|> b.name
, 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]]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment