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
Packages
Cabal
Commits
982ca25c
Commit
982ca25c
authored
Jul 30, 2004
by
md9ms
Browse files
Improve error reporting in the description parser
parent
88237745
Changes
1
Hide whitespace changes
Inline
Side-by-side
Distribution/Package.hs
View file @
982ca25c
...
...
@@ -55,7 +55,7 @@ module Distribution.Package (
#
endif
)
where
import
Control.Monad
(
foldM
)
import
Control.Monad
(
foldM
,
liftM
)
import
Data.Char
import
Data.List
(
isPrefixOf
)
import
Data.Maybe
(
fromMaybe
)
...
...
@@ -186,16 +186,25 @@ parsePackageDesc p = do h <- openFile p ReadMode
->
error
"no library listed, and no executable stanza."
Right
x
->
return
x
data
PError
=
AmbigousParse
|
NoParse
|
FromString
String
type
LineNo
=
Int
type
Stanza
=
[(
LineNo
,
String
,
String
)]
data
PError
=
AmbigousParse
String
LineNo
|
NoParse
String
LineNo
|
FromString
String
(
Maybe
LineNo
)
deriving
Show
instance
Error
PError
where
strMsg
=
FromString
strMsg
s
=
FromString
s
Nothing
showError
::
PError
->
String
showError
AmbigousParse
=
"Ambigous parse"
showError
NoParse
=
"No parse"
showError
(
FromString
s
)
=
s
showError
(
AmbigousParse
f
n
)
=
"Line "
++
show
n
++
": Ambigous parse in field '"
++
f
++
"'"
showError
(
NoParse
f
n
)
=
"Line "
++
show
n
++
": Parse of field '"
++
f
++
"' failed"
showError
(
FromString
s
(
Just
n
))
=
"Line "
++
show
n
++
": "
++
s
showError
(
FromString
s
Nothing
)
=
s
myError
::
LineNo
->
String
->
Either
PError
a
myError
n
s
=
Left
$
FromString
s
(
Just
n
)
parseDescription
::
String
->
Either
PError
PackageDescription
parseDescription
inp
=
do
let
(
st
:
sts
)
=
splitStanzas
inp
...
...
@@ -203,99 +212,111 @@ parseDescription inp = do let (st:sts) = splitStanzas inp
exes
<-
mapM
parseExecutableStanza
sts
return
pkg
{
executables
=
exes
}
where
-- The basic stanza, with library building info
parseBasicStanza
pkg
(
"name"
,
val
)
=
return
(
setPkgName
val
pkg
)
parseBasicStanza
pkg
(
"version"
,
val
)
=
do
v
<-
runP
parseVersion
val
parseBasicStanza
pkg
(
lineNo
,
f
@
"name"
,
val
)
=
do
name
<-
runP
lineNo
f
parsePackageName
val
return
(
setPkgName
name
pkg
)
parseBasicStanza
pkg
(
lineNo
,
f
@
"version"
,
val
)
=
do
v
<-
runP
lineNo
f
parseVersion
val
return
(
setPkgVersion
v
pkg
)
parseBasicStanza
pkg
(
"copyright"
,
val
)
=
return
pkg
{
copyright
=
val
}
parseBasicStanza
pkg
(
"license"
,
val
)
=
do
l
<-
runP
parseLicense
val
parseBasicStanza
pkg
(
lineNo
,
"copyright"
,
val
)
=
return
pkg
{
copyright
=
val
}
parseBasicStanza
pkg
(
lineNo
,
f
@
"license"
,
val
)
=
do
l
<-
runP
lineNo
f
parseLicense
val
return
pkg
{
license
=
l
}
parseBasicStanza
pkg
(
"license-file"
,
val
)
=
do
path
<-
runP
parseFilePath
val
parseBasicStanza
pkg
(
lineNo
,
f
@
"license-file"
,
val
)
=
do
path
<-
runP
lineNo
f
parseFilePath
val
return
pkg
{
license
=
OtherLicense
path
}
parseBasicStanza
pkg
(
"maintainer"
,
val
)
=
return
pkg
{
maintainer
=
val
}
parseBasicStanza
pkg
(
"stability"
,
val
)
=
return
pkg
{
stability
=
val
}
parseBasicStanza
pkg
(
field
,
val
)
=
parseBasicStanza
pkg
(
lineNo
,
"maintainer"
,
val
)
=
return
pkg
{
maintainer
=
val
}
parseBasicStanza
pkg
(
lineNo
,
"stability"
,
val
)
=
return
pkg
{
stability
=
val
}
parseBasicStanza
pkg
(
lineNo
,
field
,
val
)
=
do
let
lib
=
fromMaybe
emptyBuildInfo
(
library
pkg
)
lib'
<-
parse
ExeH
el
p
lib
(
field
,
val
)
lib'
<-
parse
BInfoFi
el
d
lib
(
lineNo
,
field
,
val
)
return
pkg
{
library
=
Just
lib'
}
-- Stanzas for executables
parseExecutableStanza
((
"executable"
,
eName
)
:
st
)
=
case
lookup
"main-is"
st
of
Just
xs
->
do
path
<-
runP
parseFilePath
xs
binfo
<-
foldM
parse
ExeH
el
p
emptyBuildInfo
st
return
$
Executable
eName
path
binfo
parseExecutableStanza
((
lineNo
,
f
@
"executable"
,
eName
)
:
st
)
=
case
lookup
Field
"main-is"
st
of
Just
(
lineNo
,
val
)
->
do
path
<-
runP
lineNo
f
parseFilePath
val
binfo
<-
foldM
parse
BInfoFi
el
d
emptyBuildInfo
st
return
$
Executable
eName
path
binfo
Nothing
->
fail
$
"No 'Main-Is' field found for "
++
eName
++
" stanza"
parseExecutableStanza
((
f
,
_
)
:
_
)
=
fail
$
parseExecutableStanza
((
lineNo
,
f
,
_
)
:
_
)
=
myError
lineNo
$
"'Executable' stanza starting with field '"
++
f
++
"'"
parseExecutableStanza
_
=
error
"This shouldn't happen!"
parse
ExeH
el
p
binfo
(
"main-is"
,
_
)
=
return
binfo
parse
ExeH
el
p
binfo
(
"extra-libs"
,
val
)
=
do
xs
<-
runP
(
parseCommaList
parseLibName
)
val
parse
BInfoFi
el
d
binfo
(
lineNo
,
"main-is"
,
_
)
=
return
binfo
parse
BInfoFi
el
d
binfo
(
lineNo
,
f
@
"extra-libs"
,
val
)
=
do
xs
<-
runP
lineNo
f
(
parseCommaList
parseLibName
)
val
return
binfo
{
extraLibs
=
xs
}
parse
ExeH
el
p
binfo
(
"build-depends"
,
val
)
=
do
xs
<-
runP
(
parseCommaList
parseDependency
)
val
parse
BInfoFi
el
d
binfo
(
lineNo
,
f
@
"build-depends"
,
val
)
=
do
xs
<-
runP
lineNo
f
(
parseCommaList
parseDependency
)
val
return
binfo
{
buildDepends
=
xs
}
-- Paths and stuff
parse
ExeH
el
p
binfo
(
"c-sources"
,
val
)
=
do
paths
<-
runP
(
parseCommaList
parseFilePath
)
val
parse
BInfoFi
el
d
binfo
(
lineNo
,
f
@
"c-sources"
,
val
)
=
do
paths
<-
runP
lineNo
f
(
parseCommaList
parseFilePath
)
val
return
binfo
{
cSources
=
paths
}
parse
ExeH
el
p
binfo
(
"include-dirs"
,
val
)
=
do
paths
<-
runP
(
parseCommaList
parseFilePath
)
val
parse
BInfoFi
el
d
binfo
(
lineNo
,
f
@
"include-dirs"
,
val
)
=
do
paths
<-
runP
lineNo
f
(
parseCommaList
parseFilePath
)
val
return
binfo
{
includeDirs
=
paths
}
parse
ExeH
el
p
binfo
(
"includes"
,
val
)
=
do
paths
<-
runP
(
parseCommaList
parseFilePath
)
val
parse
BInfoFi
el
d
binfo
(
lineNo
,
f
@
"includes"
,
val
)
=
do
paths
<-
runP
lineNo
f
(
parseCommaList
parseFilePath
)
val
return
binfo
{
includes
=
paths
}
parse
ExeH
el
p
binfo
(
"hs-source-dir"
,
val
)
=
do
path
<-
runP
parseFilePath
val
parse
BInfoFi
el
d
binfo
(
lineNo
,
f
@
"hs-source-dir"
,
val
)
=
do
path
<-
runP
lineNo
f
parseFilePath
val
return
binfo
{
hsSourceDir
=
path
}
-- Module related
parse
ExeH
el
p
binfo
(
"modules"
,
val
)
=
do
xs
<-
runP
(
parseCommaList
parseModuleName
)
val
parse
BInfoFi
el
d
binfo
(
lineNo
,
f
@
"modules"
,
val
)
=
do
xs
<-
runP
lineNo
f
(
parseCommaList
parseModuleName
)
val
return
binfo
{
modules
=
xs
}
parse
ExeH
el
p
binfo
(
"exposed-modules"
,
val
)
=
do
xs
<-
runP
(
parseCommaList
parseModuleName
)
val
parse
BInfoFi
el
d
binfo
(
lineNo
,
f
@
"exposed-modules"
,
val
)
=
do
xs
<-
runP
lineNo
f
(
parseCommaList
parseModuleName
)
val
return
binfo
{
exposedModules
=
xs
}
parse
ExeH
el
p
binfo
(
"extensions"
,
val
)
=
do
exts
<-
runP
(
parseCommaList
parseExtension
)
val
parse
BInfoFi
el
d
binfo
(
lineNo
,
f
@
"extensions"
,
val
)
=
do
exts
<-
runP
lineNo
f
(
parseCommaList
parseExtension
)
val
return
binfo
{
extensions
=
exts
}
parse
ExeH
el
p
binfo
(
f
,
val
)
|
"options-"
`
isPrefixOf
`
f
=
parse
BInfoFi
el
d
binfo
(
lineNo
,
f
,
val
)
|
"options-"
`
isPrefixOf
`
f
=
let
compilers
=
[(
"ghc"
,
GHC
),(
"nhc"
,
NHC
),(
"hugs"
,
Hugs
)]
-- FIXME
in
case
lookup
(
drop
(
length
"options-"
)
f
)
compilers
of
Just
c
->
return
(
setOptions
c
(
words
val
)
binfo
)
Nothing
->
error
$
"Unknown compiler ("
++
drop
8
f
++
")"
parseExeHelp
_binfo
(
field
,
_val
)
=
error
$
"Unknown field :: "
++
field
Nothing
->
myError
lineNo
$
"Unknown compiler '"
++
drop
8
f
++
"'"
parseBInfoField
_binfo
(
lineNo
,
field
,
_val
)
=
myError
lineNo
$
"Unknown field '"
++
field
++
"'"
-- ...
runP
::
ReadP
a
a
->
String
->
Either
PError
a
runP
p
s
=
case
[
x
|
(
x
,
""
)
<-
readP_to_S
p
s
]
of
lookupField
::
String
->
Stanza
->
Maybe
(
LineNo
,
String
)
lookupField
x
[]
=
Nothing
lookupField
x
((
n
,
f
,
v
)
:
st
)
|
x
==
f
=
Just
(
n
,
v
)
|
otherwise
=
lookupField
x
st
runP
::
LineNo
->
String
->
ReadP
a
a
->
String
->
Either
PError
a
runP
lineNo
field
p
s
=
case
[
x
|
(
x
,
""
)
<-
results
]
of
[
a
]
->
Right
a
[]
->
case
[
x
|
(
x
,
ys
)
<-
results
,
all
isSpace
ys
]
of
[
a
]
->
Right
a
[]
->
Left
NoParse
_
->
Left
AmbigousParse
type
Stanza
=
[(
String
,
String
)]
[]
->
Left
(
NoParse
field
lineNo
)
_
->
Left
(
AmbigousParse
field
lineNo
)
_
->
Left
(
AmbigousParse
field
lineNo
)
where
results
=
readP_to_S
p
s
-- |Split a string into blank line-separated stanzas of
-- "Field: value" groups
splitStanzas
::
String
->
[
Stanza
]
splitStanzas
=
map
merge
.
groupStanzas
.
filter
validLine
.
lines
where
validLine
s
=
case
dropWhile
isSpace
s
of
'-'
:
'-'
:
_
->
False
-- Comment
_
->
True
splitStanzas
=
map
merge
.
groupStanzas
.
filter
validLine
.
zip
[
1
..
]
.
lines
where
validLine
(
_
,
s
)
=
case
dropWhile
isSpace
s
of
'-'
:
'-'
:
_
->
False
-- Comment
_
->
True
allSpaces
(
_
,
xs
)
=
all
isSpace
xs
groupStanzas
::
[(
Int
,
String
)]
->
[[(
Int
,
String
)]]
groupStanzas
[]
=
[]
groupStanzas
xs
=
let
(
ys
,
zs
)
=
break
(
all
isSpace
)
xs
in
ys
:
groupStanzas
(
dropWhile
(
all
isSpace
)
zs
)
merge
(
x
:
(
' '
:
s
)
:
ys
)
=
case
dropWhile
isSpace
s
of
"."
->
merge
((
x
++
"
\n
"
)
:
ys
)
s'
->
merge
((
x
++
"
\n
"
++
s'
)
:
ys
)
merge
(
x
:
ys
)
=
brk
x
:
merge
ys
merge
[]
=
[]
brk
xs
=
case
break
(
==
':'
)
xs
of
(
fld
,
':'
:
val
)
->
(
map
toLower
fld
,
dropWhile
isSpace
val
)
(
fld
,
_
)
->
error
$
"Parser error: Line '"
++
fld
++
"' has no colon"
groupStanzas
xs
=
let
(
ys
,
zs
)
=
break
allSpaces
xs
in
ys
:
groupStanzas
(
dropWhile
allSpaces
zs
)
merge
((
n
,
x
)
:
(
_
,
' '
:
s
)
:
ys
)
=
case
dropWhile
isSpace
s
of
"."
->
merge
((
n
,
x
++
"
\n
"
)
:
ys
)
s'
->
merge
((
n
,
x
++
"
\n
"
++
s'
)
:
ys
)
merge
((
n
,
x
)
:
ys
)
=
brk
n
x
:
merge
ys
merge
[]
=
[]
brk
n
xs
=
case
break
(
==
':'
)
xs
of
(
fld
,
':'
:
val
)
->
(
n
,
map
toLower
fld
,
dropWhile
isSpace
val
)
(
fld
,
_
)
->
error
$
"Line "
++
show
n
++
": Invalid syntax (no colon after field name)"
-- |parse a module name
parseModuleName
::
ReadP
r
String
...
...
@@ -309,8 +330,13 @@ parseFilePath = parseReadS <++ (munch1 (\x -> isAlphaNum x || x `elem` "-+/_."))
parseReadS
::
Read
a
=>
ReadP
r
a
parseReadS
=
readS_to_P
reads
parsePackageName
::
ReadP
r
String
parsePackageName
=
do
n
<-
satisfy
isAlpha
name
<-
munch1
(
\
x
->
isAlphaNum
x
||
x
`
elem
`
"-"
)
return
(
n
:
name
)
parseDependency
::
ReadP
r
Dependency
parseDependency
=
do
name
<-
munch1
(
\
x
->
isAlphaNum
x
||
x
`
elem
`
"-_"
)
parseDependency
=
do
name
<-
parsePackageName
skipSpaces
ver
<-
parseVersionRange
<++
return
AnyVersion
skipSpaces
...
...
@@ -344,7 +370,8 @@ testPkgDesc = unlines [
"-- Optional - may be in source?"
,
"Stability: Free Text String"
,
"Build-Depends: haskell-src, HUnit>=1.0.0-rain"
,
"Modules: Distribution.Package, Distribution.Version, Distribution.Simple.GHCPackageConfig"
,
"Modules: Distribution.Package, Distribution.Version,"
,
" Distribution.Simple.GHCPackageConfig"
,
"C-Sources: not/even/rain.c, such/small/hands"
,
"HS-Source-Dir: src"
,
"Exposed-Modules: Distribution.Void, Foo.Bar"
,
...
...
@@ -403,7 +430,7 @@ hunitTests :: [Test]
hunitTests
=
[
TestLabel
"license parsers"
$
TestCase
$
sequence_
[
assertRight
(
"license "
++
show
lVal
)
lVal
(
runP
parseLicense
(
show
lVal
))
(
runP
1
"license"
parseLicense
(
show
lVal
))
|
lVal
<-
[
GPL
,
LGPL
,
BSD3
,
BSD4
]],
TestLabel
"Required fields"
$
TestCase
$
...
...
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