@@ -7,6 +7,7 @@ import qualified Control.Exception as Exception
7import Control.Monad
7import Control.Monad
8import Control.Monad.IO.Class
8import Control.Monad.IO.Class
9import Control.Monad.Trans.Maybe
9import Control.Monad.Trans.Maybe
10import qualified Data.ByteString.Char8 as BS -- TODO: Deal with utf-8 encoding!!
11import qualified Data.ByteString.Char8 as BS -- TODO: Deal with utf-8 encoding!!
11import Data.List ( isSuffixOf, isPrefixOf )
12import Data.List ( isSuffixOf, isPrefixOf )
12import qualified Data.Map as DB
13import qualified Data.Map as DB
@@ -19,6 +20,7 @@ import qualified Distribution.Package as Cabal
19import Distribution.PackageDescription
20import Distribution.PackageDescription
20import qualified Distribution.PackageDescription as Cabal
21import qualified Distribution.PackageDescription as Cabal
21import Distribution.PackageDescription.Parsec as Cabal
22import Distribution.PackageDescription.Parsec as Cabal
23+import Distribution.Parsec.Common (showPError)
22import Distribution.Text ( simpleParse, display )
24import Distribution.Text ( simpleParse, display )
23import Distribution.Version
25import Distribution.Version
24import qualified Hpack.Config as Hpack
26import qualified Hpack.Config as Hpack
@@ -199,12 +201,14 @@ hpackDirectory dir = do
199 Right (Hpack.DecodeResult pkg' _ _) -> do
201 Right (Hpack.DecodeResult pkg' _ _) -> do
200 let hpackOutput = Hpack.renderPackage [] pkg'
202 let hpackOutput = Hpack.renderPackage [] pkg'
201 hash = printSHA256 $ digestString (digestByName "sha256") hpackOutput
203 hash = printSHA256 $ digestString (digestByName "sha256") hpackOutput
202− case parseGenericPackageDescriptionMaybe (BS.pack hpackOutput) of
204+ case runParseGenericPackageDescription "<hpack output>" (BS.pack hpackOutput) of
203− Nothing -> liftIO $ do
205+ Left msg -> liftIO $ do
204− hPutStrLn stderr "*** cannot parse hpack output:"
206+ hPutStrLn stderr "*** hpack output:"
205 hPutStrLn stderr hpackOutput
207 hPutStrLn stderr hpackOutput
208+ hPutStrLn stderr "*** cannot parse hpack output:"
209+ hPutStrLn stderr msg
206 fail "*** Exiting."
210 fail "*** Exiting."
207− Just pkg -> MaybeT $ return $ Just $ (,) True $ setCabalFileHash hash pkg
211+ Right pkg -> MaybeT $ return $ Just $ (,) True $ setCabalFileHash hash pkg
209cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
213cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
210cabalFromFile failHard file =
214cabalFromFile failHard file =
@@ -216,9 +220,22 @@ cabalFromFile failHard file =
216 hSetEncoding h utf8
220 hSetEncoding h utf8
217 hGetContents h >>= Exception.evaluate . force
221 hGetContents h >>= Exception.evaluate . force
218 let hash = printSHA256 (digestString (digestByName "sha256") buf)
222 let hash = printSHA256 (digestString (digestByName "sha256") buf)
219− case parseGenericPackageDescriptionMaybe (BS.pack buf) of
223+ case runParseGenericPackageDescription file (BS.pack buf) of
224+ Left msg | failHard -> liftIO $ do
220− Nothing -> if failHard then fail ("cannot parse " ++ show file) else return Nothing
225+ hPutStrLn stderr $ "*** cannot parse " ++ show file ++ ":"
226+ hPutStrLn stderr msg
228+ Left _ -> return Nothing
221− Just pkg -> return $ Just $ setCabalFileHash hash pkg
229+ Right pkg -> return $ Just $ setCabalFileHash hash pkg
231+runParseGenericPackageDescription
234+ -> Either String Cabal.GenericPackageDescription
235+runParseGenericPackageDescription fpath
236+ = first (unlines . fmap (showPError fpath) . snd)
237+ . snd . runParseResult
238+ . parseGenericPackageDescription
223setCabalFileHash :: String -> GenericPackageDescription -> GenericPackageDescription
240setCabalFileHash :: String -> GenericPackageDescription -> GenericPackageDescription
224setCabalFileHash sha256 gpd = gpd { packageDescription = (packageDescription gpd) {
241setCabalFileHash sha256 gpd = gpd { packageDescription = (packageDescription gpd) {