Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
1c8a0e7a
Commit
1c8a0e7a
authored
Dec 24, 2015
by
Andrey Mokhov
Browse files
Fix haddockArgs, clean up code.
parent
f354291e
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/Base.hs
View file @
1c8a0e7a
...
...
@@ -26,7 +26,7 @@ module Base (
-- * Miscellaneous utilities
bimap
,
minusOrd
,
intersectOrd
,
removeFileIfExists
,
replaceEq
,
chunksOfSize
,
replaceSeparators
,
decodeModule
,
encodeModule
,
unifyPath
,
(
-/-
)
replaceSeparators
,
decodeModule
,
encodeModule
,
unifyPath
,
(
-/-
)
,
versionToInt
)
where
import
Control.Applicative
...
...
@@ -37,7 +37,7 @@ import Data.Function
import
Data.List
import
Data.Maybe
import
Data.Monoid
import
Development.Shake
hiding
(
unit
,
(
*>
)
,
parallel
)
import
Development.Shake
hiding
(
unit
,
(
*>
))
import
Development.Shake.Classes
import
Development.Shake.Config
import
Development.Shake.FilePath
...
...
@@ -77,6 +77,12 @@ replaceSeparators = replaceIf isPathSeparator
replaceIf
::
(
a
->
Bool
)
->
a
->
[
a
]
->
[
a
]
replaceIf
p
to
=
map
(
\
from
->
if
p
from
then
to
else
from
)
-- | Given a version string such as "2.16.2" produce an integer equivalent
versionToInt
::
String
->
Int
versionToInt
s
=
major
*
1000
+
minor
*
10
+
patch
where
[
major
,
minor
,
patch
]
=
map
read
.
words
$
replaceEq
'.'
' '
s
-- | Given a module name extract the directory and file name, e.g.:
--
-- > decodeModule "Data.Functor.Identity" = ("Data/Functor/", "Identity")
...
...
src/Package.hs
View file @
1c8a0e7a
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
module
Package
(
Package
(
..
),
PackageName
(
..
),
PackageType
(
..
),
Package
(
..
),
PackageName
(
..
),
PackageType
(
..
),
-- * Queries
pkgNameString
,
pkgCabalFile
,
...
...
@@ -18,7 +17,7 @@ import Data.String
-- | The name of a Cabal package
newtype
PackageName
=
PackageName
{
getPackageName
::
String
}
deriving
(
Eq
,
Ord
,
IsString
,
Generic
,
Binary
,
Hashable
,
NFData
)
,
Typeable
,
NFData
)
instance
Show
PackageName
where
show
(
PackageName
name
)
=
name
...
...
src/Rules/Cabal.hs
View file @
1c8a0e7a
module
Rules.Cabal
(
cabalRules
)
where
import
Data.Version
import
Distribution.Package
as
DP
hiding
(
Package
)
import
Distribution.Package
as
DP
import
Distribution.PackageDescription
import
Distribution.PackageDescription.Parse
import
Distribution.Verbosity
import
Expression
import
GHC
import
Package
hiding
(
library
)
import
Settings
cabalRules
::
Rules
()
...
...
src/Settings/Builders/Haddock.hs
View file @
1c8a0e7a
...
...
@@ -16,6 +16,7 @@ haddockArgs = builder Haddock ? do
hidden
<-
getPkgDataList
HiddenModules
deps
<-
getPkgDataList
Deps
depNames
<-
getPkgDataList
DepNames
hVersion
<-
lift
.
pkgData
.
Version
$
targetPath
Stage2
haddock
ghcOpts
<-
fromDiffExpr
commonGhcArgs
mconcat
[
arg
$
"--odir="
++
takeDirectory
output
...
...
@@ -26,6 +27,7 @@ haddockArgs = builder Haddock ? do
,
arg
"--hoogle"
,
arg
$
"--title="
++
pkgNameString
pkg
++
"-"
++
version
++
": "
++
synopsis
,
arg
$
"--prologue="
++
path
-/-
"haddock-prologue.txt"
,
arg
$
"--optghc=-D__HADDOCK_VERSION__="
++
show
(
versionToInt
hVersion
)
,
append
$
map
(
"--hide="
++
)
hidden
,
append
$
[
"--read-interface=../"
++
dep
++
",../"
++
dep
++
"/src/%{MODULE/./-}.html
\\
#%{NAME},"
...
...
@@ -40,7 +42,7 @@ haddockArgs = builder Haddock ? do
,
customPackageArgs
,
append
=<<
getInputs
,
arg
"+RTS"
,
arg
$
"-t"
++
path
</>
"haddock.t"
,
arg
$
"-t"
++
path
-/-
"haddock.t"
,
arg
"--machine-readable"
]
customPackageArgs
::
Args
...
...
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment