@@ -18,6 +18,8 @@ import qualified Distribution.PackageDescription as Cabal
1818import Distribution.PackageDescription.Parse as Cabal
1919import Distribution.Text ( simpleParse, display )
2020import Distribution.Version
21+import qualified Hpack.Run as Hpack
22+import qualified Hpack.Config as Hpack
2123import OpenSSL.Digest ( digestString, digestByName )
2224import System.Directory ( doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getHomeDirectory, getDirectoryContents )
2325import System.Exit ( exitFailure )
@@ -25,25 +27,30 @@ import System.FilePath ( (</>), (<.>) )
2527import System.IO ( hPutStrLn, stderr, hPutStr )
2628
2729data Package = Package
28− { pkgSource :: DerivationSource
29− , pkgCabal :: Cabal.GenericPackageDescription
30+ { pkgSource :: DerivationSource
31+ , pkgRanHpack :: Bool -- ^ If hpack generated a new cabal file
32+ , pkgCabal :: Cabal.GenericPackageDescription
3033 }
3134 deriving (Show)
3235
33−getPackage :: Maybe FilePath -> Source -> IO Package
34−getPackage optHackageDB source = do
35− (derivSource, pkgDesc) <- fetchOrFromDB optHackageDB source
36− flip Package pkgDesc <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
37−
38−fetchOrFromDB :: Maybe FilePath -> Source -> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
39−fetchOrFromDB optHackageDB src
40− | "cabal://" `isPrefixOf` sourceUrl src = fromDB optHackageDB . drop (length "cabal://") $ sourceUrl src
36+getPackage :: Bool -- ^ Whether hpack should regenerate the cabal file
37+ -> Maybe FilePath -> Source -> IO Package
38+getPackage optHpack optHackageDB source = do
39+ (derivSource, ranHpack, pkgDesc) <- fetchOrFromDB optHpack optHackageDB source
40+ (\s -> Package s ranHpack pkgDesc) <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
41+
42+fetchOrFromDB :: Bool -- ^ Whether hpack should regenerate the cabal file
43+ -> Maybe FilePath -> Source -> IO (Maybe DerivationSource, Bool, Cabal.GenericPackageDescription)
44+fetchOrFromDB optHpack optHackageDB src
45+ | "cabal://" `isPrefixOf` sourceUrl src = do
46+ (msrc, pkgDesc) <- fromDB optHackageDB . drop (length "cabal://") $ sourceUrl src
47+ return (msrc, False, pkgDesc)
4148 | otherwise = do
42− r <- fetch (\dir -> cabalFromPath (dir </> sourceCabalDir src)) src
49+ r <- fetch (\dir -> cabalFromPath optHpack (dir </> sourceCabalDir src)) src
4350 case r of
4451 Nothing -> fail "Failed to fetch source. Does the URL exist?"
45− Just (derivSource, (externalSource, pkgDesc)) -> do
46− return (derivSource <$ guard externalSource, pkgDesc)
52+ Just (derivSource, (externalSource, ranHpack, pkgDesc)) -> do
53+ return (derivSource <$ guard externalSource, ranHpack, pkgDesc)
4754
4855fromDB :: Maybe FilePath -> String -> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
4956fromDB optHackageDB pkg = do
@@ -129,23 +136,46 @@ showPackageIdentifier pkgDesc = name ++ "-" ++ display version where
129136 name = Cabal.unPackageName (Cabal.packageName pkgId)
130137 version = Cabal.packageVersion pkgId
131138
132−cabalFromPath :: FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
133−cabalFromPath path = do
139+cabalFromPath :: Bool -- ^ Whether hpack should regenerate the cabal file
140+ -> FilePath -> MaybeT IO (Bool, Bool, Cabal.GenericPackageDescription)
141+cabalFromPath optHpack path = do
134142 d <- liftIO $ doesDirectoryExist path
135− (,) d <$> if d
136− then cabalFromDirectory path
137− else cabalFromFile False path
138−
139−cabalFromDirectory :: FilePath -> MaybeT IO Cabal.GenericPackageDescription
140−cabalFromDirectory dir = do
143+ if d
144+ then do
145+ (ranHpack, pkg) <- cabalFromDirectory optHpack path
146+ return (d, ranHpack, pkg)
147+ else (,,) d False <$> cabalFromFile False path
148+
149+cabalFromDirectory :: Bool -- ^ Whether hpack should regenerate the cabal file
150+ -> FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
151+cabalFromDirectory True dir = hpackDirectory dir
152+cabalFromDirectory False dir = do
141153 cabals <- liftIO $ getDirectoryContents dir >>= filterM doesFileExist . map (dir </>) . filter (".cabal" `isSuffixOf`)
142154 case cabals of
143− [cabalFile] -> cabalFromFile True cabalFile
144− _ -> liftIO $ fail ("Found zero or more than one cabal files: " ++ show cabals ++ ". Exiting.")
155+ [] -> do
156+ liftIO $ hPutStrLn stderr "*** found zero cabal files. Trying hpack..."
157+ hpackDirectory dir
158+ [cabalFile] -> (,) False <$> cabalFromFile True cabalFile
159+ _ -> liftIO $ fail ("*** found more than one cabal file (" ++ show cabals ++ "). Exiting.")
145160
146161handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
147162handleIO = Exception.handle
148163
164+hpackDirectory :: FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
165+hpackDirectory dir = do
166+ mPackage <- liftIO $ Hpack.readPackageConfig $ dir </> "package.yaml"
167+ case mPackage of
168+ Left err -> liftIO $ hPutStrLn stderr ("*** hpack error: " ++ show err ++ ". Exiting.") >> exitFailure
169+ Right (_, pkg') -> do
170+ let hpackOutput = Hpack.renderPackage Hpack.defaultRenderSettings 2 [] [] pkg'
171+ hash = printSHA256 $ digestString (digestByName "sha256") hpackOutput
172+ case parseGenericPackageDescription hpackOutput of
173+ ParseFailed perr -> liftIO $ do
174+ hPutStrLn stderr $ "*** cannot parse hpack output: " ++ show perr
175+ hPutStrLn stderr $ "*** hpack output:\n" ++ hpackOutput
176+ fail "*** Exiting."
177+ ParseOk _ pkg -> MaybeT $ return $ Just $ (,) True $ setCabalFileHash hash pkg
178+
149179cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
150180cabalFromFile failHard file =
151181 -- readFile throws an error if it's used on binary files which contain sequences