@@ -7,6 +7,7 @@ import Control.Monad
7import Control.Monad.IO.Class
7import Control.Monad.IO.Class
8import Control.Monad.Trans.Maybe
8import Control.Monad.Trans.Maybe
9import qualified Data.ByteString.Lazy.Char8 as LBS8
9import qualified Data.ByteString.Lazy.Char8 as LBS8
10+import qualified Data.ByteString.Lazy.UTF8 as UTF8
10import Data.List ( isSuffixOf, isPrefixOf )
11import Data.List ( isSuffixOf, isPrefixOf )
11import Data.Maybe
12import Data.Maybe
12import Distribution.Hackage.DB.Parsed
13import Distribution.Hackage.DB.Parsed
@@ -27,27 +28,29 @@ import System.FilePath ( (</>), (<.>) )
27import System.IO ( hPutStrLn, stderr, hPutStr )
28import System.IO ( hPutStrLn, stderr, hPutStr )
29data Package = Package
30data Package = Package
30− { pkgSource :: DerivationSource
31+ { pkgSource :: DerivationSource
31− , pkgRunHpack :: Bool
32+ , pkgRanHpack :: Bool -- ^ If hpack generated a new cabal file
32− , pkgCabal :: Cabal.GenericPackageDescription
33+ , pkgCabal :: Cabal.GenericPackageDescription
34 deriving (Show)
35 deriving (Show)
37+getPackage :: Bool -- ^ Whether hpack should regenerate the cabal file
36−getPackage :: Maybe String -> Source -> IO Package
38+ -> Maybe String -> Source -> IO Package
37−getPackage optHackageDB source = do
39+getPackage optHpack optHackageDB source = do
38− (derivSource, runHpack, pkgDesc) <- fetchOrFromDB optHackageDB source
40+ (derivSource, ranHpack, pkgDesc) <- fetchOrFromDB optHpack optHackageDB source
39− (\s -> Package s runHpack pkgDesc) <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
41+ (\s -> Package s ranHpack pkgDesc) <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
43+fetchOrFromDB :: Bool -- ^ Whether hpack should regenerate the cabal file
41−fetchOrFromDB :: Maybe String -> Source -> IO (Maybe DerivationSource, Bool, Cabal.GenericPackageDescription)
44+ -> Maybe String -> Source -> IO (Maybe DerivationSource, Bool, Cabal.GenericPackageDescription)
42−fetchOrFromDB optHackageDB src
45+fetchOrFromDB optHpack optHackageDB src
43 | "cabal://" `isPrefixOf` sourceUrl src = fmap ((,,) Nothing False) . fromDB optHackageDB . drop (length "cabal://") $ sourceUrl src
46 | "cabal://" `isPrefixOf` sourceUrl src = fmap ((,,) Nothing False) . fromDB optHackageDB . drop (length "cabal://") $ sourceUrl src
44 | otherwise = do
47 | otherwise = do
45− r <- fetch (\dir -> cabalFromPath (dir </> sourceCabalDir src)) src
48+ r <- fetch (\dir -> cabalFromPath optHpack (dir </> sourceCabalDir src)) src
47 Nothing ->
50 Nothing ->
48 hPutStrLn stderr "*** failed to fetch source. Does the URL exist?" >> exitFailure
51 hPutStrLn stderr "*** failed to fetch source. Does the URL exist?" >> exitFailure
49− Just (derivSource, (externalSource, (runHpack, pkgDesc))) -> do
52+ Just (derivSource, (externalSource, ranHpack, pkgDesc)) -> do
50− return (derivSource <$ guard externalSource, runHpack, pkgDesc)
53+ return (derivSource <$ guard externalSource, ranHpack, pkgDesc)
52fromDB :: Maybe String -> String -> IO Cabal.GenericPackageDescription
55fromDB :: Maybe String -> String -> IO Cabal.GenericPackageDescription
53fromDB optHackageDB pkg = do
56fromDB optHackageDB pkg = do
@@ -126,38 +129,50 @@ showPackageIdentifier pkgDesc = name ++ "-" ++ display version where
126 name = Cabal.unPackageName (Cabal.packageName pkgId)
129 name = Cabal.unPackageName (Cabal.packageName pkgId)
127 version = Cabal.packageVersion pkgId
130 version = Cabal.packageVersion pkgId
132+cabalFromPath :: Bool -- ^ Whether hpack should regenerate the cabal file
129−cabalFromPath :: FilePath -> MaybeT IO (Bool, (Bool, Cabal.GenericPackageDescription))
133+ -> FilePath -> MaybeT IO (Bool, Bool, Cabal.GenericPackageDescription)
130−cabalFromPath path = do
134+cabalFromPath optHpack path = do
131 d <- liftIO $ doesDirectoryExist path
135 d <- liftIO $ doesDirectoryExist path
132− (,) d <$> if d
136+ if d
133− then cabalFromDirectory path
138+ (ranHpack, pkg) <- cabalFromDirectory optHpack path
139+ return (d, ranHpack, pkg)
134− else (,) False <$> cabalFromFile False path
140+ else (,,) d False <$> cabalFromFile False path
142+cabalFromDirectory :: Bool -- ^ Whether hpack should regenerate the cabal file
136−cabalFromDirectory :: FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
143+ -> FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
137−cabalFromDirectory dir = do
144+cabalFromDirectory True dir = hpackDirectory dir
145+cabalFromDirectory False dir = do
138 cabals <- liftIO $ getDirectoryContents dir >>= filterM doesFileExist . map (dir </>) . filter (".cabal" `isSuffixOf`)
146 cabals <- liftIO $ getDirectoryContents dir >>= filterM doesFileExist . map (dir </>) . filter (".cabal" `isSuffixOf`)
139 case cabals of
147 case cabals of
141 liftIO $ hPutStrLn stderr "*** found zero cabal files. Trying hpack..."
149 liftIO $ hPutStrLn stderr "*** found zero cabal files. Trying hpack..."
142− (,) True <$> hpackFromDirectory dir
150+ hpackDirectory dir
143 [cabalFile] -> (,) False <$> cabalFromFile True cabalFile
151 [cabalFile] -> (,) False <$> cabalFromFile True cabalFile
144 _ -> liftIO $ hPutStrLn stderr ("*** found more than one cabal file (" ++ show cabals ++ "). Exiting.") >> exitFailure
152 _ -> liftIO $ hPutStrLn stderr ("*** found more than one cabal file (" ++ show cabals ++ "). Exiting.") >> exitFailure
146handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
154handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
147handleIO = Exception.handle
155handleIO = Exception.handle
149−hpackFromDirectory :: FilePath -> MaybeT IO Cabal.GenericPackageDescription
157+hpackDirectory :: FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
150−hpackFromDirectory dir = do
158+hpackDirectory dir = do
151 mPackage <- liftIO $ Hpack.readPackageConfig $ dir </> "package.yaml"
159 mPackage <- liftIO $ Hpack.readPackageConfig $ dir </> "package.yaml"
152 case mPackage of
160 case mPackage of
153 Left err -> liftIO $ hPutStrLn stderr ("*** hpack error: " ++ show err ++ ". Exiting.") >> exitFailure
161 Left err -> liftIO $ hPutStrLn stderr ("*** hpack error: " ++ show err ++ ". Exiting.") >> exitFailure
154 Right (_, pkg') -> do
162 Right (_, pkg') -> do
155− let buf = LBS8.pack $ Hpack.renderPackage Hpack.defaultRenderSettings 0 [] [] pkg'
163+ let hpackOutput = Hpack.renderPackage Hpack.defaultRenderSettings 2 [] [] pkg'
164+ buf = UTF8.fromString hpackOutput
156− hash = printSHA256 (digest (digestByName "sha256") buf)
165+ hash = printSHA256 $ digest (digestByName "sha256") buf
157 case parsePackage' buf of
166 case parsePackage' buf of
167+ Left msg -> liftIO $ do
158− Left msg -> liftIO $ hPutStrLn stderr ("*** cannot parse hpack output: " ++ msg) >> exitFailure
168+ hPutStrLn stderr $ "*** cannot parse hpack output: " ++ msg
169+ hPutStrLn stderr $ "*** hpack output:\n" ++ hpackOutput
170+ hPutStrLn stderr "*** Exiting."
172+ Right pkg -> MaybeT $ return $ Just $ (,) True $ pkg
159− Right pkg -> MaybeT $ return $ Just $ pkg { packageDescription = (packageDescription pkg) {
173+ { packageDescription = (packageDescription pkg)
160− customFieldsPD = ("X-Cabal-File-Hash", hash) : customFieldsPD (packageDescription pkg) } }
174+ { customFieldsPD = ("X-Cabal-File-Hash", hash) : customFieldsPD (packageDescription pkg)
162cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
177cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
163cabalFromFile failHard file =
178cabalFromFile failHard file =