Commit f66144d6 authored by duncan.coutts@worc.ox.ac.uk's avatar duncan.coutts@worc.ox.ac.uk
Browse files

Make unknown fields a warning rather than an error

Add support for warnings to the ParseResult type. Change existing
warnings from using Debug.Trace to use this new warning support.
parent 639421c0
......@@ -478,8 +478,9 @@ readAndParseFile parser fpath = do
ParseFailed e -> do
let (lineNo, message) = locatedErrorMsg e
dieWithLocation fpath lineNo message
ParseOk x -> return x
where
ParseOk ws x -> do
mapM_ warn ws
return x
-- |Parse the given package file.
readPackageDescription :: FilePath -> IO PackageDescription
......@@ -565,8 +566,9 @@ parseBInfoField :: [StanzaField a] -> a -> (LineNo, String, String) -> ParseResu
parseBInfoField ((StanzaField name _ set):fields) binfo (lineNo, f, val)
| name == f = set lineNo val binfo
| otherwise = parseBInfoField fields binfo (lineNo, f, val)
parseBInfoField [] _ (lineNo, f, _) =
syntaxError lineNo $ "Unknown field '" ++ f ++ "'"
parseBInfoField [] binfo (lineNo, f, _) = do
warning $ "Unknown field '" ++ f ++ "'"
return binfo
-- --------------------------------------------
-- ** Pretty printing
......
......@@ -44,8 +44,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
-- #hide
module Distribution.ParseUtils (
LineNo, PError(..), locatedErrorMsg, showError, syntaxError, runP,
ParseResult(..),
LineNo, PError(..), locatedErrorMsg, showError, syntaxError, warning,
runP, ParseResult(..),
StanzaField(..), splitStanzas, Stanza, singleStanza,
parseFilePathQ, parseTokenQ,
parseModuleNameQ, parseDependency, parseOptVersion,
......@@ -63,7 +63,6 @@ import Distribution.Version
import Distribution.Package ( parsePackageName )
import Distribution.Compat.ReadP as ReadP hiding (get)
import Distribution.Compat.FilePath (platformPath)
import Debug.Trace
import Control.Monad (liftM)
import Data.Char
import Language.Haskell.Extension (Extension)
......@@ -77,21 +76,25 @@ data PError = AmbigousParse String LineNo
| FromString String (Maybe LineNo)
deriving Show
data ParseResult a = ParseFailed PError | ParseOk a
type PWarning = String
data ParseResult a = ParseFailed PError | ParseOk [PWarning] a
deriving Show
instance Monad ParseResult where
return x = ParseOk x
return x = ParseOk [] x
ParseFailed err >>= _ = ParseFailed err
ParseOk x >>= f = f x
ParseOk ws x >>= f = case f x of
ParseFailed err -> ParseFailed err
ParseOk ws' x' -> ParseOk (ws'++ws) x'
fail s = ParseFailed (FromString s Nothing)
runP :: LineNo -> String -> ReadP a a -> String -> ParseResult a
runP lineNo field p s =
case [ x | (x,"") <- results ] of
[a] -> ParseOk a
[a] -> ParseOk [] a
[] -> case [ x | (x,ys) <- results, all isSpace ys ] of
[a] -> ParseOk a
[a] -> ParseOk [] a
[] -> ParseFailed (NoParse field lineNo)
_ -> ParseFailed (AmbigousParse field lineNo)
_ -> ParseFailed (AmbigousParse field lineNo)
......@@ -112,6 +115,9 @@ locatedErrorMsg (FromString s n) = (n, s)
syntaxError :: LineNo -> String -> ParseResult a
syntaxError n s = ParseFailed $ FromString s (Just n)
warning :: String -> ParseResult ()
warning s = ParseOk [s] ()
data StanzaField a
= StanzaField
{ fieldName :: String
......@@ -195,11 +201,14 @@ mkStanza ((n,xs):ys) =
case break (==':') xs of
(fld', ':':val) -> do
let fld'' = map toLower fld'
fld | fld'' == "hs-source-dir"
= trace "The field \"hs-source-dir\" is deprecated, please use hs-source-dirs." "hs-source-dirs"
| fld'' == "other-files"
= trace "The field \"other-files\" is deprecated, please use extra-source-files." "extra-source-files"
| otherwise = fld''
fld <- case () of
_ | fld'' == "hs-source-dir"
-> do warning "The field \"hs-source-dir\" is deprecated, please use hs-source-dirs."
return "hs-source-dirs"
| fld'' == "other-files"
-> do warning "The field \"other-files\" is deprecated, please use extra-source-files."
return "extra-source-files"
| otherwise -> return fld''
ss <- mkStanza ys
checkDuplField fld ss
return ((n, fld, dropWhile isSpace val):ss)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment