Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
H
haddock
Manage
Activity
Members
Labels
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Model registry
Operate
Environments
Analyze
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
Glasgow Haskell Compiler
haddock
Commits
1c4e35f9
Commit
1c4e35f9
authored
17 years ago
by
David Waern
Browse files
Options
Downloads
Patches
Plain Diff
Add support for --read-interface again
parent
3242a415
No related branches found
No related tags found
No related merge requests found
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
src/Haddock/InterfaceFile.hs
+10
-6
10 additions, 6 deletions
src/Haddock/InterfaceFile.hs
src/Haddock/Options.hs
+18
-3
18 additions, 3 deletions
src/Haddock/Options.hs
src/Haddock/Packages.hs
+21
-1
21 additions, 1 deletion
src/Haddock/Packages.hs
src/Main.hs
+11
-6
11 additions, 6 deletions
src/Main.hs
with
60 additions
and
16 deletions
src/Haddock/InterfaceFile.hs
+
10
−
6
View file @
1c4e35f9
...
@@ -45,15 +45,19 @@ data InterfaceMod = InterfaceMod {
...
@@ -45,15 +45,19 @@ data InterfaceMod = InterfaceMod {
}
}
data
InterfaceFile
=
InterfaceFile
{
data
InterfaceFile
=
InterfaceFile
{
ifLinkEnv
::
LinkEnv
ifLinkEnv
::
LinkEnv
,
--
ifModules :: [
Interface
Mod]
ifModules
::
[
Mod
ule
]
}
}
instance
Binary
InterfaceFile
where
instance
Binary
InterfaceFile
where
put_
bh
(
InterfaceFile
x
)
=
put_
bh
(
Map
.
toList
x
)
put_
bh
(
InterfaceFile
env
mods
)
=
do
get
bh
=
do
put_
bh
(
Map
.
toList
env
)
env
<-
get
bh
put_
bh
mods
return
(
InterfaceFile
(
Map
.
fromList
env
))
get
bh
=
do
env
<-
get
bh
mods
<-
get
bh
return
(
InterfaceFile
(
Map
.
fromList
env
)
mods
)
iface2interface
iface
=
InterfaceMod
{
iface2interface
iface
=
InterfaceMod
{
imModule
=
ifaceMod
iface
,
imModule
=
ifaceMod
iface
,
...
...
This diff is collapsed.
Click to expand it.
src/Haddock/Options.hs
+
18
−
3
View file @
1c4e35f9
...
@@ -9,7 +9,8 @@ module Haddock.Options (
...
@@ -9,7 +9,8 @@ module Haddock.Options (
parseHaddockOpts
,
parseHaddockOpts
,
Flag
(
..
),
Flag
(
..
),
getUsage
,
getUsage
,
makeGhcFlags
getGhcFlags
,
getIfacePairs
)
where
)
where
...
@@ -36,14 +37,26 @@ parseHaddockOpts words =
...
@@ -36,14 +37,26 @@ parseHaddockOpts words =
throwE
(
concat
errors
++
usage
)
throwE
(
concat
errors
++
usage
)
makeGhcFlags
::
[
Flag
]
->
[
String
]
getGhcFlags
::
[
Flag
]
->
[
String
]
makeGhcFlags
flags
=
[
option
|
Flag_OptGhc
option
<-
flags
]
getGhcFlags
flags
=
[
option
|
Flag_OptGhc
option
<-
flags
]
getIfacePairs
::
[
Flag
]
->
[(
FilePath
,
FilePath
)]
getIfacePairs
flags
=
[
parseIfaceOption
s
|
Flag_ReadInterface
s
<-
flags
]
parseIfaceOption
::
String
->
(
FilePath
,
FilePath
)
parseIfaceOption
s
=
case
break
(
==
','
)
s
of
(
fpath
,
','
:
file
)
->
(
fpath
,
file
)
(
file
,
_
)
->
(
""
,
file
)
data
Flag
data
Flag
=
Flag_CSS
String
=
Flag_CSS
String
|
Flag_Debug
|
Flag_Debug
-- | Flag_DocBook
-- | Flag_DocBook
|
Flag_ReadInterface
String
|
Flag_DumpInterface
String
|
Flag_DumpInterface
String
|
Flag_Heading
String
|
Flag_Heading
String
|
Flag_Html
|
Flag_Html
...
@@ -83,6 +96,8 @@ options backwardsCompat =
...
@@ -83,6 +96,8 @@ options backwardsCompat =
"directory in which to put the output files"
,
"directory in which to put the output files"
,
Option
[
'l'
]
[
"lib"
]
(
ReqArg
Flag_Lib
"DIR"
)
Option
[
'l'
]
[
"lib"
]
(
ReqArg
Flag_Lib
"DIR"
)
"location of Haddock's auxiliary files"
,
"location of Haddock's auxiliary files"
,
Option
[
'i'
]
[
"read-interface"
]
(
ReqArg
Flag_ReadInterface
"FILE"
)
"read an interface from FILE"
,
Option
[
'D'
]
[
"dump-interface"
]
(
ReqArg
Flag_DumpInterface
"FILE"
)
Option
[
'D'
]
[
"dump-interface"
]
(
ReqArg
Flag_DumpInterface
"FILE"
)
"interface file name"
,
"interface file name"
,
-- Option ['S'] ["docbook"] (NoArg Flag_DocBook)
-- Option ['S'] ["docbook"] (NoArg Flag_DocBook)
...
...
This diff is collapsed.
Click to expand it.
src/Haddock/Packages.hs
+
21
−
1
View file @
1c4e35f9
...
@@ -8,6 +8,7 @@
...
@@ -8,6 +8,7 @@
module
Haddock.Packages
(
module
Haddock.Packages
(
HaddockPackage
(
..
),
HaddockPackage
(
..
),
getHaddockPackages
,
getHaddockPackages
,
getHaddockPackages'
,
combineLinkEnvs
combineLinkEnvs
)
where
)
where
...
@@ -15,6 +16,7 @@ module Haddock.Packages (
...
@@ -15,6 +16,7 @@ module Haddock.Packages (
import
Haddock.Types
import
Haddock.Types
import
Haddock.Exception
import
Haddock.Exception
import
Haddock.InterfaceFile
import
Haddock.InterfaceFile
import
qualified
Distribution.Haddock
as
D
import
Data.Maybe
import
Data.Maybe
import
qualified
Data.Map
as
Map
import
qualified
Data.Map
as
Map
...
@@ -38,6 +40,24 @@ data HaddockPackage = HaddockPackage {
...
@@ -38,6 +40,24 @@ data HaddockPackage = HaddockPackage {
}
}
getHaddockPackages'
::
[(
FilePath
,
FilePath
)]
->
IO
[
HaddockPackage
]
getHaddockPackages'
pairs
=
do
mbPackages
<-
mapM
tryReadIface
pairs
return
(
catMaybes
mbPackages
)
where
-- try to get a HaddockPackage, warn if we can't
tryReadIface
(
html
,
iface
)
=
do
eIface
<-
D
.
readInterfaceFile
iface
case
eIface
of
Left
err
->
do
putStrLn
(
"Warning: Cannot read "
++
iface
++
":"
)
putStrLn
(
" "
++
show
err
)
putStrLn
"Skipping this interface."
return
Nothing
Right
iface
->
return
$
Just
$
HaddockPackage
(
ifModules
iface
)
(
ifLinkEnv
iface
)
html
-- | Try to read the installed Haddock information for the given packages,
-- | Try to read the installed Haddock information for the given packages,
-- if it exists. Print a warning on stdout if it couldn't be found for a
-- if it exists. Print a warning on stdout if it couldn't be found for a
-- package.
-- package.
...
@@ -65,7 +85,7 @@ getPackage pkgInfo = do
...
@@ -65,7 +85,7 @@ getPackage pkgInfo = do
iface
<-
readInterfaceFile
ifacePath
iface
<-
readInterfaceFile
ifacePath
return
$
HaddockPackage
{
return
$
HaddockPackage
{
pdModules
=
package
Modules
pkgInfo
,
pdModules
=
if
Modules
iface
,
pdLinkEnv
=
ifLinkEnv
iface
,
pdLinkEnv
=
ifLinkEnv
iface
,
pdHtmlPath
=
html
pdHtmlPath
=
html
}
}
...
...
This diff is collapsed.
Click to expand it.
src/Main.hs
+
11
−
6
View file @
1c4e35f9
...
@@ -105,14 +105,18 @@ main = handleTopExceptions $ do
...
@@ -105,14 +105,18 @@ main = handleTopExceptions $ do
libDir
<-
handleEasyFlags
flags
fileArgs
libDir
<-
handleEasyFlags
flags
fileArgs
-- initialize GHC
-- initialize GHC
let
ghcFlags
=
make
GhcFlags
flags
let
ghcFlags
=
get
GhcFlags
flags
(
session
,
dynflags
)
<-
startGhc
libDir
ghcFlags
(
session
,
dynflags
)
<-
startGhc
libDir
ghcFlags
-- get the -use-package packages, load them in GHC,
-- get the -use-package packages, load them in GHC,
-- and try to get the corresponding installed HaddockPackages
-- and try to get the corresponding installed HaddockPackages
let
usePackages
=
[
pkg
|
Flag_UsePackage
pkg
<-
flags
]
let
usePackages
=
[
pkg
|
Flag_UsePackage
pkg
<-
flags
]
pkgInfos
<-
loadPackages
session
usePackages
pkgInfos
<-
loadPackages
session
usePackages
packages
<-
getHaddockPackages
pkgInfos
packages''
<-
getHaddockPackages
pkgInfos
-- get packages via --read-interface
packages'
<-
getHaddockPackages'
(
getIfacePairs
flags
)
let
packages
=
packages''
++
packages'
-- typecheck argument modules using GHC
-- typecheck argument modules using GHC
modules
<-
typecheckFiles
session
fileArgs
modules
<-
typecheckFiles
session
fileArgs
...
@@ -129,7 +133,7 @@ main = handleTopExceptions $ do
...
@@ -129,7 +133,7 @@ main = handleTopExceptions $ do
render
flags
interfaces
render
flags
interfaces
-- last but not least, dump the interface file!
-- last but not least, dump the interface file!
dumpInterfaceFile
homeLinks
flags
dumpInterfaceFile
(
map
ghcModule
modules
)
homeLinks
flags
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
...
@@ -217,14 +221,15 @@ render flags interfaces = do
...
@@ -217,14 +221,15 @@ render flags interfaces = do
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
dumpInterfaceFile
::
LinkEnv
->
[
Flag
]
->
IO
()
dumpInterfaceFile
::
[
Module
]
->
LinkEnv
->
[
Flag
]
->
IO
()
dumpInterfaceFile
homeLinks
flags
=
dumpInterfaceFile
modules
homeLinks
flags
=
case
[
str
|
Flag_DumpInterface
str
<-
flags
]
of
case
[
str
|
Flag_DumpInterface
str
<-
flags
]
of
[]
->
return
()
[]
->
return
()
fs
->
let
filename
=
last
fs
in
writeInterfaceFile
filename
ifaceFile
fs
->
let
filename
=
last
fs
in
writeInterfaceFile
filename
ifaceFile
where
where
ifaceFile
=
InterfaceFile
{
ifaceFile
=
InterfaceFile
{
ifLinkEnv
=
homeLinks
ifModules
=
modules
,
ifLinkEnv
=
homeLinks
}
}
...
...
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