Permalink
Browse files

First release of HackPort, the Hackage tool for Portage

Usage:
	"hackport list" to get a list of all available packages
	"hackport query PKG" to get all versions of a package
	"hackport merge PKG VERSION" to merge PKG-VERSION to the portage tree
  • Loading branch information...
1 parent 8e80a0b commit aff37c25b1a252c5afe93907a3279250b20dc9d0 der_eq@freenet.de committed Sep 5, 2005
Showing with 537 additions and 0 deletions.
  1. +203 −0 HackPort/Cabal2Ebuild.hs
  2. +39 −0 HackPort/Fetch.hs
  3. +41 −0 HackPort/GenerateEbuild.hs
  4. +104 −0 HackPort/Main.hs
  5. +22 −0 HackPort/Query.hs
  6. +6 −0 HackPort/Setup.hs
  7. +113 −0 HackPort/TarUtils.hs
  8. +9 −0 HackPort/hackport.cabal
View
@@ -0,0 +1,203 @@
+-- A program for generating a Gentoo ebuild from a .cabal file
+--
+-- Author : Duncan Coutts <dcoutts@gentoo.org>
+--
+-- Created: 21 July 2005
+--
+-- Copyright (C) 2005 Duncan Coutts
+--
+-- This library is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU General Public License
+-- as published by the Free Software Foundation; either version 2
+-- of the License, or (at your option) any later version.
+--
+-- This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- General Public License for more details.
+--
+-- |
+-- Maintainer : haskell@gentoo.org
+--
+-- cabal2ebuild - a program for generating a Gentoo ebuild from a .cabal file
+--
+module Cabal2Ebuild
+ (EBuild(..)
+ ,cabal2ebuild
+ ,showEBuild) where
+
+import qualified Distribution.PackageDescription as Cabal
+ (PackageDescription(..),
+ readPackageDescription)
+import qualified Distribution.Package as Cabal (PackageIdentifier(..))
+import qualified Distribution.Version as Cabal (showVersion, Dependency(..),
+ VersionRange(..))
+import qualified Distribution.License as Cabal (License(..))
+--import qualified Distribution.Compiler as Cabal (CompilerFlavor(..))
+
+import Data.Char (toLower)
+import Data.Maybe (catMaybes)
+
+data EBuild = EBuild {
+ name :: String,
+ version :: String,
+ description :: String,
+ homepage :: String,
+ src_uri :: String,
+ license :: String,
+ slot :: String,
+ keywords :: [String],
+ iuse :: [String],
+ depend :: [Dependency],
+ features :: [String],
+ -- comments on various fields for communicating stuff to the user
+ licenseComments :: String,
+ cabalPath :: Maybe String --If it's not ${WORKDIR}/${P}
+ }
+
+type Package = String
+type Version = String
+type UseFlag = String
+data Dependency = AnyVersionOf Package
+ | ThisVersionOf Version Package -- =package-version
+ | LaterVersionOf Version Package -- >package-version
+ | EarlierVersionOf Version Package -- <package-version
+ | OrLaterVersionOf Version Package -- >=package-version
+ | OrEarlierVersionOf Version Package -- <=package-version
+ | DependEither Dependency Dependency -- depend || depend
+ | DependIfUse UseFlag Dependency -- use? ( depend )
+
+ebuildTemplate = EBuild {
+ name = "foobar",
+ version = "0.1",
+ description = "",
+ homepage = "",
+ src_uri = "",
+ license = "",
+ slot = "0",
+ keywords = ["~x86"],
+ iuse = [],
+ depend = [],
+ features = ["haddock"],
+ licenseComments = "",
+ cabalPath = Nothing
+ }
+
+cabal2ebuild :: Cabal.PackageDescription -> EBuild
+cabal2ebuild pkg = ebuildTemplate {
+ name = map toLower (Cabal.pkgName (Cabal.package pkg)),
+ version = Cabal.showVersion (Cabal.pkgVersion (Cabal.package pkg)),
+ description = if null (Cabal.synopsis pkg) then Cabal.description pkg
+ else Cabal.synopsis pkg,
+ homepage = Cabal.homepage pkg,
+ src_uri = Cabal.pkgUrl pkg,
+ license = convertLicense (Cabal.license pkg),
+ licenseComments = licenseComment (Cabal.license pkg),
+ depend = defaultDepGHC
+ : convertDependencies (Cabal.buildDepends pkg)
+ }
+
+defaultDepGHC = OrLaterVersionOf "6.2.2" "virtual/ghc"
+
+-- map the cabal license type to the gentoo license string format
+convertLicense :: Cabal.License -> String
+convertLicense Cabal.GPL = "GPL-2" -- almost certainly version 2
+convertLicense Cabal.LGPL = "LGPL-2.1" -- probably version 2.1
+convertLicense Cabal.BSD3 = "BSD" -- do we really not
+convertLicense Cabal.BSD4 = "BSD" -- distinguish between these?
+convertLicense Cabal.PublicDomain = "public-domain"
+convertLicense Cabal.AllRightsReserved = ""
+convertLicense _ = ""
+
+licenseComment Cabal.AllRightsReserved =
+ "Note: packages without a license cannot be included in portage"
+licenseComment Cabal.OtherLicense =
+ "Fixme: \"OtherLicense\", please fill in manually"
+licenseComment _ = ""
+
+convertDependencies :: [Cabal.Dependency] -> [Dependency]
+convertDependencies = catMaybes . map convertDependency
+
+convertDependency :: Cabal.Dependency -> Maybe Dependency
+convertDependency (Cabal.Dependency name versionRange)
+ | name `elem` standardLibs = Nothing -- no explicit dep on standard libs
+ | otherwise = Just $ convert versionRange
+
+ where
+ ebuildName = "dev-haskell/" ++ map toLower name
+
+ convert :: Cabal.VersionRange -> Dependency
+ convert Cabal.AnyVersion = AnyVersionOf ebuildName
+ convert (Cabal.ThisVersion v) = ThisVersionOf (Cabal.showVersion v) ebuildName
+ convert (Cabal.LaterVersion v) = LaterVersionOf (Cabal.showVersion v) ebuildName
+ convert (Cabal.EarlierVersion v) = EarlierVersionOf (Cabal.showVersion v) ebuildName
+ convert (Cabal.UnionVersionRanges (Cabal.ThisVersion v1) (Cabal.LaterVersion v2))
+ | v1 == v2 = OrLaterVersionOf (Cabal.showVersion v1) ebuildName
+ convert (Cabal.UnionVersionRanges (Cabal.ThisVersion v1) (Cabal.EarlierVersion v2))
+ | v1 == v2 = OrEarlierVersionOf (Cabal.showVersion v1) ebuildName
+ convert (Cabal.UnionVersionRanges r1 r2)
+ = DependEither (convert r1) (convert r2)
+-- convert (Cabal.IntersectVersionRanges r1 r2)
+-- = convert r1 ++ "&&" ++ convert r2
+
+standardLibs =
+ ["rts", "base", "haskell98"
+ ,"template-haskell"
+ ,"unix"
+ ,"parsec"
+ ,"haskell-src"
+ ,"network"
+ ,"stm"
+ ,"readline"
+ ,"lang", "concurrent", "posix", "util", "data", "text", "net", "hssource"]
+
+showEBuild :: EBuild -> String
+showEBuild ebuild =
+ ss "# Copyright 1999-2005 Gentoo Foundation". nl.
+ ss "# Distributed under the terms of the GNU General Public License v2". nl.
+ ss "# $Header: $". nl.
+ nl.
+ ss "CABAL_FEATURES=". quote' (sepBy " " $ features ebuild). nl.
+ ss "inherit haskell-cabal". nl.
+ nl.
+ ss "DESCRIPTION=". quote (description ebuild). nl.
+ ss "HOMEPAGE=". quote (homepage ebuild). nl.
+ ss "SRC_URI=". quote (src_uri ebuild).
+ (if null (src_uri ebuild) then ss "\t#Fixme: please fill in manually"
+ else id). nl.
+ ss "LICENSE=". quote (license ebuild).
+ (if null (licenseComments ebuild) then id
+ else ss "\t#". ss (licenseComments ebuild)). nl.
+ ss "SLOT=". quote (slot ebuild). nl.
+ nl.
+ ss "KEYWORDS=". quote' (sepBy ", " $ keywords ebuild).
+ (ss "\t#if possible try testing with \"~amd64\", \"~ppc\" and \"~sparc\""). nl.
+ ss "IUSE=". quote' (sepBy ", " $ iuse ebuild). nl.
+ nl.
+ ss "DEPEND=". quote' (sepBy "\n\t\t" $ map showDepend $ depend ebuild). nl.
+ (case cabalPath ebuild of Nothing -> id ; Just cp -> ss "S=${WORKDIR}/". ss cp. nl)
+ $ []
+
+showDepend (AnyVersionOf package) = package
+showDepend (ThisVersionOf version package) = "=" ++ package ++ "-" ++ version
+showDepend (LaterVersionOf version package) = ">" ++ package ++ "-" ++ version
+showDepend (EarlierVersionOf version package) = "<" ++ package ++ "-" ++ version
+showDepend (OrLaterVersionOf version package) = ">=" ++ package ++ "-" ++ version
+showDepend (OrEarlierVersionOf version package) = "<=" ++ package ++ "-" ++ version
+showDepend (DependEither depend1 depend2) = showDepend depend1
+ ++ " || " ++ showDepend depend2
+showDepend (DependIfUse useflag depend@(DependEither _ _))
+ = useflag ++ "? " ++ showDepend depend
+showDepend (DependIfUse useflag depend) = useflag ++ "? ( " ++ showDepend depend ++ " )"
+
+ss = showString
+sc = showChar
+nl = sc '\n'
+
+quote str = sc '"'. ss str. sc '"'
+quote' str = sc '"'. str. sc '"'
+
+sepBy :: String -> [String] -> ShowS
+sepBy s [] = id
+sepBy s [x] = ss x
+sepBy s (x:xs) = ss x. ss s. sepBy s xs
View
@@ -0,0 +1,39 @@
+module Fetch(downloadFile) where
+
+import Network.HTTP (ConnError(..),Request(..),simpleHTTP
+ ,Response(..),RequestMethod(..))
+import Network.URI (URI,uriPath,parseURI)
+import Text.Regex (Regex,mkRegex,matchRegex)
+
+filenameRegex :: Regex
+filenameRegex = mkRegex "^.*?/([^/]*?)"
+
+uriToFileName :: URI -> Maybe FilePath
+uriToFileName uri = maybe Nothing (\x->Just (head x)) (matchRegex filenameRegex (uriPath uri))
+
+downloadURI :: FilePath --where to put(directory)
+ -> URI --where to get
+ -> IO (Either ConnError FilePath)
+downloadURI path uri = do
+ case uriToFileName uri of
+ Nothing -> return (Left (ErrorMisc ("URI doesn't contain a failname")))
+ Just name -> do
+ result <- simpleHTTP request
+ case result of
+ Left err -> return (Left err)
+ Right rsp
+ | rspCode rsp == (2,0,0) -> let respath=path++"/"++name in writeFile respath (rspBody rsp) >> return (Right respath)
+ | otherwise -> return (Left (ErrorMisc ("Invalid HTTP code: " ++ show (rspCode rsp))))
+ where
+ request = Request
+ {rqURI=uri
+ ,rqMethod=GET
+ ,rqHeaders=[]
+ ,rqBody=""}
+
+downloadFile :: FilePath
+ -> String
+ -> IO (Either ConnError FilePath)
+downloadFile path url = case parseURI url of
+ Just parsed -> downloadURI path parsed
+ Nothing -> return (Left (ErrorMisc ("Failed to parse url: " ++ show url)))
View
@@ -0,0 +1,41 @@
+module GenerateEbuild where
+
+import Cabal2Ebuild
+import Fetch
+import TarUtils
+import Network.Hackage.Client as Hackage
+import Distribution.PackageDescription
+import Distribution.Package
+import System.Directory
+
+mergeEbuild :: FilePath -> String -> EBuild -> IO ()
+mergeEbuild target category ebuild = do
+ let epath = target++"/"++category++"/"++(name ebuild)
+ createDirectoryIfMissing True epath
+ writeFile (epath++"/"++(name ebuild)++"-"++(version ebuild)++".ebuild") (showEBuild ebuild)
+
+hackage2ebuild :: String -> FilePath -> PackageIdentifier -> IO (Either String EBuild)
+-- | | \the package
+-- | \a temp path to store the tarball
+-- \the server
+--
+hackage2ebuild server store pkg = do
+ result <- Hackage.getPkgLocation server pkg
+ case result of
+ Nothing -> return (Left "Package not found on Hackage Server")
+ Just (tarball,sig) -> do
+ downloadres <- downloadFile store tarball
+ case downloadres of
+ Left err -> return (Left (show err))
+ Right tarballloc -> do
+ case tarballGetType tarball of
+ Nothing -> return $ Left "Couldn't guess compression type of tarball"
+ Just tarType -> do
+ files <- tarballGetFiles "/bin/tar" tarballloc tarType
+ case findCabal files of
+ Nothing -> return $ Left "No cabal file found in tarball"
+ Just (caballoc,cabalname) -> do
+ cabalfile <- tarballExtractFile "/bin/tar" tarballloc tarType (caballoc++"/"++cabalname)
+ case parseDescription cabalfile of
+ ParseFailed err -> return $ Left ("Parsing '"++cabalname++"' failed: "++(showError err))
+ ParseOk descr -> return $ Right ((cabal2ebuild descr) {src_uri=tarball,cabalPath=Just caballoc})
View
@@ -0,0 +1,104 @@
+module Main where
+
+import System.Console.GetOpt
+import System.Environment
+import System.Exit
+import Distribution.Package
+import Data.Version
+import Query
+import GenerateEbuild
+import Cabal2Ebuild
+
+data HackPortOptions
+ = TarCommand String
+ | PortageTree String
+ | Category String
+ | Server String
+ | TempDir String
+
+data OperationMode
+ = Query String
+ | Merge String String
+ | ListAll
+ | ShowHelp
+
+data Config = Config
+ { tarCommand ::String
+ , portageTree ::String
+ , portageCategory ::String
+ , server ::String
+ , tmp ::String
+ }
+
+defaultConfig :: Config
+defaultConfig = Config
+ { tarCommand = "/bin/tar"
+ , portageTree = "/usr/portage"
+ , portageCategory = "dev-haskell"
+ , server = "http://hackage.haskell.org/ModHackage/Hackage.hs?action=xmlrpc"
+ , tmp = "/tmp"
+ }
+
+options :: [OptDescr HackPortOptions]
+options = [Option ['t'] ["tar"] (ReqArg TarCommand "PATH") "Path to the \"tar\" executable"
+ ,Option ['p'] ["portage-tree"] (ReqArg PortageTree "PATH") "The portage tree to merge to"
+ ,Option ['c'] ["portage-category"] (ReqArg Category "CATEGORY") "The cateory the program belongs to"
+ ,Option ['s'] ["server"] (ReqArg Server "URL") "The Hackage server to query"
+ ,Option [] ["temp-dir"] (ReqArg TempDir "PATH") "A temp directory where tarballs can be stored"
+ ]
+
+optionsToConfig :: Config -> [HackPortOptions] -> Config
+optionsToConfig cfg [] = cfg
+optionsToConfig cfg (x:xs) = case x of
+ TarCommand str -> cfg { tarCommand = str }
+ PortageTree str -> cfg { portageTree = str }
+ Category str -> cfg { portageCategory = str }
+ Server str -> cfg { server = str }
+ TempDir str -> cfg { tmp = str }
+
+parseConfig :: [String] -> Either String (Config,OperationMode)
+parseConfig opts = case getOpt Permute options opts of
+ (popts,"query":package:[],[]) -> Right (ropts popts,Query package)
+ (popts,"merge":package:version:[],[]) -> Right (ropts popts,Merge package version)
+ (popts,"list":[],[]) -> Right (ropts popts,ListAll)
+ (popts,[],[]) -> Right (ropts popts,ShowHelp)
+ (_,_,[]) -> Left "Unknown opertation mode"
+ (_,_,errs) -> Left ("Error parsing flags: "++concat errs)
+ where
+ ropts op = optionsToConfig defaultConfig op
+
+listAll :: Config -> IO ()
+listAll cfg = do
+ pkgs <- getPackages (server cfg)
+ putStr (unlines pkgs)
+
+usage :: IO ()
+usage = putStr (usageInfo "Usage: hackport [OPTION] MODE [MODETARGET]\n\twhere MODE is one of query,list or merge" options)
+
+query :: Config -> String -> IO ()
+query cfg name = do
+ pkgvers <- getPackageVersions (server cfg) name
+ putStr (unlines (map showVersion pkgvers))
+
+merge :: Config -> String -> String -> IO ()
+merge cfg name vers = do
+ case parseVersion' vers of
+ Nothing -> putStr ("Error: couldn't parse version number '"++vers++"'\n")
+ Just realvers -> do
+ result <- hackage2ebuild (server cfg) (tmp cfg) (PackageIdentifier {pkgName=name,pkgVersion=realvers})
+ case result of
+ Left err -> putStr ("Error: "++err)
+ Right ebuild -> mergeEbuild (portageTree cfg) (portageCategory cfg) ebuild
+
+main :: IO ()
+main = do
+ args <- getArgs
+ case parseConfig args of
+ Left err -> do
+ putStr err
+ exitWith (ExitFailure 1)
+ Right (config,mode) -> case mode of
+ ShowHelp -> usage
+ ListAll -> listAll config
+ Query pkg -> query config pkg
+ Merge pkg vers -> merge config pkg vers
Oops, something went wrong.

0 comments on commit aff37c2

Please sign in to comment.