@@ -0,0 +1,127 @@
1+module Cabal2Nix.Package where
2+
3+import Control.Exception ( handle, SomeException(..))
4+import Control.Monad
5+import Data.Functor ( (<$>) )
6+import Data.List ( isSuffixOf )
7+import Data.Maybe ( fromMaybe, fromJust )
8+import Distribution.NixOS.Derivation.Cabal
9+import Distribution.Text ( simpleParse )
10+import Network.Browser ( browse, request, setCheckForProxy, setDebugLog, setOutHandler )
11+import Network.HTTP ( getRequest, rspBody )
12+import System.Directory ( doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getHomeDirectory, getDirectoryContents )
13+import System.Exit ( exitFailure )
14+import System.FilePath ( dropFileName, (</>), (<.>) )
15+import System.IO ( hPutStrLn, stderr)
16+import System.Process ( readProcess )
17+import Text.URI
18+
19+import qualified Distribution.Hackage.DB as DB
20+import qualified Distribution.Package as Cabal
21+import qualified Distribution.PackageDescription as Cabal
22+import qualified Distribution.PackageDescription.Parse as Cabal
23+
24+data Package = Package
25+ { source :: DerivationSource
26+ , cabal :: Cabal.GenericPackageDescription
27+ }
28+
29+readPackage :: Maybe String -> URI -> IO Package
30+readPackage optHash uri = case uriScheme uri of
31+ Nothing -> local
32+ Just "file" -> local
33+ Just "cabal" -> cabalPackage optHash $ fromMaybe "" (uriRegName uri) ++ uriPath uri
34+ Just scheme -> hPutStrLn stderr ("*** unsupported URI scheme: " ++ scheme) >> exitFailure
35+ where local = localPackage optHash $ fromMaybe "" (uriRegName uri) ++ uriPath uri
36+
37+localPackage :: Maybe String -> FilePath -> IO Package
38+localPackage optHash path = do
39+ isDir <- doesDirectoryExist path
40+ cabalFile <- if isDir
41+ then do
42+ cabals <- filter (".cabal" `isSuffixOf`) <$> getDirectoryContents path
43+ case cabals of
44+ [] -> hPutStrLn stderr "*** No cabal file found in given directory" >> exitFailure
45+ (f:_) -> return $ path </> f
46+ else return path
47+ pkgDesc <- readFile cabalFile >>= readPackageDescription
48+ if isDir
49+ then return $ Package (Directory path) pkgDesc
50+ else do
51+ hash <- getHash optHash pkgDesc
52+ return $ Package (Hackage hash) pkgDesc
53+
54+cabalPackage :: Maybe String -> String -> IO Package
55+cabalPackage optHash packageName = do
56+ pkgDesc <- case versionBranch $ Cabal.pkgVersion $ pid packageName of
57+ [] -> do
58+ packageDescription <- DB.lookup packageName `fmap` DB.readHackage
59+ case packageDescription of
60+ Just d -> return $ snd $ last $ DB.toList d
61+ Nothing -> error "No such package"
62+ _ -> fetchUrl (hackagePath (pid packageName) Cabal) >>= readPackageDescription
63+ hash <- getHash optHash pkgDesc
64+ return $ Package (Hackage hash) pkgDesc
65+
66+ where pid p = fromJust $ simpleParse p
67+
68+fetchUrl :: String -> IO String
69+fetchUrl url = do
70+ (_,rsp) <- browse $ do
71+ setCheckForProxy True
72+ setDebugLog Nothing
73+ setOutHandler (\_ -> return ())
74+ request (getRequest url)
75+ return (rspBody rsp)
76+
77+readPackageDescription :: String -> IO Cabal.GenericPackageDescription
78+readPackageDescription source = case Cabal.parsePackageDescription source of
79+ Cabal.ParseOk _ a -> return a
80+ Cabal.ParseFailed err -> do
81+ hPutStrLn stderr ("*** cannot parse cabal file: " ++ show err)
82+ exitFailure
83+
84+getHash :: Maybe String -> Cabal.GenericPackageDescription -> IO String
85+getHash optHash pkgDesc = maybe (hashPackage $ Cabal.package $ Cabal.packageDescription pkgDesc) return optHash
86+
87+data Ext = TarGz | Cabal deriving Eq
88+
89+showExt :: Ext -> String
90+showExt TarGz = ".tar.gz"
91+showExt Cabal = ".cabal"
92+
93+hackagePath :: Cabal.PackageIdentifier -> Ext -> String
94+hackagePath (Cabal.PackageIdentifier (Cabal.PackageName name) version') ext =
95+ "http://hackage.haskell.org/packages/archive/" ++
96+ name ++ "/" ++ version ++ "/" ++ name ++
97+ (if ext == TarGz then '-' : version else "") ++
98+ showExt ext
99+ where
100+ version = showVersion version'
101+
102+hashPackage :: Cabal.PackageIdentifier -> IO String
103+hashPackage pkg = do
104+ cachePath <- hashCachePath pkg
105+ exists <- doesFileExist cachePath
106+ hash' <- if exists
107+ then readFile cachePath
108+ else getHackageHash
109+ let hash = reverse (dropWhile (=='\n') (reverse hash'))
110+ unless exists $ do
111+ createDirectoryIfMissing True (dropFileName cachePath)
112+ writeFile cachePath hash
113+ return hash
114+ where getHackageHash = do
115+ let command = "exec nix-prefetch-url 2>/dev/tty " ++ hackagePath pkg TarGz
116+ handle handlePrefetchError (readProcess "bash" ["-c", command] "")
117+ handlePrefetchError (SomeException _) =
118+ error $ "\nError: Cannot compute hash. (Not a hackage project?)\n" ++
119+ "Specify hash explicitly via --sha256 and add appropriate \"src\" attribute " ++
120+ "to resulting nix expression."
121+
122+hashCachePath :: Cabal.PackageIdentifier -> IO FilePath
123+hashCachePath (Cabal.PackageIdentifier (Cabal.PackageName name) version') = do
124+ home <- getHomeDirectory
125+ return $ home ++ "/.cache/cabal2nix" </> name ++ "-" ++ version <.> "sha256"
126+ where
127+ version = showVersion version'