git.iko.soy/typeable/cabal2nix
on 1663fb8 help sign in
typeable/cabal2nix/src/Cabal2Nix/Package.hs
143 lines 6.4 kB history raw
1module Cabal2Nix.Package where
3import qualified Cabal2Nix.Hackage as DB
4import Control.Applicative
5import qualified Control.Exception as Exception
6import Control.Monad
7import Control.Monad.IO.Class
8import Control.Monad.Trans.Maybe
9import Data.List ( isSuffixOf, isPrefixOf )
10import Data.Maybe
11import Data.Version
12import Distribution.Nixpkgs.Fetch
13import qualified Distribution.Package as Cabal
14import qualified Distribution.PackageDescription as Cabal
15import qualified Distribution.PackageDescription.Parse as Cabal
16import qualified Distribution.ParseUtils as ParseUtils
17import Distribution.Text ( simpleParse )
18import System.Directory ( doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getHomeDirectory, getDirectoryContents )
19import System.Exit ( exitFailure )
20import System.FilePath ( (</>), (<.>) )
21import System.IO ( hPutStrLn, stderr, hPutStr )
23data Package = Package
24 { pkgSource :: DerivationSource
25 , pkgCabal :: Cabal.GenericPackageDescription
26 }
27 deriving (Show)
29getPackage :: Maybe String -> Source -> IO Package
30getPackage optHackageDB source = do
31 (derivSource, pkgDesc) <- fetchOrFromDB optHackageDB source
32 flip Package pkgDesc <$> maybe (sourceFromHackage (sourceHash source) $ showPackageIdentifier pkgDesc) return derivSource
35fetchOrFromDB :: Maybe String -> Source -> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
36fetchOrFromDB optHackageDB src
37 | "cabal://" `isPrefixOf` sourceUrl src = fmap ((,) Nothing) . fromDB optHackageDB . drop (length "cabal://") $ sourceUrl src
38 | otherwise = do
39 r <- fetch cabalFromPath src
40 case r of
41 Nothing ->
42 hPutStrLn stderr "*** failed to fetch source. Does the URL exist?" >> exitFailure
43 Just (derivSource, (externalSource, pkgDesc)) ->
44 return (derivSource <$ guard externalSource, pkgDesc)
46fromDB :: Maybe String -> String -> IO Cabal.GenericPackageDescription
47fromDB optHackageDB pkg = do
48 pkgDesc <- (lookupVersion <=< DB.lookup name) <$> maybe DB.readHashedHackage DB.readHackage' optHackageDB
49 case pkgDesc of
50 Just r -> return r
51 Nothing -> hPutStrLn stderr "*** no such package in the cabal database (did you run cabal update?). " >> exitFailure
52 where
53 pkgId = fromMaybe (error ("invalid Haskell package id " ++ show pkg)) (simpleParse pkg)
54 Cabal.PackageName name = Cabal.pkgName pkgId
55 version = Cabal.pkgVersion pkgId
57 lookupVersion :: DB.Map DB.Version Cabal.GenericPackageDescription -> Maybe Cabal.GenericPackageDescription
58 lookupVersion
59 | null (versionBranch version) = fmap snd . listToMaybe . reverse . DB.toAscList
60 | otherwise = DB.lookup version
63readFileMay :: String -> IO (Maybe String)
64readFileMay file = do
65 e <- doesFileExist file
66 if e
67 then Just <$> readFile file
68 else return Nothing
70hashCachePath :: String -> IO String
71hashCachePath pid = do
72 home <- getHomeDirectory
73 let cacheDir = home </> ".cache/cabal2nix"
74 createDirectoryIfMissing True cacheDir
75 return $ cacheDir </> pid <.> "sha256"
77sourceFromHackage :: Maybe String -> String -> IO DerivationSource
78sourceFromHackage optHash pkgId = do
79 cacheFile <- hashCachePath pkgId
80 let cachedHash = MaybeT $ maybe (readFileMay cacheFile) (return . Just) optHash
81 url = "mirror://hackage/" ++ pkgId ++ ".tar.gz"
83 -- Use the cached hash (either from cache file or given on cmdline via sha256 opt)
84 -- if available, otherwise download from hackage to compute hash.
85 maybeHash <- runMaybeT $ cachedHash <|> derivHash . fst <$> fetchWith (False, "url", []) (Source url "" Nothing)
86 case maybeHash of
87 Just hash ->
88 -- We need to force the hash here. If we didn't do this, then when reading the
89 -- hash from the cache file, the cache file will still be open for reading
90 -- (because lazy io) when writeFile opens the file again for writing. By forcing
91 -- the hash here, we ensure that the file is closed before opening it again.
92 seq (length hash) $
93 DerivationSource "url" url "" hash <$ writeFile cacheFile hash
94 Nothing -> do
95 hPutStr stderr $ unlines
96 [ "*** cannot compute hash. (Not a hackage project?)"
97 , " If your project is not on hackage, please supply the path to the root directory of"
98 , " the project, not to the cabal file."
99 , ""
100 , " If your project is on hackage but you still want to specify the hash manually, you"
101 , " can use the --sha256 option."
102 ]
103 exitFailure
105showPackageIdentifier :: Cabal.GenericPackageDescription -> String
106showPackageIdentifier pkgDesc = name ++ "-" ++ showVersion version where
107 pkgId = Cabal.package . Cabal.packageDescription $ pkgDesc
108 Cabal.PackageName name = Cabal.packageName pkgId
109 version = Cabal.packageVersion pkgId
111cabalFromPath :: FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
112cabalFromPath path = do
113 d <- liftIO $ doesDirectoryExist path
114 (,) d <$> if d
115 then cabalFromDirectory path
116 else cabalFromFile False path
118cabalFromDirectory :: FilePath -> MaybeT IO Cabal.GenericPackageDescription
119cabalFromDirectory dir = do
120 cabals <- liftIO $ getDirectoryContents dir >>= filterM doesFileExist . map (dir </>) . filter (".cabal" `isSuffixOf`)
121 case cabals of
122 [cabalFile] -> cabalFromFile True cabalFile
123 _ -> liftIO $ hPutStrLn stderr "*** found zero or more than one cabal file. Exiting." >> exitFailure
125handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
126handleIO = Exception.handle
128cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
129cabalFromFile failHard file =
130 -- readFile throws an error if it's used on binary files which contain sequences
131 -- that do not represent valid characters. To catch that exception, we need to
132 -- wrap the whole block in `catchIO`, because of lazy IO. The `case` will force
133 -- the reading of the file, so we will always catch the expression here.
134 MaybeT $ handleIO (\err -> Nothing <$ hPutStrLn stderr ("*** parsing cabal file: " ++ show err)) $ do
135 content <- readFile file
136 case Cabal.parsePackageDescription content of
137 Cabal.ParseFailed e | failHard -> do
138 let (line, err) = ParseUtils.locatedErrorMsg e
139 msg = maybe "" ((++ ": ") . show) line ++ err
140 putStrLn $ "*** error parsing cabal file: " ++ msg
141 exitFailure
142 Cabal.ParseFailed _ -> return Nothing
143 Cabal.ParseOk _ a -> return (Just a)