@@ -1,9 +1,9 @@
11module Cabal2Nix.Package where
22
3+import Control.Applicative
34import Control.Monad
45import Control.Monad.IO.Class
56import Control.Monad.Trans.Maybe
6−import Data.Functor ( (<$>), (<$) )
77import Data.List ( isSuffixOf, isPrefixOf )
88import Data.Maybe ( listToMaybe )
99import Distribution.NixOS.Derivation.Cabal
@@ -19,6 +19,9 @@ import qualified Distribution.Package as Cabal
1919import qualified Distribution.PackageDescription as Cabal
2020import qualified Distribution.PackageDescription.Parse as Cabal
2121
22+import qualified Distribution.Compat.Exception as Compat
23+import qualified Distribution.ParseUtils as ParseUtils
24+
2225data Package = Package
2326 { source :: DerivationSource
2427 , cabal :: Cabal.GenericPackageDescription
@@ -36,7 +39,8 @@ fetchOrFromDB optHackageDB src
3639 | otherwise = do
3740 r <- fetch cabalFromPath src
3841 case r of
39− Nothing -> hPutStrLn stderr "*** failed to fetch source. Does the URL exist?" >> exitFailure
42+ Nothing ->
43+ hPutStrLn stderr "*** failed to fetch source. Does the URL exist?" >> exitFailure
4044 Just (derivSource, (externalSource, pkgDesc)) ->
4145 return (derivSource <$ guard externalSource, pkgDesc)
4246
@@ -74,15 +78,28 @@ hashCachePath pid = do
7478sourceFromHackage :: Maybe String -> String -> IO DerivationSource
7579sourceFromHackage optHash pkgId = do
7680 cacheFile <- hashCachePath pkgId
77− hash <- maybe (readFileMay cacheFile) (return . Just) optHash
78− res <- runMaybeT $ fst <$> fetchWith (False, "url") (Source ("mirror://hackage/" ++ pkgId ++ ".tar.gz") "" hash)
79− case res of
80− Just r -> writeFile cacheFile (derivHash r) >> return r
81+ let cachedHash = MaybeT $ maybe (readFileMay cacheFile) (return . Just) optHash
82+ url = "mirror://hackage/" ++ pkgId ++ ".tar.gz"
83+
84+ -- Use the cached hash (either from cache file or given on cmdline via sha256 opt)
85+ -- if available, otherwise download from hackage to compute hash.
86+ maybeHash <- runMaybeT $ cachedHash <|> derivHash . fst <$> fetchWith (False, "url") (Source url "" Nothing)
87+ case maybeHash of
88+ Just hash ->
89+ -- We need to force the hash here. If we didn't do this, then when reading the
90+ -- hash from the cache file, the cache file will still be open for reading
91+ -- (because lazy io) when writeFile opens the file again for writing. By forcing
92+ -- the hash here, we ensure that the file is closed before opening it again.
93+ seq (length hash) $
94+ DerivationSource "url" url "" hash <$ writeFile cacheFile hash
8195 Nothing -> do
8296 hPutStr stderr $ unlines
8397 [ "*** cannot compute hash. (Not a hackage project?)"
84− , " Specify hash explicitly via --sha256 and add appropriate \"src\" attribute"
85− , " to resulting nix expression."
98+ , " If your project is not on hackage, please supply the path to the root directory of"
99+ , " the project, not to the cabal file."
100+ , ""
101+ , " If your project is on hackage but you still want to specify the hash manually, you"
102+ , " can use the --sha256 option."
86103 ]
87104 exitFailure
88105
@@ -96,19 +113,29 @@ cabalFromPath :: FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
96113cabalFromPath path = do
97114 d <- liftIO $ doesDirectoryExist path
98115 (,) d <$> if d
99− then cabalFromDirectory path
100− else cabalFromFile path
116+ then cabalFromDirectory path
117+ else cabalFromFile False path
101118
102119cabalFromDirectory :: FilePath -> MaybeT IO Cabal.GenericPackageDescription
103120cabalFromDirectory dir = do
104121 cabals <- liftIO $ getDirectoryContents dir >>= filterM doesFileExist . map (dir </>) . filter (".cabal" `isSuffixOf`)
105122 case cabals of
106− [cabalFile] -> cabalFromFile cabalFile
123+ [cabalFile] -> cabalFromFile True cabalFile
107124 _ -> liftIO $ hPutStrLn stderr "*** found zero or more than one cabal file. Exiting." >> exitFailure
108125
109−cabalFromFile :: FilePath -> MaybeT IO Cabal.GenericPackageDescription
110−cabalFromFile file = do
111− content <- liftIO $ readFile file
112− case Cabal.parsePackageDescription content of
113− Cabal.ParseFailed _ -> mzero
114− Cabal.ParseOk _ a -> return a
126+cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
127+cabalFromFile failHard file =
128+ -- readFile throws an error if it's used on binary files which contain sequences
129+ -- that do not represent valid characters. To catch that exception, we need to
130+ -- wrap the whole block in `catchIO`, because of lazy IO. The `case` will force
131+ -- the reading of the file, so we will always catch the expression here.
132+ MaybeT $ flip Compat.catchIO (const $ return Nothing) $ do
133+ content <- readFile file
134+ case Cabal.parsePackageDescription content of
135+ Cabal.ParseFailed e | failHard -> do
136+ let (line, err) = ParseUtils.locatedErrorMsg e
137+ msg = maybe "" ((++ ": ") . show) line ++ err
138+ putStrLn $ "*** error parsing cabal file: " ++ msg
139+ exitFailure
140+ Cabal.ParseFailed _ -> return Nothing
141+ Cabal.ParseOk _ a -> return (Just a)