Commit c87d5b5b authored by Oleg Grenrus's avatar Oleg Grenrus
Browse files

Include lex warnings in parsec's ParseResult

parent 722e030f
......@@ -52,6 +52,8 @@ import Distribution.Parsec.Types.Common
import Distribution.Parsec.Types.Field (getName)
import Distribution.Parsec.Types.FieldDescr
import Distribution.Parsec.Types.ParseResult
import Distribution.Parsec.LexerMonad
(LexWarning, toPWarning)
import Distribution.Text (display)
import Distribution.Version (mkVersion, Version, asVersionIntervals, orLaterVersion, LowerBound (..))
......@@ -96,8 +98,8 @@ readGenericPackageDescription = readAndParseFile parseGenericPackageDescription
--
-- TODO: add lex warnings
parseGenericPackageDescription :: BS.ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription bs = case readFields bs of
Right fs -> parseGenericPackageDescription' fs
parseGenericPackageDescription bs = case readFields' bs of
Right (fs, lexWarnings) -> parseGenericPackageDescription' lexWarnings fs
-- | TODO: better marshalling of errors
Left perr -> parseFatalFailure (Position 0 0) (show perr)
......@@ -143,9 +145,11 @@ data GPDS = Fields | Sections
-- Note [Accumulating parser]
parseGenericPackageDescription'
:: [Field Position]
:: [LexWarning]
-> [Field Position]
-> ParseResult GenericPackageDescription
parseGenericPackageDescription' fs = do
parseGenericPackageDescription' lexWarnings fs = do
parseWarnings' (fmap toPWarning lexWarnings)
let (newSyntax, fs') = sectionizeFields fs
(_, gpd) <- foldM go (Fields, emptyGpd) fs'
-- Various post checks
......
......@@ -320,7 +320,7 @@ readFields s = fmap elaborate $ parse cabalStyleFile "the input" lexSt
lexSt = mkLexState' (mkLexState s)
readFields' :: B.ByteString -> Either ParseError ([Field Position], [LexWarning])
readFields' s = parse (liftM2 (,) cabalStyleFile getLexerWarnings) "the input" lexSt
readFields' s = fmap (first elaborate) $ parse (liftM2 (,) cabalStyleFile getLexerWarnings) "the input" lexSt
where
lexSt = mkLexState' (mkLexState s)
......
......@@ -7,6 +7,7 @@ module Distribution.Parsec.Types.ParseResult (
parseFailure,
parseFatalFailure,
parseFatalFailure',
parseWarnings',
) where
import Distribution.Compat.Prelude
......@@ -61,6 +62,10 @@ parseWarning :: Position -> PWarnType -> String -> ParseResult ()
parseWarning pos t msg = PR $ \(PRState warns errs) ->
(Just (), PRState (PWarning t pos msg : warns) errs)
parseWarnings' :: [PWarning] -> ParseResult ()
parseWarnings' newWarns = PR $ \(PRState warns errs) ->
(Just (), PRState (warns ++ newWarns) errs)
-- | Add an error, but not fail the parser yet.
parseFailure :: Position -> String -> ParseResult ()
parseFailure pos msg = PR $ \(PRState warns errs) ->
......
Markdown is supported
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