@@ -7,6 +7,7 @@ import qualified Control.Exception as Exception
77import Control.Monad
88import Control.Monad.IO.Class
99import Control.Monad.Trans.Maybe
10+import Data.Bifunctor
1011import qualified Data.ByteString.Char8 as BS -- TODO: Deal with utf-8 encoding!!
1112import Data.List ( isSuffixOf, isPrefixOf )
1213import qualified Data.Map as DB
@@ -19,6 +20,7 @@ import qualified Distribution.Package as Cabal
1920import Distribution.PackageDescription
2021import qualified Distribution.PackageDescription as Cabal
2122import Distribution.PackageDescription.Parsec as Cabal
23+import Distribution.Parsec.Common (showPError)
2224import Distribution.Text ( simpleParse, display )
2325import Distribution.Version
2426import qualified Hpack.Config as Hpack
@@ -199,12 +201,14 @@ hpackDirectory dir = do
199201 Right (Hpack.DecodeResult pkg' _ _) -> do
200202 let hpackOutput = Hpack.renderPackage [] pkg'
201203 hash = printSHA256 $ digestString (digestByName "sha256") hpackOutput
202− case parseGenericPackageDescriptionMaybe (BS.pack hpackOutput) of
203− Nothing -> liftIO $ do
204− hPutStrLn stderr "*** cannot parse hpack output:"
204+ case runParseGenericPackageDescription "<hpack output>" (BS.pack hpackOutput) of
205+ Left msg -> liftIO $ do
206+ hPutStrLn stderr "*** hpack output:"
205207 hPutStrLn stderr hpackOutput
208+ hPutStrLn stderr "*** cannot parse hpack output:"
209+ hPutStrLn stderr msg
206210 fail "*** Exiting."
207− Just pkg -> MaybeT $ return $ Just $ (,) True $ setCabalFileHash hash pkg
211+ Right pkg -> MaybeT $ return $ Just $ (,) True $ setCabalFileHash hash pkg
208212
209213cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
210214cabalFromFile failHard file =
@@ -216,9 +220,22 @@ cabalFromFile failHard file =
216220 hSetEncoding h utf8
217221 hGetContents h >>= Exception.evaluate . force
218222 let hash = printSHA256 (digestString (digestByName "sha256") buf)
219− case parseGenericPackageDescriptionMaybe (BS.pack buf) of
220− Nothing -> if failHard then fail ("cannot parse " ++ show file) else return Nothing
221− Just pkg -> return $ Just $ setCabalFileHash hash pkg
223+ case runParseGenericPackageDescription file (BS.pack buf) of
224+ Left msg | failHard -> liftIO $ do
225+ hPutStrLn stderr $ "*** cannot parse " ++ show file ++ ":"
226+ hPutStrLn stderr msg
227+ fail "*** Exiting."
228+ Left _ -> return Nothing
229+ Right pkg -> return $ Just $ setCabalFileHash hash pkg
230+
231+runParseGenericPackageDescription
232+ :: FilePath
233+ -> BS.ByteString
234+ -> Either String Cabal.GenericPackageDescription
235+runParseGenericPackageDescription fpath
236+ = first (unlines . fmap (showPError fpath) . snd)
237+ . snd . runParseResult
238+ . parseGenericPackageDescription
222239
223240setCabalFileHash :: String -> GenericPackageDescription -> GenericPackageDescription
224241setCabalFileHash sha256 gpd = gpd { packageDescription = (packageDescription gpd) {