Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
H
haddock
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package registry
Container registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Rinat Striungis
haddock
Commits
f2c7dd08
Commit
f2c7dd08
authored
18 years ago
by
David Waern
Browse files
Options
Downloads
Patches
Plain Diff
Filter out all non-vanilla type sigs
parent
7979ad1f
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
src/Haddock/Interface/Create.hs
+13
-10
13 additions, 10 deletions
src/Haddock/Interface/Create.hs
with
13 additions
and
10 deletions
src/Haddock/Interface/Create.hs
+
13
−
10
View file @
f2c7dd08
...
@@ -148,13 +148,14 @@ sortByLoc = map unLoc . sortBy (comparing getLoc)
...
@@ -148,13 +148,14 @@ sortByLoc = map unLoc . sortBy (comparing getLoc)
getClassEntities
tcd
=
sortByLoc
(
docs
++
meths
++
sigs
)
getClassEntities
tcd
=
sortByLoc
(
docs
++
meths
++
sigs
)
where
where
docs
=
[
L
l
(
DocEntity
d
)
|
L
l
d
<-
tcdDocs
tcd
]
docs
=
[
L
l
(
DocEntity
d
)
|
L
l
d
<-
tcdDocs
tcd
]
meths
=
meths
=
let
bindings
=
bagToList
(
tcdMeths
tcd
)
let
bindings
=
bagToList
(
tcdMeths
tcd
)
bindingName
=
unLoc
.
fun_id
bindingName
=
unLoc
.
fun_id
in
[
L
l
(
DeclEntity
(
bindingName
b
))
|
L
l
b
<-
bindings
]
in
[
L
l
(
DeclEntity
(
bindingName
b
))
|
L
l
b
<-
bindings
]
sigs
=
let
sigName
=
fromJust
.
sigNameNoLoc
-- TODO: fixities
in
[
L
l
(
DeclEntity
(
sigName
sig
))
|
L
l
sig
<-
tcdSigs
tcd
]
sigs
=
[
L
l
$
DeclEntity
name
|
L
l
(
TypeSig
(
L
_
name
)
_
)
<-
tcdSigs
tcd
]
-- | Get all the top level entities in a module. The entities are sorted by
-- | Get all the top level entities in a module. The entities are sorted by
...
@@ -170,7 +171,8 @@ getTopEntities group = sortByLoc (docs ++ declarations)
...
@@ -170,7 +171,8 @@ getTopEntities group = sortByLoc (docs ++ declarations)
-- we just use the sigs here for now.
-- we just use the sigs here for now.
-- TODO: collect from the bindings as well
-- TODO: collect from the bindings as well
-- (needed for docs to work for inferred entities)
-- (needed for docs to work for inferred entities)
in
[
(
l
,
fromJust
(
sigNameNoLoc
s
))
|
L
l
s
<-
sigs
]
in
[
(
l
,
fromJust
(
sigNameNoLoc
s
))
|
L
l
s
<-
sigs
,
isVanillaLSig
(
L
l
s
)
]
-- TODO: document fixity decls
tyclds
=
[
(
l
,
tcdName
t
)
|
L
l
t
<-
hs_tyclds
group
]
tyclds
=
[
(
l
,
tcdName
t
)
|
L
l
t
<-
hs_tyclds
group
]
fords
=
[
(
l
,
forName
f
)
|
L
l
f
<-
hs_fords
group
]
fords
=
[
(
l
,
forName
f
)
|
L
l
f
<-
hs_fords
group
]
where
where
...
@@ -290,10 +292,7 @@ getDeclFromGroup group name =
...
@@ -290,10 +292,7 @@ getDeclFromGroup group name =
[
lsig
]
->
Just
(
L
(
getLoc
lsig
)
(
SigD
(
unLoc
lsig
)))
[
lsig
]
->
Just
(
L
(
getLoc
lsig
)
(
SigD
(
unLoc
lsig
)))
_
->
Nothing
_
->
Nothing
where
where
matching
=
[
lsig
|
lsig
<-
lsigs
,
let
Just
n
=
sigName
lsig
,
n
==
name
,
matching
=
[
lsig
|
L
l
(
TypeSig
(
L
_
n
)
_
)
<-
lsigs
,
n
==
name
]
isNormal
(
unLoc
lsig
)
]
isNormal
(
TypeSig
_
_
)
=
True
isNormal
_
=
False
getDeclFromVals
_
=
error
"getDeclFromVals: illegal input"
getDeclFromVals
_
=
error
"getDeclFromVals: illegal input"
...
@@ -314,8 +313,11 @@ getDeclFromGroup group name =
...
@@ -314,8 +313,11 @@ getDeclFromGroup group name =
[
ltycl
]
->
Just
(
L
(
getLoc
ltycl
)
(
TyClD
(
unLoc
ltycl
)))
[
ltycl
]
->
Just
(
L
(
getLoc
ltycl
)
(
TyClD
(
unLoc
ltycl
)))
_
->
Nothing
_
->
Nothing
where
where
matching
=
[
ltycl
|
ltycl
<-
ltycls
,
matching
=
[
fmap
makeVanillaTyCl
ltycl
|
ltycl
<-
ltycls
,
name
`
elem
`
map
unLoc
(
tyClDeclNames
(
unLoc
ltycl
))]
name
`
elem
`
map
unLoc
(
tyClDeclNames
(
unLoc
ltycl
))]
where
makeVanillaTyCl
tycl
=
tycl
{
tcdSigs
=
filter
isVanillaLSig
(
tcdSigs
tycl
)
}
getDeclFromFors
lfors
=
case
matching
of
getDeclFromFors
lfors
=
case
matching
of
[
for
]
->
Just
(
L
(
getLoc
for
)
(
ForD
(
unLoc
for
)))
[
for
]
->
Just
(
L
(
getLoc
for
)
(
ForD
(
unLoc
for
)))
...
@@ -425,7 +427,8 @@ extractDecl name mdl decl
...
@@ -425,7 +427,8 @@ extractDecl name mdl decl
|
otherwise
=
|
otherwise
=
case
unLoc
decl
of
case
unLoc
decl
of
TyClD
d
|
isClassDecl
d
->
TyClD
d
|
isClassDecl
d
->
let
matches
=
[
sig
|
sig
<-
tcdSigs
d
,
sigName
sig
==
Just
name
]
let
matches
=
[
sig
|
sig
<-
tcdSigs
d
,
sigName
sig
==
Just
name
,
isVanillaLSig
sig
]
-- TODO: document fixity
in
case
matches
of
in
case
matches
of
[
s0
]
->
let
(
n
,
tyvar_names
)
=
name_and_tyvars
d
[
s0
]
->
let
(
n
,
tyvar_names
)
=
name_and_tyvars
d
L
pos
sig
=
extractClassDecl
n
mdl
tyvar_names
s0
L
pos
sig
=
extractClassDecl
n
mdl
tyvar_names
s0
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment