@@ -2,24 +2,26 @@ module Distribution.Nixpkgs.Haskell.PackageSourceSpec
22 ( Package(..), getPackage, sourceFromHackage
33 ) where
44
5−import qualified Distribution.Nixpkgs.Haskell.Hackage as DB
65import qualified Control.Exception as Exception
76import Control.Monad
87import Control.Monad.IO.Class
98import Control.Monad.Trans.Maybe
9+import qualified Data.ByteString.Lazy.Char8 as BS8
10+import Data.Digest.Pure.SHA ( sha256, showDigest )
1011import Data.List ( isSuffixOf, isPrefixOf )
1112import Data.Maybe
1213import Data.Version
14+import Distribution.Hackage.DB.Parsed
1315import Distribution.Nixpkgs.Fetch
16+import qualified Distribution.Nixpkgs.Haskell.Hackage as DB
1417import qualified Distribution.Package as Cabal
18+import Distribution.PackageDescription
1519import qualified Distribution.PackageDescription as Cabal
16−import qualified Distribution.PackageDescription.Parse as Cabal
17−import qualified Distribution.ParseUtils as ParseUtils
1820import Distribution.Text ( simpleParse )
1921import System.Directory ( doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getHomeDirectory, getDirectoryContents )
2022import System.Exit ( exitFailure )
2123import System.FilePath ( (</>), (<.>) )
22−import System.IO ( hPutStrLn, stderr, hPutStr, openFile, IOMode(ReadMode), hSetEncoding, utf8, hGetContents )
24+import System.IO ( hPutStrLn, stderr, hPutStr )
2325
2426data Package = Package
2527 { pkgSource :: DerivationSource
@@ -143,14 +145,13 @@ cabalFromFile failHard file =
143145 -- wrap the whole block in `catchIO`, because of lazy IO. The `case` will force
144146 -- the reading of the file, so we will always catch the expression here.
145147 MaybeT $ handleIO (\err -> Nothing <$ hPutStrLn stderr ("*** parsing cabal file: " ++ show err)) $ do
146− inputHandle <- openFile file ReadMode
147− hSetEncoding inputHandle utf8
148− content <- hGetContents inputHandle
149− case Cabal.parsePackageDescription content of
150− Cabal.ParseFailed e | failHard -> do
151− let (line, err) = ParseUtils.locatedErrorMsg e
152− msg = maybe "" ((++ ": ") . show) line ++ err
153− hPutStrLn stderr $ "*** error parsing cabal file: " ++ msg
154− exitFailure
155− Cabal.ParseFailed _ -> return Nothing
156− Cabal.ParseOk _ a -> return (Just a)
148+ buf <- BS8.readFile file
149+ let hash = showDigest (sha256 buf)
150+ case parsePackage' buf of
151+ Left msg -> if failHard
152+ then fail ("*** cannot parse " ++ show file ++ ": " ++ msg)
153+ else return Nothing
154+ Right pkg -> do return $ Just $ pkg { packageDescription = (packageDescription pkg) {
155+ customFieldsPD = ("X-Cabal-File-Hash", hash) : customFieldsPD (packageDescription pkg)
156+ }
157+ }