Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 130 lines (119 sloc) 4.796 kb
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
1 module Merge where
2
3 import Control.Monad.Error
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
4 -- import Control.Monad.Error
5 import Control.Exception
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
6 import Data.Char
7 import Data.Maybe
8 import Data.List
9 import Data.Version
10 import Distribution.Package
11 import Distribution.Compiler (CompilerId(..), CompilerFlavor(GHC))
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
12 import Distribution.PackageDescription ( PackageDescription(..) )
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
13 import Distribution.PackageDescription.Configuration
14 ( finalizePackageDescription )
15 import Distribution.Simple.PackageIndex (PackageIndex)
16 import Distribution.Text (display)
17
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
18 import System.Directory ( getCurrentDirectory , setCurrentDirectory )
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
19 import System.IO
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
20 import System.Cmd (system)
21 import System.FilePath ((</>), splitPath, joinPath, takeFileName)
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
22 import qualified Data.Map as Map
23
24 import qualified Cabal2Ebuild as E
25 import Cache
26 import Error
27 import GenerateEbuild
225135fd »
2008-09-07 Switch to using Portage.{PackageId,Version}
28 import qualified Portage.PackageId as Portage
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
29 import Overlays
30 import P2
31
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
32 import Distribution.System (buildOS, buildArch)
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
33 import Distribution.Verbosity
34 import Distribution.Simple.Utils
35
36 import Network.URI
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
37 import Network.HTTP
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
38
39 import Cabal2Ebuild
40
f56d5083 »
2008-10-02 Cleanup in merge
41 a <-> b = a ++ '-':b
42 a <.> b = a ++ '.':b
43
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
44 merge :: Verbosity -> URI -> String -> IO ()
225135fd »
2008-09-07 Switch to using Portage.{PackageId,Version}
45 merge verbosity serverURI pstr = do
46 (m_category, Portage.PN pname, m_version) <- case Portage.parseFriendlyPackage pstr of
47 Just v -> return v
48 Nothing -> throwEx (ArgumentError ("Could not parse [category/]package[-version]: " ++ show pstr))
49 overlayPath <- getOverlayPath verbosity
50 overlay <- readPortageTree overlayPath
51 cache <- readCache verbosity overlayPath serverURI
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
52 let (indexTree,clashes) = indexToPortage cache overlay
53 mapM_ putStrLn clashes
225135fd »
2008-09-07 Switch to using Portage.{PackageId,Version}
54 info verbosity $ "Searching for: "++ pstr
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
55 let pkgs =
56 Map.elems
57 . Map.filterWithKey (\(P _ pname') _ -> map toLower pname' == map toLower pname)
58 $ indexTree
59 return ()
60 pkg <- case pkgs of
61 [] -> throwEx (PackageNotFound pname)
62 [xs] -> case m_version of
63 Nothing -> return (maximum xs) -- highest version
64 Just v -> do
65 let ebuilds = filter (\e -> eVersion e == v) xs
66 case ebuilds of
67 [] -> throwEx (PackageNotFound (pname ++ '-':show v))
68 [e] -> return e
69 _ -> fail "the impossible happened"
70 _ -> fail "the impossible happened"
71 category <- do
72 case m_category of
225135fd »
2008-09-07 Switch to using Portage.{PackageId,Version}
73 Just (Portage.Category cat) -> return cat
a1730ad8 »
2008-08-31 Switch to using Cabal's CLI API
74 Nothing -> do
75 case pCategory (ePackage pkg) of
76 "hackage" -> return "dev-haskell"
77 c -> return c
78 let Just genericDesc = ePkgDesc pkg
79 Right (desc, _) = finalizePackageDescription []
80 (Nothing :: Maybe (PackageIndex PackageIdentifier))
81 buildOS buildArch
82 (CompilerId GHC (Version [6,8,2] []))
83 [] genericDesc
84 let ebuild = fixSrc serverURI (packageId desc) (E.cabal2ebuild desc)
f56d5083 »
2008-10-02 Cleanup in merge
85 ebuildName = category </> pname <-> display (pkgVersion (packageId desc))
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
86 putStrLn $ "Merging " ++ ebuildName
87 putStrLn $ "Destination: " ++ overlayPath
88 mergeEbuild overlayPath category ebuild
89 let
f56d5083 »
2008-10-02 Cleanup in merge
90 package_name = pkgName (package desc)
91 package_version = showVersion (pkgVersion (package desc))
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
92 url = "http://hackage.haskell.org/packages/archive/"
93 </> package_name </> package_version </> package_name <-> package_version <.> "tar.gz"
94 Just uri = parseURI url
95 tarballName = package_name <-> package_version <.> "tar.gz"
96 -- example:
97 -- http://hackage.haskell.org/packages/archive/Cabal/1.4.0.2/Cabal-1.4.0.2.tar.gz
98 fetchAndDigest
99 verbosity
100 (overlayPath </> category </> pname)
101 tarballName
102 uri
103
104 fetchAndDigest :: Verbosity
105 -> FilePath -- ^ directory of ebuild
106 -> String -- ^ tarball name
107 -> URI -- ^ tarball uri
108 -> IO ()
109 fetchAndDigest verbosity ebuildDir tarballName tarballURI = do
110 withWorkingDirectory ebuildDir $ do
f56d5083 »
2008-10-02 Cleanup in merge
111 notice verbosity $ "Fetching " ++ show tarballURI
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
112 response <- simpleHTTP (Request tarballURI GET [] "")
113 case response of
114 Left err -> print err
115 Right response -> do
116 let tarDestination = "/usr/portage/distfiles" </> tarballName
f56d5083 »
2008-10-02 Cleanup in merge
117 notice verbosity $ "Saving to " ++ tarDestination
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
118 writeFile tarDestination (rspBody response)
f56d5083 »
2008-10-02 Cleanup in merge
119 notice verbosity $ "Recalculating digests..."
8135c0c7 »
2008-10-01 Implement fetching and creation of digests for new ebuilds
120 system "repoman manifest"
121 return ()
122
123 withWorkingDirectory :: FilePath -> IO a -> IO a
124 withWorkingDirectory newDir action = do
125 oldDir <- getCurrentDirectory
126 bracket
127 (setCurrentDirectory newDir)
128 (\_ -> setCurrentDirectory oldDir)
129 (\_ -> action)
Something went wrong with that request. Please try again.