Skip to content
Newer
Older
100644 161 lines (131 sloc) 5.28 KB
d5bb377 @gregorycollins First commit
authored Jul 24, 2009
1 {-
2 -- Given a .cabal file with the platform specification, generate a tree in
3 -- hackage format, with a 00-index.tgz file, so that cabal-install will be
4 -- able to treat the local tree as a db.
5 -}
6
7 import Data.List hiding (intercalate)
8 import System.Directory
9 import Control.Monad
10 import System.IO
11 import System.FilePath
12 import qualified Data.ByteString.Lazy as BS
13 import qualified Data.ByteString.Lazy.Char8 as BS.Char8
14 import qualified Control.Exception as C
15 import System.IO.Error (isDoesNotExistError)
16 import Data.Monoid
17 import Data.Maybe
18 import System.Environment
19
20 -- cabal-install
21 -- import qualified Tar as Tar
22 -- import Types
23
24 import Distribution.Package ( PackageIdentifier(..), Package(..) , Dependency(Dependency) )
25 import Distribution.PackageDescription.Parse
26 import Distribution.Version
27 import Distribution.Simple.Utils
28 import Distribution.Simple.PackageIndex
29 import Distribution.PackageDescription.Configuration
30 import Distribution.PackageDescription hiding (packageDescription)
31 import Distribution.Verbosity
32 import Distribution.Text ( display, simpleParse )
33 import qualified Distribution.Simple.PackageIndex as PackageIndex
34 import System.Cmd
35 import System.FilePath
36
37 -- import Network.Curl.Download.Lazy
38
39 main = do
40 [cabalpath,outdir] <- getArgs
41
42 pwd <- getCurrentDirectory
43 setCurrentDirectory outdir
44
45 let cabal = pwd </> cabalpath
46
47
48 cabalsrc <- readPackageDescription normal cabal
49 let final = flattenPackageDescription cabalsrc
50 dependencies = buildDepends final ++
51 concatMap buildTools (allBuildInfo final)
52
53 -- relies on the fact that meta cabal package is a simple list of
54 -- dependencies and versions. nothing suss.
55 --
56 let urls =
57 [ (d, display name ++ "-" ++ display vers)
58 | d@(Dependency name (ThisVersion vers)) <- dependencies ]
59
60 forM_ urls $ \(dep@(Dependency name vers), package) -> do
61 system $ "cabal unpack " ++ package
62
63
64 --
65 -- Too sleepy. Future: solve this via the cabal library
66 --
67 system $ "cabal install --dry-run --reinstall " ++ (
68 intercalate " " [ package
69 | (_, package) <- urls
70 ] ) ++ " > platform.packages.raw"
71 src <- readFile "platform.packages.raw"
72
73 let programs = drop 2 $ lines src
74 let ls' = case partition ("happy" `isPrefixOf`) programs of ([h],rest) -> h : rest
75 let ls = case partition ("mtl" `isPrefixOf`) ls' of ([h],rest) -> h : rest
76
77 writeFile "platform.packages" (unlines ls) -- move happy to top of list.
78
79 removeFile "platform.packages.raw"
80 setCurrentDirectory pwd
81
82 ------------------------------------------------------------------------
83
84 {-
85 e <- openLazyURI url
86 case e of
87 Left err -> error $ "Unable to download " ++ show url ++ ": " ++ show err
88 Right s -> do createDirectory name
89 createDirectory (name </> display vers)
90 BS.writeFile (name </> display vers </>
91 (name ++ "-" ++ display vers ++ ".tar.gz")) s
92 -}
93
94 {-
95 home <- getHomeDirectory
96 let index = home </> ".cabal/packages/hackage.haskell.org"
97 x <- readRepoIndex index
98 print x
99 -}
100
101
102 -- lookupDependency :: Package pkg => PackageIndex pkg -> Dependency
103
104 -- -> [pkg]
105
106 ------------------------------------------------------------------------
107 -- Stolen from cabal-install
108
109 {-
110 -- | Read a repository index from disk, from the local file specified by
111 -- the 'Repo'.
112 --
113 readRepoIndex :: FilePath -> IO (PackageIndex AvailablePackage)
114 readRepoIndex path =
115 handleNotFound $ do
116 let indexFile = repoLocalDir path </> "00-index.tar"
117 pkgs <- either fail return . parseRepoIndex =<< BS.readFile indexFile
118 C.evaluate (PackageIndex.fromList pkgs)
119
120 where
121 -- | Parse a repository index file from a 'ByteString'.
122 --
123 -- All the 'AvailablePackage's are marked as having come from the given 'Repo'.
124 --
125 parseRepoIndex :: BS.ByteString -> Either String [AvailablePackage]
126 parseRepoIndex = either Left (Right . catMaybes . map extractPkg)
127 . check [] . Tar.read
128
129 check _ (Tar.Fail err) = Left err
130 check ok Tar.Done = Right ok
131 check ok (Tar.Next e es) = check (e:ok) es
132
133 extractPkg :: Tar.Entry -> Maybe AvailablePackage
134 extractPkg entry
135 | takeExtension fileName == ".cabal"
136 = case splitDirectories (normalise fileName) of
137 [pkgname,vers,_] -> case simpleParse vers of
138 Just ver -> Just AvailablePackage {
139 packageInfoId = PackageIdentifier ({-PackageName-} pkgname) ver,
140 packageDescription = descr,
141 packageSource = RepoTarballPackage path
142 }
143 _ -> Nothing
144 where
145 parsed = parsePackageDescription . fromUTF8 . BS.Char8.unpack
146 . Tar.fileContent $ entry
147 descr = case parsed of
148 ParseOk _ d -> d
149 _ -> error $ "Couldn't read cabal file "
150 ++ show fileName
151 _ -> Nothing
152 | otherwise = Nothing
153 where
154 fileName = Tar.fileName entry
155
156 handleNotFound action = catch action $ \e -> if isDoesNotExistError e
157 then return mempty
158 else ioError e
159
160 -}
Something went wrong with that request. Please try again.