Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Cloogle
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Cloogle
Cloogle
Commits
96f1ea60
Verified
Commit
96f1ea60
authored
Apr 04, 2018
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
More logical indexing pipeline
parent
f700b326
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
115 additions
and
59 deletions
+115
-59
CloogleDB.dcl
CloogleDB.dcl
+6
-0
CloogleDB.icl
CloogleDB.icl
+3
-0
CloogleDBFactory.dcl
CloogleDBFactory.dcl
+34
-15
CloogleDBFactory.icl
CloogleDBFactory.icl
+72
-44
No files found.
CloogleDB.dcl
View file @
96f1ea60
...
...
@@ -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
View file @
96f1ea60
...
...
@@ -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
View file @
96f1ea60
...
...
@@ -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
View file @
96f1ea60
...
...
@@ -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
=
[(
mod
f
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
]]
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment