summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLennartKolmodin <>2008-08-28 20:42:41 (GMT)
committerLuite Stegeman <luite@luite.com>2008-08-28 20:42:41 (GMT)
commit798faf2f4fc74cddc57c6a010ab65448c4067da8 (patch)
treea93529ebb2bf885e9ae2e634fa80a3bdfccdf6e9
version 0.2.10.2.1
-rw-r--r--Action.hs121
-rw-r--r--AnsiColor.hs63
-rw-r--r--Bash.hs45
-rw-r--r--BlingBling.hs15
-rw-r--r--Cabal2Ebuild.hs401
-rw-r--r--Cache.hs93
-rw-r--r--CacheFile.hs12
-rw-r--r--Config.hs125
-rw-r--r--Diff.hs70
-rw-r--r--Error.hs55
-rw-r--r--Fetch.hs75
-rw-r--r--GenerateEbuild.hs60
-rw-r--r--Index.hs45
-rw-r--r--Main.hs136
-rw-r--r--MaybeRead.hs14
-rw-r--r--Overlays.hs59
-rw-r--r--P2.hs106
-rw-r--r--Package.hs76
-rw-r--r--Portage.hs20
-rw-r--r--Setup.hs7
-rw-r--r--Status.hs159
-rw-r--r--Utils.hs7
-rw-r--r--Version.hs122
-rw-r--r--hackport.cabal64
24 files changed, 1950 insertions, 0 deletions
diff --git a/Action.hs b/Action.hs
new file mode 100644
index 0000000..0b18752
--- /dev/null
+++ b/Action.hs
@@ -0,0 +1,121 @@
+module Action where
+
+import Config
+import Error
+
+import Control.Monad.State
+import Control.Monad.Error
+import Network.URI (parseURI)
+import System.IO
+import System.Environment
+
+type HPAction = ErrorT HackPortError (StateT HPState IO)
+
+data HPState = HPState
+ { config :: Config
+ , indention :: Int
+ }
+
+verbose :: HPAction a -> (String,a->String) -> HPAction a
+verbose action (premsg,postmsg) = do
+ echoIndent
+ echo premsg
+ flush
+ res <- indent action
+ echoLn (postmsg res)
+ return res
+
+sayNormal :: HPAction a -> (String,a->String) -> HPAction a
+sayNormal action strs = do
+ cfg <- getCfg
+ case verbosity cfg of
+ Silent -> action
+ _ -> action `verbose` strs
+
+sayDebug :: HPAction a -> (String,a->String) -> HPAction a
+sayDebug action strs = do
+ cfg <- getCfg
+ case verbosity cfg of
+ Debug -> action `verbose` strs
+ _ -> action
+
+info :: String -> HPAction ()
+info str = do
+ cfg <- getCfg
+ case verbosity cfg of
+ Silent -> return ()
+ _ -> echoLn str
+
+-- | Prints a string iff in debug output mode
+whisper :: String -> HPAction ()
+whisper str = do
+ cfg <- getCfg
+ case verbosity cfg of
+ Debug -> echoLn str
+ _ -> return ()
+
+getCfg :: HPAction Config
+getCfg = gets config
+
+setOverlayPath :: Maybe String -> HPAction ()
+setOverlayPath mt = modify $ \hps ->
+ hps { config = (config hps) { overlayPath = mt } }
+
+setPortagePath :: Maybe String -> HPAction ()
+setPortagePath mt = modify $ \hps ->
+ hps { config = (config hps) { portagePath = mt } }
+
+lessIndent :: HPAction ()
+lessIndent = modify $ \s -> s { indention = indention s - 1 }
+
+moreIndent :: HPAction ()
+moreIndent = modify $ \s -> s { indention = indention s + 1 }
+
+echoIndent :: HPAction ()
+echoIndent = do
+ ind <- gets indention
+ echo (replicate ind '\t')
+
+indent :: HPAction a -> HPAction a
+indent action = do
+ moreIndent
+ res <- action
+ lessIndent
+ return res
+
+echo :: String -> HPAction ()
+echo str = liftIO $ hPutStr stderr str
+
+flush :: HPAction ()
+flush = liftIO (hFlush stderr)
+
+echoLn :: String -> HPAction ()
+echoLn str = echoIndent >> echo str >> liftIO (hPutChar stderr '\n')
+
+loadConfig :: HPAction OperationMode
+loadConfig = do
+ args <- liftIO getArgs
+ case parseConfig args of
+ Left errmsg -> throwError (ArgumentError errmsg)
+ Right (opts,opmode) -> do
+ cfg <- foldM optionToConfig defaultConfig opts
+ modify $ \s -> s { config = cfg }
+ return opmode
+
+optionToConfig :: Config -> HackPortOptions -> HPAction Config
+optionToConfig cfg opt = case opt of
+ OverlayPath str -> return cfg { overlayPath = Just str }
+ PortagePath str -> return cfg { portagePath = Just str }
+ Server str -> case parseURI str of
+ Nothing -> throwError (InvalidServer str)
+ Just uri -> return cfg { server = uri }
+ TempDir str -> return cfg { tmp = str }
+ Verbosity str -> case parseVerbosity str of
+ Nothing -> throwError (UnknownVerbosityLevel str)
+ Just verb -> return cfg { verbosity=verb }
+ Help -> return cfg
+ RefreshCache -> return cfg { refreshCache = True }
+
+performHPAction :: HPAction a -> IO (Either HackPortError a)
+performHPAction action =
+ evalStateT (runErrorT action) (HPState defaultConfig 0)
diff --git a/AnsiColor.hs b/AnsiColor.hs
new file mode 100644
index 0000000..7a6edf7
--- /dev/null
+++ b/AnsiColor.hs
@@ -0,0 +1,63 @@
+{-|
+ Maintainer : Andres Loeh <kosmikus@gentoo.org>
+ Stability : provisional
+ Portability : haskell98
+
+ Simplistic ANSI color support.
+-}
+
+module AnsiColor
+ where
+
+import Data.List
+
+data Color = Black
+ | Red
+ | Green
+ | Yellow
+ | Blue
+ | Magenta
+ | Cyan
+ | White
+ | Default
+ deriving Enum
+
+esc :: [String] -> String
+esc [] = ""
+esc xs = "\ESC[" ++ (concat . intersperse ";" $ xs) ++ "m"
+
+col :: Color -> Bool -> Color -> [String]
+col fg bf bg = show (fromEnum fg + 30) : bf' [show (fromEnum bg + 40)]
+ where bf' | bf = ("01" :)
+ | otherwise = id
+
+inColor :: Color -> Bool -> Color -> String -> String
+inColor c bf bg txt = esc (col c bf bg) ++ txt ++ esc ["00"]
+
+bold, italic, underline, inverse :: String -> String
+bold = ansi "1" "22"
+italic = ansi "3" "23"
+underline = ansi "4" "24"
+inverse = ansi "7" "27"
+
+ansi :: String -> String -> String -> String
+ansi on off txt = esc [on] ++ txt ++ esc [off]
+
+{-
+data Doc = Doc (Bool -> String -> String)
+
+char chr = Doc (\_ c -> chr:c)
+
+text str = Doc (\_ c -> str ++ c)
+
+(Doc t) <> (Doc u) = Doc (\b c -> t b (u b c))
+
+t <+> u = t <> char ' ' <> u
+
+showDoc (Doc d) b = d b ""
+
+color (Doc d) color = Doc (\ b c ->
+ if not b
+ then d b c
+ else inColor color False Default (d b ""))
+-}
diff --git a/Bash.hs b/Bash.hs
new file mode 100644
index 0000000..4fe703b
--- /dev/null
+++ b/Bash.hs
@@ -0,0 +1,45 @@
+module Bash where
+
+import Control.Monad.Error
+import System.Process
+import System.Directory
+import System.IO
+import System.Exit
+
+import Action
+import Config
+import Error
+
+getSystemPortdir :: HPAction String
+getSystemPortdir = do
+ dir <- runBash "source /etc/make.conf;echo -n $PORTDIR"
+ case dir of
+ "" -> return "/usr/portage"
+ _ -> return dir
+
+getPortdir :: HPAction String
+getPortdir = do
+ cfg <- getCfg
+ case portagePath cfg of
+ Just dir -> return dir
+ Nothing -> do
+ sys <- getSystemPortdir
+ setPortagePath (Just sys)
+ return sys
+
+runBash ::
+ String -> -- ^ The command line
+ HPAction String -- ^ The command-line's output
+runBash command = do
+ mpath <- liftIO $ findExecutable "bash"
+ bash <- maybe (throwError BashNotFound) return mpath
+ (inp,outp,err,pid) <- liftIO $ runInteractiveProcess bash ["-c",command] Nothing Nothing
+ liftIO $ hClose inp
+ result <- liftIO $ hGetContents outp
+ errors <- liftIO $ hGetContents err
+ length result `seq` liftIO (hClose outp)
+ length errors `seq` liftIO (hClose err)
+ exitCode <- liftIO $ waitForProcess pid
+ case exitCode of
+ ExitFailure _ -> throwError $ BashError errors
+ ExitSuccess -> return result
diff --git a/BlingBling.hs b/BlingBling.hs
new file mode 100644
index 0000000..14a75b1
--- /dev/null
+++ b/BlingBling.hs
@@ -0,0 +1,15 @@
+module BlingBling where
+
+import System.IO
+
+-- what nobody needs but everyone wants...
+
+-- FIXME: do something more fun here
+forMbling :: [a] -> (a -> IO b) -> IO [b]
+forMbling lst f = do
+ origBuffering <- hGetBuffering stdout
+ hSetBuffering stdout NoBuffering
+ xs <- mapM (\x -> putStr "." >> f x) lst
+ putStrLn ""
+ hSetBuffering stdout origBuffering
+ return xs
diff --git a/Cabal2Ebuild.hs b/Cabal2Ebuild.hs
new file mode 100644
index 0000000..5511204
--- /dev/null
+++ b/Cabal2Ebuild.hs
@@ -0,0 +1,401 @@
+-- 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(..))
+import qualified Distribution.Package as Cabal (PackageIdentifier(..), Dependency(..))
+import qualified Distribution.Version as Cabal (VersionRange(..), versionBranch, Version)
+import qualified Distribution.License as Cabal (License(..))
+import qualified Distribution.Text as Cabal (display)
+--import qualified Distribution.Compiler as Cabal (CompilerFlavor(..))
+
+import Data.Char (toLower,isUpper)
+import Data.List (intercalate, groupBy, partition, nub, sortBy, init, last)
+import Data.Ord (comparing)
+import Data.Maybe (catMaybes, fromJust)
+
+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,
+ my_pn :: Maybe String --If the package's name contains upper-case
+ }
+
+type Package = String
+newtype Version = Version [Int] deriving (Ord, Eq)
+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 )
+ | ThisMajorOf Version Package -- =package-version*
+ deriving Eq
+
+ebuildTemplate :: EBuild
+ebuildTemplate = EBuild {
+ name = "foobar",
+ version = "0.1",
+ description = "",
+ homepage = "",
+ src_uri = "",
+ license = "",
+ slot = "0",
+ keywords = ["~amd64","~x86"],
+ iuse = [],
+ depend = [],
+ features = [],
+ licenseComments = "",
+ my_pn = Nothing
+ }
+
+
+
+cabal2ebuild :: Cabal.PackageDescription -> EBuild
+cabal2ebuild pkg = ebuildTemplate {
+ name = map toLower cabalPkgName,
+ version = Cabal.display (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
+ : (simplify_deps $
+ convertDependency (Cabal.Dependency "Cabal"
+ (Cabal.descCabalVersion pkg))
+ ++ convertDependencies (Cabal.buildDepends pkg)),
+ my_pn = if any isUpper cabalPkgName then Just cabalPkgName else Nothing,
+ features = features ebuildTemplate
+ ++ (if null (Cabal.executables pkg) then [] else ["bin"])
+ ++ maybe [] (const ["lib","profile","haddock"]) (Cabal.library pkg)
+ } where
+ cabalPkgName = Cabal.pkgName (Cabal.package pkg)
+
+defaultDepGHC :: Dependency
+defaultDepGHC = OrLaterVersionOf (Version [6,6,1]) "dev-lang/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.License -> String
+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 = concatMap convertDependency
+
+convertDependency :: Cabal.Dependency -> [Dependency]
+convertDependency (Cabal.Dependency pname _)
+ | pname `elem` coreLibs = [] -- no explicit dep on core libs
+convertDependency (Cabal.Dependency pname versionRange)
+ = case versionRange of
+ (Cabal.IntersectVersionRanges v1 v2) -> [convert v1, convert v2]
+ v -> [convert v]
+
+ where
+ ebuildName = "dev-haskell/" ++ map toLower pname
+
+ convert :: Cabal.VersionRange -> Dependency
+ convert Cabal.AnyVersion = AnyVersionOf ebuildName
+ convert (Cabal.ThisVersion v) = ThisVersionOf (cabalVtoHPv v) ebuildName
+ convert (Cabal.LaterVersion v) = LaterVersionOf (cabalVtoHPv v) ebuildName
+ convert (Cabal.EarlierVersion v) = EarlierVersionOf (cabalVtoHPv v) ebuildName
+ convert (Cabal.UnionVersionRanges (Cabal.ThisVersion v1) (Cabal.LaterVersion v2))
+ | v1 == v2 = OrLaterVersionOf (cabalVtoHPv v1) ebuildName
+ convert (Cabal.UnionVersionRanges (Cabal.ThisVersion v1) (Cabal.EarlierVersion v2))
+ | v1 == v2 = OrEarlierVersionOf (cabalVtoHPv v1) ebuildName
+ convert (Cabal.UnionVersionRanges r1 r2)
+ = DependEither (convert r1) (convert r2)
+
+-- converts Cabal versiion type to hackopr version
+cabalVtoHPv :: Cabal.Version -> Version
+cabalVtoHPv = Version . Cabal.versionBranch
+
+instance Show Version where
+ show (Version v) = intercalate "." $ map show v
+
+coreLibs :: [String]
+coreLibs =
+ ["array"
+ ,"base"
+--,"bytestring" --already has ebuild
+ ,"containers"
+ ,"directory"
+--,"filepath" --already has ebuild
+ ,"ghc"
+ ,"haskell98"
+ ,"hpc" --has ebuild, but only in the overlay
+ ,"old-locale"
+ ,"old-time"
+ ,"packedstring"
+ ,"pretty"
+ ,"process"
+ ,"random"
+ ,"readline" --has ebuild, but only in the overlay
+ ,"rts"
+ ,"template-haskell"
+ ,"unix" --has ebuild, but only in the overlay
+ ]
+
+showEBuild :: EBuild -> String
+showEBuild ebuild =
+ ss "# Copyright 1999-2008 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.
+ (case my_pn ebuild of
+ Nothing -> id
+ Just pn -> ss "MY_PN=". quote pn. nl.
+ ss "MY_P=". quote "${MY_PN}-${PV}". nl. nl).
+ ss "DESCRIPTION=". quote (description ebuild). nl.
+ ss "HOMEPAGE=". quote (homepage ebuild). nl.
+ ss "SRC_URI=". quote (replaceVars (src_uri ebuild)).
+ (if null (src_uri ebuild) then ss "\t#Fixme: please fill in manually"
+ else id). nl.
+ 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.
+ ss "KEYWORDS=". quote' (sepBy " " $ keywords ebuild).nl.
+ ss "IUSE=". quote' (sepBy ", " $ iuse ebuild). nl.
+ nl.
+ ss "DEPEND=". quote' (sepBy "\n\t\t" $ map showDepend $ depend ebuild). nl.
+ (case my_pn ebuild of
+ Nothing -> id
+ Just _ -> nl. ss "S=". quote ("${WORKDIR}/${MY_P}"). nl)
+ $ []
+ where replaceVars = replaceCommonVars (name ebuild) (my_pn ebuild) (version ebuild)
+
+showDepend :: Dependency -> Package
+showDepend (AnyVersionOf p) = p
+showDepend (ThisVersionOf v p) = "~" ++ p ++ "-" ++ show v
+showDepend (LaterVersionOf v p) = ">" ++ p ++ "-" ++ show v
+showDepend (EarlierVersionOf v p) = "<" ++ p ++ "-" ++ show v
+showDepend (OrLaterVersionOf v p) = ">=" ++ p ++ "-" ++ show v
+showDepend (OrEarlierVersionOf v p) = "<=" ++ p ++ "-" ++ show v
+showDepend (DependEither dep1 dep2) = showDepend dep1
+ ++ " || " ++ showDepend dep2
+showDepend (DependIfUse useflag dep@(DependEither _ _))
+ = useflag ++ "? " ++ showDepend dep
+showDepend (DependIfUse useflag dep) = useflag ++ "? ( " ++ showDepend dep++ " )"
+showDepend (ThisMajorOf v p) = "=" ++ p ++ "-" ++ show v ++ "*"
+
+ss :: String -> String -> String
+ss = showString
+
+sc :: Char -> String -> String
+sc = showChar
+
+nl :: String -> String
+nl = sc '\n'
+
+quote :: String -> String -> String
+quote str = sc '"'. ss str. sc '"'
+
+quote' :: (String -> String) -> String -> String
+quote' str = sc '"'. str. sc '"'
+
+sepBy :: String -> [String] -> ShowS
+sepBy _ [] = id
+sepBy _ [x] = ss x
+sepBy s (x:xs) = ss x. ss s. sepBy s xs
+
+getRestIfPrefix ::
+ String -> -- ^ the prefix
+ String -> -- ^ the string
+ Maybe String
+getRestIfPrefix (p:ps) (x:xs) = if p==x then getRestIfPrefix ps xs else Nothing
+getRestIfPrefix [] rest = Just rest
+getRestIfPrefix _ [] = Nothing
+
+subStr ::
+ String -> -- ^ the search string
+ String -> -- ^ the string to be searched
+ Maybe (String,String) -- ^ Just (pre,post) if string is found
+subStr sstr str = case getRestIfPrefix sstr str of
+ Nothing -> if null str then Nothing else case subStr sstr (tail str) of
+ Nothing -> Nothing
+ Just (pre,post) -> Just (head str:pre,post)
+ Just rest -> Just ([],rest)
+
+replaceMultiVars ::
+ [(String,String)] -> -- ^ pairs of variable name and content
+ String -> -- ^ string to be searched
+ String -- ^ the result
+replaceMultiVars [] str = str
+replaceMultiVars whole@((pname,cont):rest) str = case subStr cont str of
+ Nothing -> replaceMultiVars rest str
+ Just (pre,post) -> (replaceMultiVars rest pre)++pname++(replaceMultiVars whole post)
+
+replaceCommonVars ::
+ String -> -- ^ PN
+ Maybe String -> -- ^ MYPN
+ String -> -- ^ PV
+ String -> -- ^ the string to be replaced
+ String
+replaceCommonVars pn mypn pv str
+ = replaceMultiVars
+ ([("${P}",pn++"-"++pv)]
+ ++ maybe [] (\x->[("${MY_P}",x++"-"++pv)]) mypn
+ ++[("${PN}",pn)]
+ ++ maybe [] (\x->[("${MY_PN}",x)]) mypn
+ ++[("${PV}",pv)]) str
+
+
+{- Here goes code for dependencies simplification -}
+
+simplify_group_table :: Package ->
+ Maybe Version ->
+ Maybe Version ->
+ Maybe Version ->
+ Maybe Version ->
+ Maybe Version -> [Dependency]
+
+-- simplify_group_table p ol l e oe exact
+-- 1) trivial cases:
+simplify_group_table p Nothing Nothing Nothing Nothing Nothing = error $ p ++ ": unsolvable constraints"
+simplify_group_table p (Just v) Nothing Nothing Nothing Nothing = [OrLaterVersionOf v p]
+simplify_group_table p Nothing (Just v) Nothing Nothing Nothing = [LaterVersionOf v p]
+simplify_group_table p Nothing Nothing (Just v) Nothing Nothing = [EarlierVersionOf v p]
+simplify_group_table p Nothing Nothing Nothing (Just v) Nothing = [OrEarlierVersionOf v p]
+simplify_group_table p Nothing Nothing Nothing Nothing (Just v) = [ThisVersionOf v p]
+
+-- 2) simplification passes
+simplify_group_table p (Just (Version v1)) Nothing (Just (Version v2)) Nothing Nothing
+ -- specian case: >=a-v.N a<v.(N+1) => =a-v.N*
+ | (init v1 == init v2) && (last v2 == last v1 + 1) = [ThisMajorOf (Version v1) p]
+ | otherwise = [OrLaterVersionOf (Version v1) p, EarlierVersionOf (Version v2) p]
+
+-- TODO: simplify constraints of type: >=a-v1; > a-v2 and such
+
+-- o3) therwise sink:
+simplify_group_table p (Just v) l@(_) e@(_) oe@(_) exact@(_) = OrLaterVersionOf v p : simplify_group_table p Nothing l e oe exact
+simplify_group_table p ol@(Nothing) (Just v) e@(_) oe@(_) exact@(_) = LaterVersionOf v p : simplify_group_table p ol Nothing e oe exact
+simplify_group_table p ol@(Nothing) l@(Nothing) (Just v) oe@(_) exact@(_) = EarlierVersionOf v p : simplify_group_table p ol l Nothing oe exact
+simplify_group_table p ol@(Nothing) l@(Nothing) e@(Nothing) (Just v) exact@(_) = OrEarlierVersionOf v p : simplify_group_table p ol l e Nothing exact
+-- already defined earlier
+-- simplify_group_table p ol@(Nothing) l@(Nothing) e@(Nothing) oe@(Nothing) (Just v) = OrEarlierVersionOf v p : simplify_group_table p ol l e oe Nothing
+
+-- >a-v1 >a-v2 => >a-(max v1 v2)
+-- key idea: all constraints are enforcing constraints, so we can't get
+-- more, than one interval.
+simplify_group :: [Dependency] -> [Dependency]
+simplify_group [dep@(AnyVersionOf _package)] = [dep]
+simplify_group deps = simplify_group_table package
+ min_or_later_v -- >=
+ min_later_v -- >
+ max_earlier_v -- <
+ max_or_earlier_v -- <=
+ exact_this_v -- ==
+ where
+ package = fromJust.getPackage $ head deps
+ max_earlier_v = safe_minimum $ map earlier_v deps
+ max_or_earlier_v = safe_minimum $ map or_earlier_v deps
+ min_later_v = safe_maximum $ map later_v deps
+ min_or_later_v = safe_maximum $ map or_later_v deps
+ exact_this_v = case catMaybes (map this_v deps) of
+ [] -> Nothing
+ [v] -> Just v
+ xs -> error $ "too many exact versions:" ++ show xs
+ --
+ earlier_v (EarlierVersionOf v _p) = Just v
+ earlier_v _ = Nothing
+
+ or_earlier_v (OrEarlierVersionOf v _p) = Just v
+ or_earlier_v _ = Nothing
+
+ later_v (LaterVersionOf v _p) = Just v
+ later_v _ = Nothing
+
+ or_later_v (OrLaterVersionOf v _p) = Just v
+ or_later_v _ = Nothing
+
+ this_v (ThisVersionOf v _p) = Just v
+ this_v _ = Nothing
+ --
+ safe_minimum xs = case catMaybes xs of
+ [] -> Nothing
+ xs' -> Just $ minimum xs'
+ safe_maximum xs = case catMaybes xs of
+ [] -> Nothing
+ xs' -> Just $ maximum xs'
+
+-- divide packages to groups (by package name), simplify groups, merge again
+simplify_deps :: [Dependency] -> [Dependency]
+simplify_deps deps = (concatMap (simplify_group.nub) $
+ groupBy cmpPkgName $
+ sortBy (comparing getPackageString) groupable)
+ ++ ungroupable
+ where (ungroupable, groupable) = partition ((==Nothing).getPackage) deps
+ --
+ cmpPkgName p1 p2 = cmpMaybe (getPackage p1) (getPackage p2)
+ cmpMaybe (Just p1) (Just p2) = p1 == p2
+ cmpMaybe _ _ = False
+ --
+getPackage :: Dependency -> Maybe Package
+getPackage (AnyVersionOf package) = Just package
+getPackage (ThisVersionOf _version package) = Just package
+getPackage (LaterVersionOf _version package) = Just package
+getPackage (EarlierVersionOf _version package) = Just package
+getPackage (OrLaterVersionOf _version package) = Just package
+getPackage (OrEarlierVersionOf _version package) = Just package
+getPackage (DependEither _dependency _Dependency) = Nothing
+getPackage (DependIfUse _useFlag _Dependency) = Nothing
+getPackage (ThisMajorOf _version package) = Just package
+--
+getPackageString :: Dependency -> Package
+getPackageString dep = maybe "" id $ getPackage dep
diff --git a/Cache.hs b/Cache.hs
new file mode 100644
index 0000000..3cc5051
--- /dev/null
+++ b/Cache.hs
@@ -0,0 +1,93 @@
+module Cache where
+
+import Action
+import CacheFile
+import Config
+import Error
+import Index
+import P2
+import Version
+import Overlays
+
+import Distribution.Text ( simpleParse )
+
+import Control.Arrow
+import Data.Char
+import Data.List
+import Network.URI (URI, uriPath)
+import Network.HTTP (Request(..), RequestMethod(GET), simpleHTTP, rspBody)
+import qualified Data.ByteString.Lazy as L
+import System.Time
+import System.FilePath
+import Control.Monad.Error(throwError)
+import Control.Monad.Writer
+import Control.Monad (unless)
+import System.Directory (doesFileExist,createDirectoryIfMissing)
+
+import qualified Data.Map as Map
+
+-- | A long time. Used in checkCacheDate
+alarmingLongTime :: TimeDiff
+alarmingLongTime = TimeDiff
+ { tdYear = 0
+ , tdMonth = 0
+ , tdDay = 7
+ , tdHour = 0
+ , tdMin = 0
+ , tdSec = 0
+ , tdPicosec = 0
+ }
+
+cacheURI :: URI -> URI
+cacheURI uri = uri {uriPath = uriPath uri </> indexFile}
+
+updateCache :: HPAction ()
+updateCache = do
+ path <- getOverlayPath
+ cfg <- getCfg
+ let cache = cacheURI $ server cfg
+ res <- (liftIO $ simpleHTTP (Request cache GET [] "")) `sayNormal` ("Fetching cache from "++show cache++"...",const "done.")
+ case res of
+ Left err -> throwError (ConnectionFailed (show cache) (show err))
+ Right resp -> liftIO $ do
+ createDirectoryIfMissing False (path </> hackportDir)
+ Prelude.writeFile (cacheFile path) (rspBody resp)
+
+readCache :: FilePath -> HPAction Index
+readCache portdir = do
+ let cachePath = cacheFile portdir
+ exists <- liftIO $ doesFileExist cachePath
+ unless exists $ do
+ info "No cache file present, attempting to update..."
+ updateCache
+ str <- liftIO $ L.readFile cachePath
+ return $ readIndex str
+
+readDefaultCache :: HPAction Index
+readDefaultCache = do
+ overlayPath <- getOverlayPath
+ readCache overlayPath
+
+indexToPortage :: Index -> Portage -> (Portage, [String])
+indexToPortage index port = second nub . runWriter $ do
+ pkgs <- forM index $ \(pkg_h_name, pkg_h_ver, pkg_desc) -> do
+ let pkg_name = map toLower pkg_h_name
+ pkg_cat <- lookupCat pkg_name
+ Just ver <- return . simpleParse $ pkg_h_ver
+ return $ Ebuild (P pkg_cat pkg_name)
+ (fromCabalVersion ver)
+ "<hackage>"
+ (Just pkg_desc)
+ return $ Map.map sort $ Map.fromListWith (++) [ (ePackage e, [e]) | e <- pkgs ]
+ where
+ catMap = Map.fromListWith (++) [ (p, [c]) | P c p <- Map.keys port ]
+ lookupCat :: String -> Writer [String] String
+ lookupCat p = do
+ case Map.lookup p catMap of
+ Nothing -> return "hackage"
+ Just [x] -> return x
+ Just xs -> do
+ let c | elem "dev-haskell" xs = "dev-haskell"
+ | otherwise = head xs
+ tell ["WARNING: Category clash for package " ++ p ++ ", defaulting to " ++ c ++ ". Other categories: " ++ unwords (delete c xs)]
+ return c
diff --git a/CacheFile.hs b/CacheFile.hs
new file mode 100644
index 0000000..4569ca3
--- /dev/null
+++ b/CacheFile.hs
@@ -0,0 +1,12 @@
+module CacheFile where
+
+import System.FilePath
+
+indexFile :: String
+indexFile = "00-index.tar.gz"
+
+hackportDir :: String
+hackportDir = ".hackport"
+
+cacheFile :: FilePath -> FilePath
+cacheFile tree = tree </> hackportDir </> indexFile
diff --git a/Config.hs b/Config.hs
new file mode 100644
index 0000000..b6f122d
--- /dev/null
+++ b/Config.hs
@@ -0,0 +1,125 @@
+module Config where
+
+import Network.URI
+import System.Console.GetOpt
+import Text.Regex
+
+data HackPortOptions
+ = OverlayPath String
+ | PortagePath String
+ | Server String
+ | TempDir String
+ | Verbosity String
+ | Help
+ | RefreshCache
+
+data OperationMode
+ = List String
+ | Merge String
+ | DiffTree DiffMode
+ | Update
+ | ShowHelp
+ | Status String
+ | MakeEbuild String
+
+data DiffMode
+ = ShowAll
+ | ShowMissing
+ | ShowAdditions
+ | ShowNewer
+ | ShowCommon
+ deriving Eq
+
+data Config = Config
+ { overlayPath ::Maybe String
+ , portagePath ::Maybe String
+ , server ::URI
+ , tmp ::String
+ , verbosity ::Verbosity
+ , refreshCache ::Bool
+ }
+
+data Verbosity
+ = Debug
+ | Normal
+ | Silent
+
+packageRegex :: Regex
+packageRegex = mkRegex "^(.*?)-([0-9].*)$"
+
+defaultConfig :: Config
+defaultConfig = Config
+ { overlayPath = Nothing
+ , portagePath = Nothing
+ , server = URI "http:" (Just $ URIAuth "" "hackage.haskell.org" "") "/packages/archive/" "" ""
+ , tmp = "/tmp"
+ , verbosity = Normal
+ , refreshCache = False
+ }
+
+hackageOptions :: [OptDescr HackPortOptions]
+hackageOptions =
+ [Option ['o'] ["overlay-path"] (ReqArg OverlayPath "PATH") "The overlay tree to merge to"
+ ,Option ['p'] ["portdir"] (ReqArg PortagePath "PATH") "The portage directory to use"
+ ,Option ['s'] ["server"] (ReqArg Server "URL") "The Hackage server to query"
+ ,Option ['t'] ["temp-dir"] (ReqArg TempDir "PATH") "A temp directory where tarballs can be stored"
+ ,Option ['v'] ["verbosity"] (ReqArg Verbosity "debug|normal|silent") "Set verbosity level (default is 'normal')"
+ ,Option ['h', '?'] ["help"] (NoArg Help) "Display this help message"
+ ,Option ['r'] ["refresh-cache"] (NoArg RefreshCache) "Refresh the hackport cache before running the command"
+ ]
+
+parseConfig :: [String] -> Either String ([HackPortOptions],OperationMode)
+parseConfig opts = let
+ (popts,args,errs) = getOpt Permute hackageOptions opts
+ mode | not (null errs) = Left $ "Error while parsing flags:\n"
+ ++ concat errs
+ | not (null [ () | Help <- popts ]) = Right ShowHelp
+ | otherwise = case args of
+ "merge":[] -> Left "Need a package's name and version to merge it.\n"
+ "merge":package:[] -> Right (Merge package)
+ "merge":_:rest -> Left ("'merge' takes 1 argument("++show ((length rest)+1)++" given).\n")
+ "list":[] -> Right (List "")
+ "list":package:[] -> Right (List package)
+ "list":rest -> Left ("'list' takes at most one argument ("++show (length rest)++" given).\n")
+ "diff":[] -> Right (DiffTree ShowAll)
+ "diff":"all":[] -> Right (DiffTree ShowAll)
+ "diff":"missing":[] -> Right (DiffTree ShowMissing)
+ "diff":"additions":[] -> Right (DiffTree ShowAdditions)
+ "diff":"newer":[] -> Right (DiffTree ShowNewer)
+ "diff":"common":[] -> Right (DiffTree ShowCommon)
+ "diff":arg:[] -> Left ("Unknown argument to diff: '" ++ arg ++ "'. Use all,missing,additions,newer or common.\n")
+ "diff":_:xs -> Left ("'diff' takes one argument("++show ((length xs)+1)++" given).\n")
+ "update":[] -> Right Update
+ "update":rest -> Left ("'update' takes zero arguments("++show (length rest)++" given).\n")
+ "status":[] -> Right (Status "")
+ "status":"toportage":[] -> Right (Status "toportage")
+ "status":xs-> Left ("invalid argument(s) to 'status': " ++ show xs)
+ "make-ebuild":[] -> Left "Need .cabal file to make ebuild."
+ "make-ebuild":package:[] -> Right (MakeEbuild package)
+ "make-ebuild":_:rest -> Left ("'make-ebuild' takes 1 argument("++show ((length rest)+1)++" given).\n")
+
+ [] -> Right ShowHelp
+ _ -> Left "Unknown opertation mode\n"
+ in case mode of
+ Left err -> Left err
+ Right m -> Right (popts,m)
+
+hackageUsage :: IO ()
+hackageUsage = putStr $ flip usageInfo hackageOptions $ unlines
+ [ "Usage:"
+ , "\t\"hackport [OPTION] MODE [MODETARGET]\""
+ , "\t\"hackport [OPTION] list [PKG]\" lists all packages or packages matching search term"
+ , "\t\"hackport [OPTION] merge PKG-VERSION\" merges a package into the portage tree"
+ , "\t\"hackport [OPTION] diff\" prints the difference between the portage-tree and the server's packages"
+ , "\t\"hackport [OPTION] update\" updates the local cache"
+ , "\t\"hackport [OPTION] status\" compares the overlay with the portage tree"
+ , "\t\"hackport [OPTION] make-ebuild\" creates standalone ebuild from given .cabal file"
+ , "Options:"
+ ]
+
+parseVerbosity :: String -> Maybe Verbosity
+parseVerbosity "debug" = Just Debug
+parseVerbosity "normal" = Just Normal
+parseVerbosity "silent" = Just Silent
+parseVerbosity _ = Nothing
+
diff --git a/Diff.hs b/Diff.hs
new file mode 100644
index 0000000..fc355ea
--- /dev/null
+++ b/Diff.hs
@@ -0,0 +1,70 @@
+module Diff
+ ( diffAction
+ ) where
+
+import qualified Data.Map as Map
+
+import Control.Monad.Trans
+import Data.Char
+
+import Action
+import Cache
+import Config (DiffMode(..))
+import P2
+import Version
+import Overlays
+
+data DiffState a
+ = OnlyLeft a
+ | OnlyRight a
+ | Both a a
+
+tabs :: String -> String
+tabs str = let len = length str in str++(if len < 3*8
+ then replicate (3*8-len) ' '
+ else "")
+
+showDiffState :: Package -> DiffState Version -> String
+showDiffState pkg st = (tabs (show pkg)) ++ " [" ++ (case st of
+ Both x y -> showVersion x ++ (case compare x y of
+ EQ -> "="
+ GT -> ">"
+ LT -> "<") ++ showVersion y
+ OnlyLeft x -> showVersion x ++ ">none"
+ OnlyRight y -> "none<"++showVersion y)++"]"
+
+
+diffAction :: DiffMode -> HPAction ()
+diffAction dm = do
+ overlayPath <- getOverlayPath
+ cache <- readCache overlayPath
+ overlayTree <- liftIO $ readPortageTree overlayPath
+ let (hackageTree, clashes) = indexToPortage cache overlayTree
+ liftIO $ mapM_ putStrLn clashes
+ diff hackageTree overlayTree dm
+
+diff :: Portage -> Portage -> DiffMode -> HPAction ()
+diff pt1 pt2 mode = do
+ let pkgs1 = Map.map (OnlyLeft . eVersion . maximum) pt1
+ let pkgs2 = Map.map (OnlyRight . eVersion . maximum) pt2
+ let union = Map.unionWith (\(OnlyLeft x) (OnlyRight y) -> Both x y) pkgs1 pkgs2
+ let showFilter st = case mode of
+ ShowAll -> True
+ ShowMissing -> case st of
+ OnlyLeft _ -> True
+ Both x y -> x > y
+ OnlyRight _ -> False
+ ShowAdditions -> case st of
+ OnlyLeft _ -> False
+ Both x y -> x < y
+ OnlyRight _ -> True
+ ShowNewer -> case st of
+ OnlyLeft _ -> False
+ Both x y -> x > y
+ OnlyRight _ -> False
+ ShowCommon -> case st of
+ OnlyLeft _ -> False
+ Both x y -> x == y
+ OnlyRight _ -> False
+ let packages = filter (showFilter . snd) (Map.assocs union)
+ mapM_ (info . uncurry showDiffState) packages
diff --git a/Error.hs b/Error.hs
new file mode 100644
index 0000000..d7e3519
--- /dev/null
+++ b/Error.hs
@@ -0,0 +1,55 @@
+{-# OPTIONS -fglasgow-exts #-}
+module Error where
+
+import Data.Typeable
+import Control.Monad.Error (Error)
+
+data HackPortError
+ = ArgumentError String
+ | ConnectionFailed String String
+ | PackageNotFound String
+ | InvalidTarballURL String String
+ | InvalidSignatureURL String String
+ | VerificationFailed String String
+ | DownloadFailed String String
+ | UnknownCompression String
+ | UnpackingFailed String Int
+ | NoCabalFound String
+ | ExtractionFailed String String Int
+ | CabalParseFailed String String
+ | BashNotFound
+ | BashError String
+ | NoOverlay
+ | MultipleOverlays [String]
+ | UnknownVerbosityLevel String
+ -- | WrongCacheVersion
+ -- | InvalidCache
+ | InvalidServer String
+ deriving (Typeable)
+
+instance Error HackPortError
+
+type HackPortResult a = Either
+
+hackPortShowError :: HackPortError -> String
+hackPortShowError err = case err of
+ ArgumentError str -> "Argument error: "++str
+ ConnectionFailed server reason -> "Connection to hackage server '"++server++"' failed: "++reason
+ PackageNotFound pkg -> "Package '"++ pkg ++"' not found on server."
+ InvalidTarballURL url reason -> "Error while downloading tarball '"++url++"': "++reason
+ InvalidSignatureURL url reason -> "Error while downloading signature '"++url++"': "++reason
+ VerificationFailed file signature -> "Error while checking signature('"++signature++"') of '"++file++"'"
+ DownloadFailed url reason -> "Error while downloading '"++url++"': "++reason
+ UnknownCompression tarball -> "Couldn't guess compression type of '"++tarball++"'"
+ UnpackingFailed tarball code -> "Unpacking '"++tarball++"' failed with exit code '"++show code++"'"
+ NoCabalFound tarball -> "Tarball '"++tarball++"' doesn't contain a cabal file"
+ ExtractionFailed tarball file code -> "Extracting '"++file++"' from '"++tarball++"' failed with '"++show code++"'"
+ CabalParseFailed file reason -> "Error while parsing cabal file '"++file++"': "++reason
+ BashNotFound -> "The 'bash' executable was not found. It is required to figure out your portage-overlay. If you don't want to install bash, use '-p path-to-overlay'"
+ BashError str -> "Error while guessing your portage-overlay. Either set PORTDIR_OVERLAY in /etc/make.conf or use '-p path-to-overlay'.\nThe error was: \""++str++"\""
+ MultipleOverlays overlays -> "You have the following overlays available: '"++unwords overlays++"'. Please choose one by using '-p path-to-overlay'"
+ NoOverlay -> "You don't have PORTDIR_OVERLAY set in '/etc/make.conf'. Please set it or use '-p path-to-overlay'"
+ UnknownVerbosityLevel str -> "The verbosity level '"++str++"' is invalid. Please use debug,normal or silent"
+ InvalidServer srv -> "Invalid server address, could not parse: " ++ srv
+ --WrongCacheVersion -> "The version of the cache is too old. Please update the cache using 'hackport update'"
+ --InvalidCache -> "Could not read the cache. Please ensure that it's up to date using 'hackport update'"
diff --git a/Fetch.hs b/Fetch.hs
new file mode 100644
index 0000000..349d4e3
--- /dev/null
+++ b/Fetch.hs
@@ -0,0 +1,75 @@
+module Fetch(downloadTarball,downloadFileVerify) where
+
+import Prelude hiding (catch)
+
+import Network.HTTP (ConnError(..),Request(..),simpleHTTP
+ ,Response(..),RequestMethod(..))
+import Network.URI (URI,uriPath,parseURI)
+import Text.Regex (Regex,mkRegex,matchRegex)
+import System.GPG
+import Control.Monad.Error
+import System.Directory
+import System.FilePath
+import Data.Typeable
+
+import Error
+import Action
+
+filenameRegex :: Regex
+filenameRegex = mkRegex "^.*?/([^/]*?)"
+
+uriToFileName :: URI -> Maybe FilePath
+uriToFileName uri = maybe Nothing (\x->Just (head x)) (matchRegex filenameRegex (uriPath uri))
+
+downloadURI :: FilePath -- ^ a directory to store the file
+ -> URI -- ^ the url
+ -> HPAction FilePath -- ^ the path of the downloaded file
+downloadURI path uri = do
+ fileName <- maybe (throwError $ InvalidTarballURL (show uri) "URL doesn't contain a filename") return (uriToFileName uri)
+ httpResult <- liftIO $ simpleHTTP request
+ Response {rspCode=code,rspBody=body,rspReason=reason} <- either (\x->throwError $ DownloadFailed (show uri) "Connection failed") return httpResult
+ if code==(2,0,0) then (do
+ let writePath=path </> fileName
+ liftIO $ writeFile writePath body
+ return writePath) else throwError $ DownloadFailed (show uri) ("Code "++show code++":"++reason)
+ where
+ request = Request
+ {rqURI=uri
+ ,rqMethod=GET
+ ,rqHeaders=[]
+ ,rqBody=""}
+
+
+downloadFileVerify ::
+ FilePath -> -- ^ the directory to store the files
+ String -> -- ^ the url of the tarball
+ String -> -- ^ the url of the signature
+ HPAction (FilePath,FilePath) -- ^ the tarballs and signatures path
+downloadFileVerify path url sigurl = do
+ tarballPath <- downloadTarball path url
+ sigPath <- downloadSig path sigurl `catchError` (\x->liftIO (removeFile tarballPath) >> throwError x)
+ verified <- liftIO $ verifyFile stdOptions tarballPath sigPath
+ if verified then return (tarballPath,sigPath) else (do
+ liftIO $ removeFile tarballPath
+ liftIO $ removeFile sigPath
+ throwError $ VerificationFailed url sigurl)
+
+downloadTarball ::
+ FilePath ->
+ String ->
+ HPAction FilePath
+downloadTarball dir url = download dir url InvalidTarballURL
+
+downloadSig ::
+ FilePath ->
+ String ->
+ HPAction FilePath
+downloadSig dir url = download dir url InvalidSignatureURL
+
+download :: FilePath -- ^ the folder to store the file in
+ -> String -- ^ the url
+ -> (String -> String -> HackPortError) -- ^ a function to construct an error
+ -> HPAction FilePath -- ^ the resulting file's path
+download dir url errFunc = do
+ parsedURL <- maybe (throwError $ errFunc url "Parsing failed") return (parseURI url)
+ downloadURI dir parsedURL
diff --git a/GenerateEbuild.hs b/GenerateEbuild.hs
new file mode 100644
index 0000000..65d35b0
--- /dev/null
+++ b/GenerateEbuild.hs
@@ -0,0 +1,60 @@
+module GenerateEbuild where
+
+import Action
+import Cabal2Ebuild
+import Config
+
+import Prelude hiding (catch)
+import Control.Monad.Error
+import Distribution.Package
+import Data.Version (showVersion)
+import Network.URI
+import System.Directory
+import System.FilePath
+
+mergeEbuild :: FilePath -> String -> EBuild -> IO ()
+mergeEbuild target category ebuild = do
+ let edir = target </> category </> name ebuild
+ let epath = edir </> name ebuild ++"-"++ version ebuild <.> "ebuild"
+ createDirectoryIfMissing True edir
+ writeFile epath (showEBuild ebuild)
+
+fixSrc :: PackageIdentifier -> EBuild -> HPAction EBuild
+fixSrc p ebuild = do
+ cfg <- getCfg
+ return $ ebuild {
+ src_uri = show $ (server cfg) {
+ uriPath = (uriPath (server cfg))
+ </> pkgName p
+ </> showVersion (pkgVersion p)
+ </> pkgName p ++ "-" ++
+ showVersion (pkgVersion p)
+ <.> "tar.gz"
+ }
+ }
+
+{-hackage2ebuild ::
+ (PackageIdentifier,String,String) -> -- ^ the package
+ HPAction EBuild
+hackage2ebuild (pkg,tarball,sig) = do
+ cfg <- getCfg
+ tarballPath <- (if verify cfg then (do
+ (tarPath,sigPath) <- downloadFileVerify (tmp cfg) tarball sig
+ liftIO $ removeFile sigPath
+ return tarPath) else (downloadTarball (tmp cfg) tarball))
+ `sayNormal` ("Downloading tarball from '"++tarball++"' to '"++(tmp cfg)++"'... ",const "done.")
+ tarType <- maybe (liftIO (removeFile tarballPath) >> throwError (UnknownCompression tarball)) return (tarballGetType tarballPath)
+ `sayDebug` ("Guessing compression type of tarball... ",const "done.")
+ filesInTarball <- tarballGetFiles (tarCommand cfg) tarballPath tarType
+ `sayDebug` ("Getting list of files from tarball... ",const "done.")
+ `catchError` (\x->liftIO (removeFile tarballPath) >> throwError x)
+ (cabalDir,cabalName) <- maybe (throwError $ NoCabalFound tarball) return (findCabal filesInTarball)
+ `sayDebug` ("Trying to find cabal file... ",\(dir,name)->"Found cabal file '"++name++"' in '"++dir++"'.")
+ cabalFile <- tarballExtractFile tarballPath tarType (cabalDir++"/"++cabalName)
+ `sayDebug` ("Extracting cabal file... ",const "done.")
+ packageDescription <- case parseDescription cabalFile of
+ ParseFailed err -> throwError $ CabalParseFailed cabalName (showError err)
+ ParseOk descr -> return descr
+ `sayDebug` ("Parsing '"++cabalName++"'... ",const "done.")
+ let ebuild=cabal2ebuild (packageDescription{pkgUrl=tarball}) --we don't trust the cabal file as we just successfully downloaded the tarbal somewhere
+ return ebuild {cabalPath=Just cabalDir}-}
diff --git a/Index.hs b/Index.hs
new file mode 100644
index 0000000..065f3c9
--- /dev/null
+++ b/Index.hs
@@ -0,0 +1,45 @@
+module Index where
+
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Data.Version (Version,parseVersion)
+import Codec.Compression.GZip(decompress)
+import Data.ByteString.Lazy.Char8(ByteString,unpack)
+import Codec.Archive.Tar
+import Distribution.PackageDescription
+import Distribution.Package
+import System.FilePath.Posix
+import MaybeRead (readPMaybe)
+
+type Index = [(String,String,GenericPackageDescription)]
+type IndexMap = Map.Map String (Set.Set Version)
+
+readIndex :: ByteString -> Index
+readIndex str = do
+ let unziped = decompress str
+ untared = readTarArchive unziped
+ entr <- archiveEntries untared
+ case splitDirectories (tarFileName (entryHeader entr)) of
+ [".",pkgname,vers,file] -> do
+ let descr = case parsePackageDescription (unpack (entryData entr)) of
+ ParseOk _ pkg_desc -> pkg_desc
+ _ -> error $ "Couldn't read cabal file "++show file
+ return (pkgname,vers,descr)
+ _ -> fail "doesn't look like the proper path"
+
+filterIndexByPV :: (String -> String -> Bool) -> Index -> Index
+filterIndexByPV cond index = [ x | x@(p,v,_d) <- index, cond p v]
+
+indexMapFromList :: [PackageIdentifier] -> IndexMap
+indexMapFromList pids = Map.unionsWith Set.union $
+ [ Map.singleton name (Set.singleton vers)
+ | (PackageIdentifier {pkgName = name,pkgVersion = vers}) <- pids ]
+
+indexToPackageIdentifier :: Index -> [PackageIdentifier]
+indexToPackageIdentifier index = do
+ (name,vers_str,_) <- index
+ Just vers <- return $ readPMaybe parseVersion vers_str
+ return $ PackageIdentifier {pkgName = name,pkgVersion = vers}
+
+bestVersions :: IndexMap -> Map.Map String Version
+bestVersions = Map.map Set.findMax
diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..19d7929
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,136 @@
+module Main where
+
+import Control.Monad.Error
+import Data.Char
+import Data.Maybe
+import Data.List
+import Data.Version
+import Distribution.Package
+import Distribution.Compiler (CompilerId(..), CompilerFlavor(GHC))
+import Distribution.PackageDescription.Configuration
+ ( finalizePackageDescription, flattenPackageDescription )
+import Distribution.Simple.PackageIndex (PackageIndex)
+import Distribution.Text (display)
+import System.IO
+import Distribution.System (buildOS, buildArch)
+import qualified Data.Map as Map
+import Text.ParserCombinators.Parsec
+
+import Action
+import qualified Cabal2Ebuild as E
+import Cache
+import Config
+import Diff
+import Error
+import GenerateEbuild
+import Index
+import Status
+import Package
+import Overlays
+import P2
+
+import qualified Distribution.PackageDescription as Cabal
+import Distribution.Verbosity (normal)
+import Cabal2Ebuild
+
+list :: String -> HPAction ()
+list name = do
+ index <- readCache =<< getOverlayPath
+ let index' | null name = index
+ | otherwise = filterIndexByPV matchSubstringCaseInsensitive index
+ pkgs = [ pkg ++ "-" ++ ver | (pkg,ver,_) <- index']
+ if null pkgs
+ then throwError (PackageNotFound name)
+ else liftIO . putStr . unlines . sort $ pkgs
+ where
+ matchSubstringCaseInsensitive pName _pVver =
+ map toLower name `isInfixOf` map toLower pName
+
+merge :: String -> HPAction ()
+merge pstr = do
+ (m_category, pname, m_version) <- case parsePVC of
+ Right v -> return v
+ Left err -> throwError (ArgumentError ("Could not parse [category/]package[-version]: " ++ show err))
+ portdir <- getOverlayPath
+ overlay <- liftIO $ readPortageTree portdir
+ cache <- readCache portdir
+ let (indexTree,clashes) = indexToPortage cache overlay
+ mapM_ (liftIO . putStrLn) clashes
+ whisper $ "Searching for: "++ pstr
+ let pkgs =
+ Map.elems
+ . Map.filterWithKey (\(P _ pname') _ -> map toLower pname' == map toLower pname)
+ $ indexTree
+ return ()
+ pkg <- case pkgs of
+ [] -> throwError (PackageNotFound pname)
+ [xs] -> case m_version of
+ Nothing -> return (maximum xs) -- highest version
+ Just v -> do
+ let ebuilds = filter (\e -> eVersion e == v) xs
+ case ebuilds of
+ [] -> throwError (PackageNotFound (pname ++ '-':show v))
+ [e] -> return e
+ _ -> fail "the impossible happened"
+ _ -> fail "the impossible happened"
+ category <- do
+ case m_category of
+ Just cat -> return cat
+ Nothing -> do
+ case pCategory (ePackage pkg) of
+ "hackage" -> return "dev-haskell"
+ c -> return c
+ let Just genericDesc = ePkgDesc pkg
+ Right (desc, _) = finalizePackageDescription []
+ (Nothing :: Maybe (PackageIndex PackageIdentifier))
+ buildOS buildArch
+ (CompilerId GHC (Version [6,8,2] []))
+ [] genericDesc
+ ebuild <- fixSrc (packageId desc) (E.cabal2ebuild desc)
+ liftIO $ do
+ putStrLn $ "Merging " ++ category ++ '/': pname ++ "-" ++ display (pkgVersion (packageId desc))
+ putStrLn $ "Destination: " ++ portdir
+ mergeEbuild portdir category ebuild
+ where
+ parsePVC = parse readPVC "" pstr
+ readPVC = do
+ mc <- option Nothing $ try $ do
+ c <- readCat
+ char '/'
+ return (Just c)
+ (p, mv) <- readPkgAndVer
+ eof
+ return (mc, p, mv)
+
+makeEbuild :: String -> HPAction ()
+makeEbuild cabalFileName = liftIO $ do
+ pkg <- Cabal.readPackageDescription normal cabalFileName
+ let ebuild = cabal2ebuild (flattenPackageDescription pkg)
+ let ebuildFileName = name ebuild ++ "-" ++ version ebuild ++ ".ebuild"
+ writeFile ebuildFileName (showEBuild ebuild)
+
+hpmain :: HPAction ()
+hpmain = do
+ mode <- loadConfig
+ requestedUpdate <- fmap refreshCache getCfg
+ when requestedUpdate $
+ case mode of
+ Update -> return ()
+ _ -> updateCache
+ case mode of
+ ShowHelp -> liftIO hackageUsage
+ List pkg -> list pkg
+ Merge pkg -> merge pkg
+ DiffTree dtmode -> diffAction dtmode
+ Update -> updateCache
+ Status action -> statusAction action
+ MakeEbuild cabalFileName -> makeEbuild cabalFileName
+
+main :: IO ()
+main = do
+ res <- performHPAction hpmain
+ case res of
+ Right _ -> return ()
+ Left err -> do
+ hPutStrLn stderr "An error occurred. To get more info run with --verbosity=debug"
+ hPutStrLn stderr (hackPortShowError err)
diff --git a/MaybeRead.hs b/MaybeRead.hs
new file mode 100644
index 0000000..cf739fd
--- /dev/null
+++ b/MaybeRead.hs
@@ -0,0 +1,14 @@
+module MaybeRead where
+
+import Data.List(find)
+import Text.Read
+import Text.ParserCombinators.ReadP
+
+readMaybe :: Read a => String -> Maybe a
+readMaybe = readsMaybe reads
+
+readsMaybe :: ReadS a -> String -> Maybe a
+readsMaybe func str = maybe Nothing (\x->Just (fst x)) (find (null.snd) (func str))
+
+readPMaybe :: ReadP a -> String -> Maybe a
+readPMaybe = readsMaybe.readP_to_S
diff --git a/Overlays.hs b/Overlays.hs
new file mode 100644
index 0000000..d18ab80
--- /dev/null
+++ b/Overlays.hs
@@ -0,0 +1,59 @@
+module Overlays where
+
+import Control.Monad.Error
+import System.Directory
+import Data.Maybe
+import Data.List (nub)
+
+import Bash
+import Action
+import Config
+import Error
+import CacheFile
+
+getOverlayPath :: HPAction String
+getOverlayPath = do
+ cfg <- getCfg
+ case overlayPath cfg of
+ Nothing -> do
+ tree <- getOverlay `sayDebug` ("Guessing overlay...\n",\tree->"Found '"++tree++"'")
+ setOverlayPath $ Just tree
+ return tree
+ Just tree -> return tree
+
+getOverlay :: HPAction String
+getOverlay = do
+ overlays <- getOverlays
+ case overlays of
+ [] -> throwError NoOverlay
+ [x] -> return x
+ mul -> search mul
+ where
+ search :: [String] -> HPAction String
+ search mul = do
+ let loop [] = throwError $ MultipleOverlays mul
+ loop (x:xs) = (do
+ found <- liftIO (doesFileExist (cacheFile x))
+ `sayDebug` ("Checking '"++x++"'...\n",\res->if res then "found.\n" else "not found.")
+ if found
+ then return x
+ else loop xs)
+ whisper "There are several overlays in your /etc/make.conf"
+ mapM (\x-> whisper (" * " ++x)) mul
+ whisper "Looking for one with a HackPort cache..."
+ overlay <- loop mul
+ whisper ("I choose " ++ overlay)
+ whisper "Override my decision with hackport -p /my/overlay"
+ return overlay
+
+portageOverlays :: HPAction [String]
+portageOverlays = runBash "source /etc/make.conf;echo -n $PORTDIR_OVERLAY" >>= (return.words)
+
+paludisOverlays :: HPAction [String]
+paludisOverlays = return []
+
+getOverlays :: HPAction [String]
+getOverlays = do
+ portage <- portageOverlays
+ paludis <- paludisOverlays
+ return (nub (portage ++ paludis))
diff --git a/P2.hs b/P2.hs
new file mode 100644
index 0000000..6df3902
--- /dev/null
+++ b/P2.hs
@@ -0,0 +1,106 @@
+module P2 where
+
+-- Module that respect categories.
+-- Possibly to replace Portage.hs when the rest of the project has been
+-- ported to this style.
+
+import BlingBling
+
+import Control.Arrow
+import Control.Monad
+
+import qualified Distribution.PackageDescription as Cabal
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe
+import qualified Data.List as List
+
+import System.Directory
+import System.IO
+import System.FilePath
+
+import Text.Regex
+
+import Version
+
+type Portage = PortageMap [Ebuild]
+type PortageMap a = Map Package a
+
+data Ebuild = Ebuild {
+ ePackage :: Package,
+ eVersion :: Version,
+ eFilePath :: FilePath,
+ ePkgDesc :: Maybe Cabal.GenericPackageDescription }
+ deriving (Show)
+
+data Package = P { pCategory :: String, pPackage :: String }
+ deriving (Eq, Ord)
+
+instance Show Package where
+ show (P c p) = c ++ '/':p
+
+instance Eq Ebuild where
+ e1 == e2 = (ePackage e1, eVersion e1) == (ePackage e2, eVersion e2)
+
+instance Ord Ebuild where
+ compare e1 e2 = compare (ePackage e1, eVersion e1)
+ (ePackage e2, eVersion e2)
+
+lookupEbuildWith :: Portage -> Package -> (Ebuild -> Bool) -> Maybe Ebuild
+lookupEbuildWith portage package comp = do
+ es <- Map.lookup package portage
+ List.find comp es
+
+getPackageList :: FilePath -> IO [Package]
+getPackageList portdir = do
+ categories <- getDirectories portdir
+ packages <- fmap concat $ forMbling categories $ \c -> do
+ pkg <- getDirectories (portdir </> c)
+ return (map (P c) pkg)
+ return packages
+
+readPortagePackages :: FilePath -> [Package] -> IO Portage
+readPortagePackages portdir packages0 = do
+ packages <- filterM (doesDirectoryExist . (portdir </>) . show) packages0
+ ebuild_map0 <- forM packages $ \package -> do
+ ebuilds <- getPackageVersions package
+ return (package, List.sort ebuilds)
+ let ebuild_map = filter (not . null . snd) ebuild_map0
+ return $ Map.fromList ebuild_map
+
+ where
+ getPackageVersions :: Package -> IO [Ebuild]
+ getPackageVersions (P category package) = do
+ files <- getDirectoryContents (portdir </> category </> package)
+ let ebuilds = [ (v, portdir </> category </> package </> fn)
+ | (Just v, fn) <- map ((filterVersion package) &&& id) files ]
+ return (map (uncurry (\v f -> Ebuild (P category package) v f Nothing)) ebuilds)
+
+ filterVersion :: String -> String -> Maybe Version
+ filterVersion p fn = do
+ [vstring] <- matchRegex (ebuildVersionRegex p) fn
+ case (parseVersion vstring) of
+ Left e -> fail (show e)
+ Right v -> return v
+
+ ebuildVersionRegex name = mkRegex ("^"++name++"-(.*)\\.ebuild$")
+
+readPortageTree :: FilePath -> IO Portage
+readPortageTree portdir = do
+ packages <- getPackageList portdir
+ readPortagePackages portdir packages
+
+getDirectories :: FilePath -> IO [String]
+getDirectories fp = do
+ files <- fmap (filter (`notElem` [".", ".."])) $ getDirectoryContents fp
+ filterM (doesDirectoryExist . (fp </>)) files
+
+printPortage :: Portage -> IO ()
+printPortage port =
+ forM_ (Map.toAscList port) $ \(package, ebuilds) -> do
+ let (P c p) = package
+ putStr $ c ++ '/':p
+ putStr " "
+ forM_ ebuilds (\e -> putStr (show $ eVersion e) >> putChar ' ')
+ putStrLn ""
diff --git a/Package.hs b/Package.hs
new file mode 100644
index 0000000..5048cec
--- /dev/null
+++ b/Package.hs
@@ -0,0 +1,76 @@
+{-|
+ Maintainer : Andres Loeh <kosmikus@gentoo.org>
+ Stability : provisional
+ Portability : haskell98
+
+ Parser for categories and packages.
+
+ Shamelessly borrowed from exi, somewhat modified
+-}
+
+module Package
+ where
+
+import Control.Monad
+import Text.ParserCombinators.Parsec
+
+import Version
+
+type Category = String
+type Package = String
+type Slot = String
+
+getPV :: String -> (Category, Package, Version)
+getPV xs = case parsePV xs of
+ Left e ->
+ error $ "getPV: cat/pkg-ver parse error '" ++ xs ++ "'\n" ++ show e
+ Right x -> x
+
+getP :: String -> (Category, Package)
+getP xs = case parseP xs of
+ Left e ->
+ error $ "getCatPkg: cat/pkg parse error '" ++ xs ++ "'\n" ++ show e
+ Right x -> x
+
+parsePV :: String -> Either ParseError (Category, Package, Version)
+parsePV = parse (readPV >>= \x -> eof >> return x) "<cat/pkg-ver>"
+
+readPV :: GenParser Char st (Category, Package, Version)
+readPV = do cat <- readCat
+ char '/'
+ (pkg,mver) <- readPkgAndVer
+ case mver of
+ Nothing -> fail "readPV: version expected"
+ Just ver -> return (cat, pkg, ver)
+
+parseP :: String -> Either ParseError (Category, Package)
+parseP = parse (readP >>= \x -> eof >> return x) "<cat/pkg>"
+
+readP :: GenParser Char st (Category, Package)
+readP = do cat <- readCat
+ char '/'
+ (pkg,mver) <- readPkgAndVer
+ case mver of
+ Nothing -> return (cat, pkg)
+ Just _ -> error "readCatPkg: unexpected version"
+
+readCat :: CharParser st Category
+readPkgAndVer :: CharParser st (Package,Maybe Version)
+
+readCat = many1 (letter <|> digit <|> oneOf "_-")
+readPkgAndVer = do pre <- many1 (letter <|> digit <|> oneOf "_+")
+ (p,v) <- option ("",Nothing)
+ (do char '-'
+ liftM (\v -> ("",Just v)) readVerOrFail
+ <|> liftM (\(p,v) -> ('-':p,v)) readPkgAndVer
+ )
+ return (pre ++ p,v)
+
+readVerOrFail :: CharParser st Version
+readVerOrFail = try $
+ do ver <- many1 (letter <|> digit <|> oneOf "_+.-")
+ case parseVersion ver of
+ Left _ ->
+ fail $ "version parse error"
+ Right x -> return x
+
diff --git a/Portage.hs b/Portage.hs
new file mode 100644
index 0000000..4b870b6
--- /dev/null
+++ b/Portage.hs
@@ -0,0 +1,20 @@
+module Portage where
+
+import System.Directory
+import Text.Regex
+import Data.Maybe
+
+ebuildVersionRegex :: String -> Regex
+ebuildVersionRegex name = mkRegex ("^"++name++"-(.*)\\.ebuild$")
+
+filterPackages :: String -> [String] -> IO [String]
+filterPackages _ [] = return []
+filterPackages base (x:xs) = do
+ ak <- case x of
+ "." -> return Nothing
+ ".." -> return Nothing
+ dir -> do
+ exists <- doesDirectoryExist (base++dir)
+ return (if exists then Just dir else Nothing)
+ rest <- filterPackages base xs
+ return (maybe rest (:rest) ak)
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..36c3aa9
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,7 @@
+#!/usr/bin/runhaskell
+module Main where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
diff --git a/Status.hs b/Status.hs
new file mode 100644
index 0000000..aca18c4
--- /dev/null
+++ b/Status.hs
@@ -0,0 +1,159 @@
+module Status
+ ( FileStatus(..)
+ , fromStatus
+ , status
+ , statusAction
+ ) where
+
+import Action
+import AnsiColor
+import Bash
+import P2
+import Utils
+import Overlays
+
+import Control.Monad.State
+
+import qualified Data.List as List
+
+import qualified Data.ByteString.Lazy.Char8 as L
+
+import Data.Char
+import qualified Data.Map as Map
+import Data.Map as Map (Map)
+
+import qualified Data.Traversable as T
+
+data FileStatus a
+ = Same a
+ | Differs a a
+ | OverlayOnly a
+ | PortageOnly a
+ deriving (Show,Eq)
+
+instance Ord a => Ord (FileStatus a) where
+ compare x y = compare (fromStatus x) (fromStatus y)
+
+instance Functor FileStatus where
+ fmap f st =
+ case st of
+ Same a -> Same (f a)
+ Differs a b -> Differs (f a) (f b)
+ OverlayOnly a -> OverlayOnly (f a)
+ PortageOnly a -> PortageOnly (f a)
+
+fromStatus :: FileStatus a -> a
+fromStatus fs =
+ case fs of
+ Same a -> a
+ Differs a _ -> a -- second status is lost
+ OverlayOnly a -> a
+ PortageOnly a -> a
+
+status :: HPAction (Map Package [FileStatus Ebuild])
+status = do
+ portdir <- getPortdir
+ overlayPath <- getOverlayPath
+ overlay <- liftIO $ readPortageTree overlayPath
+ portage <- liftIO $ readPortagePackages portdir (Map.keys overlay)
+ let (over, both, port) = portageDiff overlay portage
+
+ both' <- T.forM both $ mapM $ \e -> liftIO $ do
+ -- can't fail, we know the ebuild exists in both portagedirs
+ -- also, one of them is already bound to 'e'
+ let (Just e1) = lookupEbuildWith portage (ePackage e) (comparing eVersion e)
+ (Just e2) = lookupEbuildWith overlay (ePackage e) (comparing eVersion e)
+ eq <- equals (eFilePath e1) (eFilePath e2)
+ return $ if eq
+ then Same e
+ else Differs e1 e2
+
+ let meld = Map.unionsWith (\a b -> List.sort (a++b))
+ [ Map.map (map PortageOnly) port
+ , both'
+ , Map.map (map OverlayOnly) over
+ ]
+ return meld
+
+statusAction :: String -> HPAction ()
+statusAction action = do
+ let pkgFilter =
+ case action of
+ "" -> id
+ "toportage" -> toPortageFilter
+ pkgs <- status
+ statusPrinter (pkgFilter pkgs)
+
+-- |Only return packages that seems interesting to sync to portage;
+--
+-- * Ebuild differs, or
+-- * Newer version in overlay than in portage
+toPortageFilter :: Map Package [FileStatus Ebuild] -> Map Package [FileStatus Ebuild]
+toPortageFilter = Map.mapMaybe $ \ sts ->
+ let inPortage = flip filter sts $ \st ->
+ case st of
+ OverlayOnly _ -> False
+ _ -> True
+ latestPortageVersion = List.maximum $ map (eVersion . fromStatus) inPortage
+ interestingPackages = flip filter sts $ \st ->
+ case st of
+ Differs _ _ -> True
+ _ | eVersion (fromStatus st) > latestPortageVersion -> True
+ | otherwise -> False
+ in if not (null inPortage) && not (null interestingPackages)
+ then Just sts
+ else Nothing
+
+statusPrinter :: Map Package [FileStatus Ebuild] -> HPAction ()
+statusPrinter packages = do
+ liftIO $ putStrLn $ toColor (Same "Green") ++ ": package in portage and overlay are the same"
+ liftIO $ putStrLn $ toColor (Differs "Yellow" "") ++ ": package in portage and overlay differs"
+ liftIO $ putStrLn $ toColor (OverlayOnly "Red") ++ ": package only exist in the overlay"
+ liftIO $ putStrLn $ toColor (PortageOnly "Magenta") ++ ": package only exist in the portage tree"
+ forM_ (Map.toAscList packages) $ \(pkg, ebuilds) -> liftIO $ do
+ let (P c p) = pkg
+ putStr $ c ++ '/' : bold p
+ putStr " "
+ forM_ ebuilds $ \e -> do
+ putStr $ toColor (fmap (show . eVersion) e)
+ putChar ' '
+ putStrLn ""
+
+toColor :: FileStatus String -> String
+toColor st = inColor c False Default (fromStatus st)
+ where
+ c = case st of
+ (Same _) -> Green
+ (Differs _ _) -> Yellow
+ (OverlayOnly _) -> Red
+ (PortageOnly _) -> Magenta
+
+portageDiff :: Portage -> Portage -> (Portage, Portage, Portage)
+portageDiff p1 p2 = (in1, ins, in2)
+ where ins = Map.filter (not . null) $
+ Map.intersectionWith (List.intersectBy $ comparing eVersion) p1 p2
+ in1 = difference p1 p2
+ in2 = difference p2 p1
+ difference x y = Map.filter (not . null) $
+ Map.differenceWith (\xs ys ->
+ let lst = foldr (List.deleteBy (comparing eVersion)) xs ys in
+ if null lst
+ then Nothing
+ else Just lst
+ ) x y
+
+-- | Compares two ebuilds, returns True if they are equal.
+-- Disregards comments.
+equals :: FilePath -> FilePath -> IO Bool
+equals fp1 fp2 = do
+ f1 <- L.readFile fp1
+ f2 <- L.readFile fp2
+ return (equal' f1 f2)
+
+equal' :: L.ByteString -> L.ByteString -> Bool
+equal' = comparing essence
+ where
+ essence = filter (not . isEmpty) . filter (not . isComment) . L.lines
+ isComment = L.isPrefixOf (L.pack "#") . L.dropWhile isSpace
+ isEmpty = L.null . L.dropWhile isSpace
+
diff --git a/Utils.hs b/Utils.hs
new file mode 100644
index 0000000..bee72e2
--- /dev/null
+++ b/Utils.hs
@@ -0,0 +1,7 @@
+module Utils where
+
+comparing :: (Eq b) => (a -> b) -> a -> a -> Bool
+comparing f x y = f x == f y
+
+compareWith :: (Ord b) => (a -> b) -> a -> a -> Ordering
+compareWith f x y = compare (f x) (f y)
diff --git a/Version.hs b/Version.hs
new file mode 100644
index 0000000..4a7853a
--- /dev/null
+++ b/Version.hs
@@ -0,0 +1,122 @@
+{-|
+ Maintainer : Andres Loeh <kosmikus@gentoo.org>
+ Stability : provisional
+ Portability : haskell98
+
+ Version parser, according to Portage spec.
+
+ Shamelessly borrowed from exi, somewhat modified
+
+-}
+
+module Version
+ (
+ Version(),
+ Suffix(..),
+ fromCabalVersion,
+ showVersion,
+ showSuffix,
+ readVersion,
+ parseVersion,
+ getVersion,
+ showRevPR
+ ) where
+
+import qualified Distribution.Version as Cabal
+import Control.Monad
+import Data.List
+import Data.Maybe
+import Text.ParserCombinators.Parsec
+
+data Version = Version [Int] -- [1,42,3] ~= 1.42.3
+ (Maybe Char) -- optional letter
+ [Suffix]
+ Int -- revision, 0 means none
+ deriving (Eq, Ord)
+
+data Suffix = Alpha Int | Beta Int | Pre Int | RC Int | P_ Int
+ deriving (Eq,Ord)
+
+instance Show Version where
+ show = showVersion
+
+instance Show Suffix where
+ show = showSuffix
+
+showVersion :: Version -> String
+showVersion (Version ver c suf rev)
+ = showver ++ showc ++ concatMap showSuffix suf ++ showRev rev
+ where showver = concat . intersperse "." . map show $ ver
+ showc = maybe "" (:[]) c
+
+showSuffix :: Suffix -> String
+showSuffix (Alpha n) = "_alpha" ++ showPos n
+showSuffix (Beta n) = "_beta" ++ showPos n
+showSuffix (Pre n) = "_pre" ++ showPos n
+showSuffix (RC n) = "_rc" ++ showPos n
+showSuffix (P_ n) = "_p" ++ showPos n
+
+showPos :: Int -> String
+showPos 0 = ""
+showPos n = show n
+
+showRev :: Int -> String
+showRev 0 = ""
+showRev n = "-r" ++ show n
+
+showRevPR :: Int -> String
+showRevPR n = "r" ++ show n
+
+fromCabalVersion :: Cabal.Version -> Version
+fromCabalVersion (Cabal.Version nums _tags) =
+ Version nums Nothing [] 0
+
+-- | Function to call if you want to parse a version number.
+getVersion :: String -> Version
+getVersion ver = case parseVersion ver of
+ Left _ ->
+ error $ "getVersion: version parse error '" ++ ver ++ "'"
+ Right x -> x
+
+parseVersion :: String -> Either ParseError Version
+parseVersion = parse (readVersion >>= \x -> eof >> return x) "<version number>"
+
+readVersion :: CharParser st Version
+readVersion = do (ver, _verr) <- readVer
+ (c, _cr ) <- readC
+ (suf, _sufr) <- readSufs
+ (rev, _revr) <- readRev
+ return (Version ver c suf rev)
+
+readVer :: CharParser st ([Int], String)
+readNum :: CharParser st (Int, String)
+readC :: CharParser st (Maybe Char, String)
+readSuf :: CharParser st (Suffix, String)
+readSufType :: CharParser st (Int -> Suffix, String)
+readSufs :: CharParser st ([Suffix], String)
+readRev :: CharParser st (Int, String)
+
+readVer = liftM ((\(x,y) -> (x, concat . intersperse "." $ y)) . unzip) (sepBy1 readNum (char '.'))
+readNum = do ds <- many1 digit
+ case read ds of
+ n -> return (n,ds)
+readC = option (Nothing, "") (liftM (\x -> (Just x, [x])) letter)
+readSuf = do char '_'
+ (f,sr) <- readSufType
+ (n,nr) <- option (0, "") readNum
+ return (f n,"_" ++ sr ++ nr)
+
+readSufType = choice [
+ liftM (\x -> (Alpha, x)) (try $ string "alpha"),
+ liftM (\x -> (Beta, x)) (try $ string "beta" ),
+ liftM (\x -> (Pre, x)) (try $ string "pre" ),
+ liftM (\x -> (RC, x)) (try $ string "rc" ),
+ liftM (\x -> (P_, x)) (try $ string "p" )
+ ]
+
+readSufs = fmap ( ( \ (x,y) -> (x, concat y) ) . unzip ) (many readSuf)
+
+readRev = option (0, "") ( do rr <- string "-r"
+ (n,nr) <- readNum
+ return (n,rr ++ nr)
+ )
diff --git a/hackport.cabal b/hackport.cabal
new file mode 100644
index 0000000..dc42de7
--- /dev/null
+++ b/hackport.cabal
@@ -0,0 +1,64 @@
+Name: hackport
+Version: 0.2.1
+License: GPL
+Author: Henning G√ľnther, Duncan Coutts, Lennart Kolmodin
+Maintainer: Gentoo Haskell team <haskell@gentoo.org>
+Category: Distribution
+Synopsis: Hackage and Portage integration tool
+Description: A command line tool to manage an overlay of Gentoo ebuilds
+ that are generated from a hackage repo of Cabal packages.
+Build-Type: Simple
+Cabal-Version: >=1.2
+
+Flag split-base
+
+Executable hackport
+ Main-Is: Main.hs
+ Build-Depends:
+ base >= 2.0,
+ filepath,
+ parsec,
+ mtl,
+ network,
+ regex-compat,
+ Cabal >= 1.4 && < 1.5,
+ HTTP >= 3000 && < 3002,
+ zlib,
+ tar
+
+ if flag(split-base)
+ Build-Depends:
+ base >= 3,
+ directory,
+ containers,
+ process,
+ old-time,
+ bytestring
+ else
+ Build-Depends: base < 3
+
+ ghc-options: -Wall
+ other-modules:
+ Action
+ AnsiColor
+ Bash
+ BlingBling
+ Cabal2Ebuild
+ Cache
+ CacheFile
+ Config
+ Diff
+ Error
+ Fetch
+ GenerateEbuild
+ Index
+ Main
+ MaybeRead
+ Overlays
+ P2
+ Package
+ Portage
+ Setup
+ Status
+ Utils
+ Version