Permalink
Browse files

Switch to using Portage.{PackageId,Version}

  • Loading branch information...
kolmodin committed Sep 7, 2008
1 parent 2fcffdb commit 225135fd86a3defc88a4ec72ffbcb92ee3a5de1f
Showing with 83 additions and 272 deletions.
  1. +15 −14 Cache.hs
  2. +11 −9 Diff.hs
  3. +28 −12 Main.hs
  4. +12 −24 Merge.hs
  5. +6 −6 P2.hs
  6. +0 −76 Package.hs
  7. +7 −7 Status.hs
  8. +0 −122 Version.hs
  9. +4 −2 hackport.cabal
View
@@ -4,7 +4,7 @@ import CacheFile
import Error
import Index
import P2
-import Version
+import qualified Portage.Version as Portage
import Overlays
import Distribution.Text ( simpleParse )
@@ -18,12 +18,13 @@ import qualified Data.ByteString.Lazy as L
import System.Time
import System.FilePath
import Control.Monad.Writer
-import System.Directory (createDirectoryIfMissing)
+import System.Directory (createDirectoryIfMissing, doesFileExist)
import qualified Data.Map as Map
-- cabal
import Distribution.Verbosity
+import Distribution.Simple.Utils
-- | A long time
alarmingLongTime :: TimeDiff
@@ -41,7 +42,11 @@ updateCache :: Verbosity -> URI -> IO ()
updateCache verbose uri = do
path <- getOverlayPath verbose
let cache = cacheURI uri
- res <- simpleHTTP (Request cache GET [] "") -- `sayNormal` ("Fetching cache from "++show cache++"...",const "done.")
+ notice verbose $
+ "Fetching cache from " ++ show cache ++ "..."
+ res <- simpleHTTP (Request cache GET [] "")
+ notice verbose $
+ "done."
case res of
Left err -> throwEx (ConnectionFailed (show cache) (show err))
Right resp -> do
@@ -52,28 +57,24 @@ updateCache verbose uri = do
cacheURI uri = uri {uriPath = uriPath uri </> indexFile}
-readCache :: FilePath -> IO Index
-readCache portdir = do
+readCache :: Verbosity -> FilePath -> URI -> IO Index
+readCache verbosity portdir uri = do
let cachePath = cacheFile portdir
- -- TODO: re-implement
- -- exists <- doesFileExist cachePath
- -- unless exists $ do
- -- info "No cache file present, attempting to update..."
- -- updateCache
+ exists <- doesFileExist cachePath
+ unless exists $ do
+ notice verbose "No cache file present, attempting to update..."
+ updateCache verbosity uri
str <- L.readFile cachePath
return (readIndex str)
-readDefaultCache :: Verbosity -> IO Index
-readDefaultCache verbose = getOverlayPath verbose >>= readCache
-
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)
+ (Portage.fromCabalVersion ver)
"<hackage>"
(Just pkg_desc)
return $ Map.map sort $ Map.fromListWith (++) [ (ePackage e, [e]) | e <- pkgs ]
View
20 Diff.hs
@@ -5,13 +5,15 @@ module Diff
import Data.Char
import qualified Data.Map as Map
+import Network.URI
import Cache
import P2
-import Version
+import qualified Portage.Version as Portage
-- cabal
import Distribution.Verbosity
+import Distribution.Text(display)
data DiffMode
= ShowAll
@@ -31,18 +33,18 @@ tabs str = let len = length str in str++(if len < 3*8
then replicate (3*8-len) ' '
else "")
-showDiffState :: Package -> DiffState Version -> String
+showDiffState :: Package -> DiffState Portage.Version -> String
showDiffState pkg st = (tabs (show pkg)) ++ " [" ++ (case st of
- Both x y -> showVersion x ++ (case compare x y of
+ Both x y -> display x ++ (case compare x y of
EQ -> "="
GT -> ">"
- LT -> "<") ++ showVersion y
- OnlyLeft x -> showVersion x ++ ">none"
- OnlyRight y -> "none<"++showVersion y)++"]"
+ LT -> "<") ++ display y
+ OnlyLeft x -> display x ++ ">none"
+ OnlyRight y -> "none<" ++ display y) ++ "]"
-runDiff :: Verbosity -> FilePath -> DiffMode -> IO ()
-runDiff verbose overlayPath dm = do
- cache <- readCache overlayPath
+runDiff :: Verbosity -> FilePath -> URI -> DiffMode -> IO ()
+runDiff verbosity overlayPath serverURI dm = do
+ cache <- readCache verbosity overlayPath serverURI
overlayTree <- readPortageTree overlayPath
let (hackageTree, clashes) = indexToPortage cache overlayTree
mapM_ putStrLn clashes
View
40 Main.hs
@@ -45,24 +45,28 @@ import Cabal2Ebuild
data ListFlags = ListFlags {
listVerbosity :: Flag Verbosity,
- listOverlayPath :: Flag FilePath
+ listOverlayPath :: Flag FilePath,
+ listServerURI :: Flag String
}
instance Monoid ListFlags where
mempty = ListFlags {
listVerbosity = mempty,
- listOverlayPath = mempty
+ listOverlayPath = mempty,
+ listServerURI = mempty
}
mappend a b = ListFlags {
listVerbosity = combine listVerbosity,
- listOverlayPath = combine listOverlayPath
+ listOverlayPath = combine listOverlayPath,
+ listServerURI = combine listServerURI
}
where combine field = field a `mappend` field b
defaultListFlags :: ListFlags
defaultListFlags = ListFlags {
listVerbosity = Flag normal,
- listOverlayPath = NoFlag
+ listOverlayPath = NoFlag,
+ listServerURI = Flag defaultHackageServerURI
}
listCommand :: CommandUI ListFlags
@@ -84,10 +88,11 @@ listCommand = CommandUI {
listAction :: ListFlags -> [String] -> GlobalFlags -> IO ()
listAction flags args globalFlags = do
- let verbose = fromFlag (listVerbosity flags)
+ let verbosity = fromFlag (listVerbosity flags)
portdirM = flagToMaybe (listOverlayPath flags)
- overlay <- maybe (getOverlayPath verbose) return portdirM
- index <- readCache overlay
+ serverURI <- getServerURI (fromFlag $ listServerURI flags)
+ overlay <- maybe (getOverlayPath verbosity) return portdirM
+ index <- readCache verbosity overlay serverURI
let index' | null name = index
| otherwise = filterIndexByPV matchSubstringCaseInsensitive index
pkgs = [ pkg ++ "-" ++ ver | (pkg,ver,_) <- index']
@@ -152,24 +157,28 @@ makeEbuildCommand = CommandUI {
data DiffFlags = DiffFlags {
diffMode :: Flag DiffMode,
- diffVerbosity :: Flag Verbosity
+ diffVerbosity :: Flag Verbosity,
+ diffServerURI :: Flag String
}
instance Monoid DiffFlags where
mempty = DiffFlags {
diffMode = mempty,
- diffVerbosity = mempty
+ diffVerbosity = mempty,
+ diffServerURI = mempty
}
mappend a b = DiffFlags {
diffMode = combine diffMode,
- diffVerbosity = combine diffVerbosity
+ diffVerbosity = combine diffVerbosity,
+ diffServerURI = combine diffServerURI
}
where combine field = field a `mappend` field b
defaultDiffFlags :: DiffFlags
defaultDiffFlags = DiffFlags {
diffMode = Flag ShowAll,
- diffVerbosity = Flag normal
+ diffVerbosity = Flag normal,
+ diffServerURI = Flag defaultHackageServerURI
}
diffCommand :: CommandUI DiffFlags
@@ -189,8 +198,9 @@ diffAction :: DiffFlags -> [String] -> GlobalFlags -> IO ()
diffAction flags args globalFlags = do
let verbose = fromFlag (diffVerbosity flags)
dm = fromFlag (diffMode flags)
+ serverURI <- getServerURI (fromFlag $ diffServerURI flags)
overlayPath <- getOverlayPath verbose
- runDiff verbose overlayPath dm
+ runDiff verbose overlayPath serverURI dm
-----------------------------------------------------------------------
-- Update
@@ -377,6 +387,12 @@ mergeAction _ _ _ =
defaultHackageServerURI :: String
defaultHackageServerURI = "http://hackage.haskell.org/packages/archive/"
+getServerURI :: String -> IO URI
+getServerURI str =
+ case parseURI str of
+ Just uri -> return uri
+ Nothing -> throwEx (InvalidServer str)
+
reqArgFlag :: ArgPlaceHolder -> SFlags -> LFlags -> Description ->
(b -> Flag String) -> (Flag String -> b -> b) -> OptDescr b
reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList
View
@@ -1,7 +1,5 @@
module Merge where
-import Text.ParserCombinators.Parsec
-
import Control.Monad.Error
import Data.Char
import Data.Maybe
@@ -22,7 +20,7 @@ import qualified Cabal2Ebuild as E
import Cache
import Error
import GenerateEbuild
-import Package
+import qualified Portage.PackageId as Portage
import Overlays
import P2
@@ -34,16 +32,16 @@ import Network.URI
import Cabal2Ebuild
merge :: Verbosity -> URI -> String -> IO ()
-merge verbose serverURI pstr = do
- (m_category, pname, m_version) <- case parsePVC of
- Right v -> return v
- Left err -> throwEx (ArgumentError ("Could not parse [category/]package[-version]: " ++ show err))
- portdir <- liftIO (getOverlayPath verbose)
- overlay <- liftIO (readPortageTree portdir)
- cache <- liftIO $ readCache portdir
+merge verbosity serverURI pstr = do
+ (m_category, Portage.PN pname, m_version) <- case Portage.parseFriendlyPackage pstr of
+ Just v -> return v
+ Nothing -> throwEx (ArgumentError ("Could not parse [category/]package[-version]: " ++ show pstr))
+ overlayPath <- getOverlayPath verbosity
+ overlay <- readPortageTree overlayPath
+ cache <- readCache verbosity overlayPath serverURI
let (indexTree,clashes) = indexToPortage cache overlay
mapM_ putStrLn clashes
- info verbose $ "Searching for: "++ pstr
+ info verbosity $ "Searching for: "++ pstr
let pkgs =
Map.elems
. Map.filterWithKey (\(P _ pname') _ -> map toLower pname' == map toLower pname)
@@ -62,7 +60,7 @@ merge verbose serverURI pstr = do
_ -> fail "the impossible happened"
category <- do
case m_category of
- Just cat -> return cat
+ Just (Portage.Category cat) -> return cat
Nothing -> do
case pCategory (ePackage pkg) of
"hackage" -> return "dev-haskell"
@@ -76,15 +74,5 @@ merge verbose serverURI pstr = do
let ebuild = fixSrc serverURI (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)
+ putStrLn $ "Destination: " ++ overlayPath
+ mergeEbuild overlayPath category ebuild
View
12 P2.hs
@@ -22,14 +22,16 @@ import System.FilePath
import Text.Regex
-import Version
+import qualified Portage.Version as Portage
+
+import Distribution.Text
type Portage = PortageMap [Ebuild]
type PortageMap a = Map Package a
data Ebuild = Ebuild {
ePackage :: Package,
- eVersion :: Version,
+ eVersion :: Portage.Version,
eFilePath :: FilePath,
ePkgDesc :: Maybe Cabal.GenericPackageDescription }
deriving (Show)
@@ -77,12 +79,10 @@ readPortagePackages portdir packages0 = do
| (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 :: String -> String -> Maybe Portage.Version
filterVersion p fn = do
[vstring] <- matchRegex (ebuildVersionRegex p) fn
- case (parseVersion vstring) of
- Left e -> fail (show e)
- Right v -> return v
+ simpleParse vstring
ebuildVersionRegex name = mkRegex ("^"++name++"-(.*)\\.ebuild$")
Oops, something went wrong.

0 comments on commit 225135f

Please sign in to comment.