diff --git a/Cabal/Distribution/FieldGrammar/Parsec.hs b/Cabal/Distribution/FieldGrammar/Parsec.hs index 6567d68b4048f2569c95cf448627a610d19dc882..bf61e2c446e3b51fee6a7143bf5ee24e9be6167a 100644 --- a/Cabal/Distribution/FieldGrammar/Parsec.hs +++ b/Cabal/Distribution/FieldGrammar/Parsec.hs @@ -275,9 +275,10 @@ runFieldParser' (Position row col) p v str = case P.runParser p' [] "<field>" st let msg = P.showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (P.errorMessages err) - let str' = unlines (filter (not . all isSpace) (fieldLineStreamToLines str)) + -- let str' = unlines (filter (not . all isSpace) (fieldLineStreamToLines str)) - parseFatalFailure epos $ msg ++ "\n" ++ "\n" ++ str' + parseFatalFailure epos $ msg ++ "\n" + -- ++ "\n" ++ str' don't add field contents, as they may span a lot of lines where p' = (,) <$ P.spaces <*> unPP p v <* P.spaces <* P.eof <*> P.getState diff --git a/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal-install/Distribution/Client/ProjectConfig.hs index cfd0a9b55cb135968c206bf096210a46144150f0..a2e33fab7ac463cb546a0249791976dd473b5a0d 100644 --- a/cabal-install/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/Distribution/Client/ProjectConfig.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, DeriveDataTypeable, LambdaCase #-} +{-# LANGUAGE CPP, BangPatterns, RecordWildCards, NamedFieldPuns, DeriveDataTypeable, LambdaCase #-} -- | Handling project configuration. -- @@ -93,7 +93,7 @@ import Distribution.PackageDescription.Parsec import Distribution.Parsec.ParseResult ( runParseResult ) import Distribution.Parsec.Common as NewParser - ( PError, PWarning, showPError, showPWarning ) + ( PError (..), PWarning, showPError, showPWarning, Position (..), zeroPos) import Distribution.Pretty import Distribution.Types.SourceRepo ( SourceRepo(..), RepoType(..), ) @@ -110,7 +110,7 @@ import Distribution.Simple.InstallDirs ( PathTemplate, fromPathTemplate , toPathTemplate, substPathTemplate, initialPathTemplateEnv ) import Distribution.Simple.Utils - ( die', warn, notice, info, createDirectoryIfMissingVerbose ) + ( die', warn, notice, info, createDirectoryIfMissingVerbose, fromUTF8BS ) import Distribution.Client.Utils ( determineNumJobs ) import Distribution.Utils.NubList @@ -132,8 +132,9 @@ import Control.Monad import Control.Monad.Trans (liftIO) import Control.Exception import Data.Either -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set @@ -1220,13 +1221,23 @@ mkSpecificSourcePackage location pkg = -- | Errors reported upon failing to parse a @.cabal@ file. -- -data CabalFileParseError = - CabalFileParseError - FilePath - [PError] - (Maybe Version) -- We might discover the spec version the package needs - [PWarning] - deriving (Show, Typeable) +data CabalFileParseError = CabalFileParseError + FilePath -- ^ @.cabal@ file path + BS.ByteString -- ^ @.cabal@ file contents + [PError] -- ^ errors + (Maybe Version) -- ^ We might discover the spec version the package needs + [PWarning] -- ^ warnings + deriving (Typeable) + +-- | Manual instance which skips file contentes +instance Show CabalFileParseError where + showsPrec d (CabalFileParseError fp _ es mv ws) = showParen (d > 10) + $ showString "CabalFileParseError" + . showChar ' ' . showsPrec 11 fp + . showChar ' ' . showsPrec 11 ("" :: String) + . showChar ' ' . showsPrec 11 es + . showChar ' ' . showsPrec 11 mv + . showChar ' ' . showsPrec 11 ws instance Exception CabalFileParseError #if MIN_VERSION_base(4,8,0) @@ -1236,19 +1247,36 @@ instance Exception CabalFileParseError renderCabalFileParseError :: CabalFileParseError -> String -renderCabalFileParseError (CabalFileParseError filePath errors mVer warnings) = +renderCabalFileParseError (CabalFileParseError filePath contents errors mVer warnings) = "Errors encountered when parsing cabal file " <> filePath <> ":\n" <> versionSpecMsg <> "\n\n" - <> renderedErrors <> renderedWarnings + <> renderedErrors + <> renderedWarnings where - renderedErrors = concatMap (NewParser.showPError filePath) errors + ls = BS8.lines contents + + nths :: Int -> [a] -> [a] + nths n | n <= 0 = take 2 + nths n = take 3 . drop (n - 1) + + renderedErrors = concatMap renderError errors renderedWarnings = concatMap (NewParser.showPWarning filePath) warnings versionSpecMsg = case mVer of Just ver -> "Note: This package was parsed using the Cabal spec version " <> prettyShow ver Nothing -> "" + renderError e@(PError pos@(Position row _col) _) + -- if position is 0:0, then it doens't make sense to show input + | pos == zeroPos = NewParser.showPError filePath e + | otherwise = NewParser.showPError filePath e ++ "\n" ++ + unlines (zipWith formatInputLine (nths (row - 1) ls) [row - 1 ..]) + + formatInputLine bs l = + showN l ++ " | " ++ fromUTF8BS bs + + showN n = let s = show n in replicate (5 - length s) ' ' ++ s -- | Wrapper for the @.cabal@ file parser. It reports warnings on higher -- verbosity levels and throws 'CabalFileParseError' on failure. @@ -1265,7 +1293,7 @@ readSourcePackageCabalFile verbosity pkgfilename content = return pkg (warnings, Left (mspecVersion, errors)) -> - throwIO $ CabalFileParseError pkgfilename errors mspecVersion warnings + throwIO $ CabalFileParseError pkgfilename content errors mspecVersion warnings where formatWarnings warnings = "The package description file " ++ pkgfilename