@@ -7,6 +7,7 @@ import Control.Monad
77import Control.Monad.IO.Class
88import Control.Monad.Trans.Maybe
99import qualified Data.ByteString.Lazy.Char8 as LBS8
10+import qualified Data.ByteString.Lazy.UTF8 as UTF8
1011import Data.List ( isSuffixOf, isPrefixOf )
1112import Data.Maybe
1213import Distribution.Hackage.DB.Parsed
@@ -27,27 +28,29 @@ import System.FilePath ( (</>), (<.>) )
2728import System.IO ( hPutStrLn, stderr, hPutStr )
2829
2930data Package = Package
30− { pkgSource :: DerivationSource
31− , pkgRunHpack :: Bool
32− , pkgCabal :: Cabal.GenericPackageDescription
31+ { pkgSource :: DerivationSource
32+ , pkgRanHpack :: Bool -- ^ If hpack generated a new cabal file
33+ , pkgCabal :: Cabal.GenericPackageDescription
3334 }
3435 deriving (Show)
3536
36−getPackage :: Maybe String -> Source -> IO Package
37−getPackage optHackageDB source = do
38− (derivSource, runHpack, pkgDesc) <- fetchOrFromDB optHackageDB source
39− (\s -> Package s runHpack pkgDesc) <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
37+getPackage :: Bool -- ^ Whether hpack should regenerate the cabal file
38+ -> Maybe String -> Source -> IO Package
39+getPackage optHpack optHackageDB source = do
40+ (derivSource, ranHpack, pkgDesc) <- fetchOrFromDB optHpack optHackageDB source
41+ (\s -> Package s ranHpack pkgDesc) <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
4042
41−fetchOrFromDB :: Maybe String -> Source -> IO (Maybe DerivationSource, Bool, Cabal.GenericPackageDescription)
42−fetchOrFromDB optHackageDB src
43+fetchOrFromDB :: Bool -- ^ Whether hpack should regenerate the cabal file
44+ -> Maybe String -> Source -> IO (Maybe DerivationSource, Bool, Cabal.GenericPackageDescription)
45+fetchOrFromDB optHpack optHackageDB src
4346 | "cabal://" `isPrefixOf` sourceUrl src = fmap ((,,) Nothing False) . fromDB optHackageDB . drop (length "cabal://") $ sourceUrl src
4447 | otherwise = do
45− r <- fetch (\dir -> cabalFromPath (dir </> sourceCabalDir src)) src
48+ r <- fetch (\dir -> cabalFromPath optHpack (dir </> sourceCabalDir src)) src
4649 case r of
4750 Nothing ->
4851 hPutStrLn stderr "*** failed to fetch source. Does the URL exist?" >> exitFailure
49− Just (derivSource, (externalSource, (runHpack, pkgDesc))) -> do
50− return (derivSource <$ guard externalSource, runHpack, pkgDesc)
52+ Just (derivSource, (externalSource, ranHpack, pkgDesc)) -> do
53+ return (derivSource <$ guard externalSource, ranHpack, pkgDesc)
5154
5255fromDB :: Maybe String -> String -> IO Cabal.GenericPackageDescription
5356fromDB optHackageDB pkg = do
@@ -126,38 +129,50 @@ showPackageIdentifier pkgDesc = name ++ "-" ++ display version where
126129 name = Cabal.unPackageName (Cabal.packageName pkgId)
127130 version = Cabal.packageVersion pkgId
128131
129−cabalFromPath :: FilePath -> MaybeT IO (Bool, (Bool, Cabal.GenericPackageDescription))
130−cabalFromPath path = do
132+cabalFromPath :: Bool -- ^ Whether hpack should regenerate the cabal file
133+ -> FilePath -> MaybeT IO (Bool, Bool, Cabal.GenericPackageDescription)
134+cabalFromPath optHpack path = do
131135 d <- liftIO $ doesDirectoryExist path
132− (,) d <$> if d
133− then cabalFromDirectory path
134− else (,) False <$> cabalFromFile False path
135−
136−cabalFromDirectory :: FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
137−cabalFromDirectory dir = do
136+ if d
137+ then do
138+ (ranHpack, pkg) <- cabalFromDirectory optHpack path
139+ return (d, ranHpack, pkg)
140+ else (,,) d False <$> cabalFromFile False path
141+
142+cabalFromDirectory :: Bool -- ^ Whether hpack should regenerate the cabal file
143+ -> FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
144+cabalFromDirectory True dir = hpackDirectory dir
145+cabalFromDirectory False dir = do
138146 cabals <- liftIO $ getDirectoryContents dir >>= filterM doesFileExist . map (dir </>) . filter (".cabal" `isSuffixOf`)
139147 case cabals of
140148 [] -> do
141149 liftIO $ hPutStrLn stderr "*** found zero cabal files. Trying hpack..."
142− (,) True <$> hpackFromDirectory dir
150+ hpackDirectory dir
143151 [cabalFile] -> (,) False <$> cabalFromFile True cabalFile
144152 _ -> liftIO $ hPutStrLn stderr ("*** found more than one cabal file (" ++ show cabals ++ "). Exiting.") >> exitFailure
145153
146154handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
147155handleIO = Exception.handle
148156
149−hpackFromDirectory :: FilePath -> MaybeT IO Cabal.GenericPackageDescription
150−hpackFromDirectory dir = do
157+hpackDirectory :: FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
158+hpackDirectory dir = do
151159 mPackage <- liftIO $ Hpack.readPackageConfig $ dir </> "package.yaml"
152160 case mPackage of
153161 Left err -> liftIO $ hPutStrLn stderr ("*** hpack error: " ++ show err ++ ". Exiting.") >> exitFailure
154162 Right (_, pkg') -> do
155− let buf = LBS8.pack $ Hpack.renderPackage Hpack.defaultRenderSettings 0 [] [] pkg'
156− hash = printSHA256 (digest (digestByName "sha256") buf)
163+ let hpackOutput = Hpack.renderPackage Hpack.defaultRenderSettings 2 [] [] pkg'
164+ buf = UTF8.fromString hpackOutput
165+ hash = printSHA256 $ digest (digestByName "sha256") buf
157166 case parsePackage' buf of
158− Left msg -> liftIO $ hPutStrLn stderr ("*** cannot parse hpack output: " ++ msg) >> exitFailure
159− Right pkg -> MaybeT $ return $ Just $ pkg { packageDescription = (packageDescription pkg) {
160− customFieldsPD = ("X-Cabal-File-Hash", hash) : customFieldsPD (packageDescription pkg) } }
167+ Left msg -> liftIO $ do
168+ hPutStrLn stderr $ "*** cannot parse hpack output: " ++ msg
169+ hPutStrLn stderr $ "*** hpack output:\n" ++ hpackOutput
170+ hPutStrLn stderr "*** Exiting."
171+ exitFailure
172+ Right pkg -> MaybeT $ return $ Just $ (,) True $ pkg
173+ { packageDescription = (packageDescription pkg)
174+ { customFieldsPD = ("X-Cabal-File-Hash", hash) : customFieldsPD (packageDescription pkg)
175+ } }
161176
162177cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
163178cabalFromFile failHard file =