Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Rewritten overlayonly functionality

Initial attempt. Code hackish and chainsawed
  • Loading branch information...
commit 9448bb73a28b1c1bcf37fb45103d60a7091132a5 1 parent 419a84b
@kolmodin kolmodin authored
View
2  Action.hs
@@ -58,7 +58,7 @@ getCfg :: HPAction Config
getCfg = gets config
setOverlayPath :: Maybe String -> HPAction ()
-setOverlayPath mt = modify $ \hps ->
+setOverlayPath mt = modify $ \hps ->
hps { config = (config hps) { overlayPath = mt } }
lessIndent :: HPAction ()
View
50 AnsiColor.hs
@@ -0,0 +1,50 @@
+{-|
+ Maintainer : Andres Loeh <kosmikus@gentoo.org>
+ Stability : provisional
+ Portability : haskell98
+
+ Simplistic ANSI color support.
+-}
+
+module AnsiColor
+ where
+
+-- import Portage.Config.Type
+import Data.List
+
+data Color = Black
+ | Red
+ | Green
+ | Yellow
+ | Blue
+ | Magenta
+ | Cyan
+ | White
+ | Default
+ deriving Enum
+
+esc [] = ""
+esc xs = "\ESC[" ++ (concat . intersperse ";" $ xs) ++ "m"
+
+col fg bf bg = show (fromEnum fg + 30) : bf' [show (fromEnum bg + 40)]
+ where bf' | bf = ("01" :)
+ | otherwise = id
+
+inColor c bf bg txt = esc (col c bf bg) ++ txt ++ esc ["00"]
+
+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 ""))
View
6 Bash.hs
@@ -24,15 +24,15 @@ getOverlay = 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.")
+ `sayDebug` ("Checking '"++x++"'...\n",\res->if res then "found.\n" else "not found.")
if found
then return x
- else loop xs)
+ 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 ("I choose " ++ overlay)
whisper "Override my decision with hackport -p /my/overlay"
return overlay
View
4 Cabal2Ebuild.hs
@@ -134,7 +134,7 @@ convertDependency (Cabal.Dependency name 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
@@ -226,7 +226,7 @@ getRestIfPrefix _ [] = Nothing
subStr ::
String -> -- ^ the search string
String -> -- ^ the string to be searched
- Maybe (String,String) -- ^ Just (pre,post) if string is found
+ 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
View
7 Config.hs
@@ -23,7 +23,7 @@ data OperationMode
| DiffTree DiffMode
| Update
| ShowHelp
- | OverlayOnly (Maybe String)
+ | OverlayOnly
data DiffMode
= ShowAll
@@ -92,9 +92,8 @@ parseConfig opts = let
"diff":arg1:args -> Left ("'diff' takes one argument("++show ((length args)+1)++" given).\n")
"update":[] -> Right Update
"update":rest -> Left ("'update' takes zero arguments("++show (length rest)++" given).\n")
- "overlayonly":[] -> Right (OverlayOnly Nothing)
- "overlayonly":portdir:[] -> Right (OverlayOnly (Just portdir))
- "overlayonly":arg:args -> Left ("'overlayonly' takes one optional argument("++show ((length args)+1)++" given).\n")
+ "overlayonly":[] -> Right OverlayOnly
+ "overlayonly":args -> Left ("'overlayonly' doesn't take any arguments. ("++show ((length args)+1)++" given).\n")
[] -> Right ShowHelp
_ -> Left "Unknown opertation mode\n"
in case mode of
View
33 Main.hs
@@ -14,17 +14,21 @@ import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
+
import Action
-import Error
-import Cabal2Ebuild
-import GenerateEbuild
import Bash
+import Cabal2Ebuild
+import Cache
import Config
import Diff
-import Portage
-import Cache
+import Error
+import GenerateEbuild
import Index
import MaybeRead
+import OverlayPortageDiff
+import Portage
+
+import P2
list :: String -> HPAction ()
list name = do
@@ -107,23 +111,6 @@ update = do
updateCache
return ()
-overlayonly :: Maybe String -> HPAction ()
-overlayonly pd = do
- cfg <- getCfg
- portdir <- maybe (getPortDir `sayDebug` ("Guessing portage main dir from /etc/make.conf...",\res->"found: "++res++".")) return pd
- overlay <- getOverlayPath
- mainlinepkgs <- portageGetPackages portdir
- `sayDebug` ("Getting package list from "++portdir++"...",const "done.")
- overlaypkgs <- portageGetPackages overlay
- `sayDebug` ("Getting package list from "++overlay++"...",const "done.")
- info "These packages are in the overlay but not in the portage tree:"
- let (_,diff,_) = diffSet (Set.fromList mainlinepkgs) (Set.fromList overlaypkgs)
- let vindent = case verbosity cfg of
- Silent -> id
- _ -> indent
- let showPkgSet set = mapM_ (\pkg->echoLn (pkgName pkg++"-"++showVersion (pkgVersion pkg))) (Set.elems set)
- vindent $ showPkgSet diff
-
hpmain :: HPAction ()
hpmain = do
mode <- loadConfig
@@ -133,7 +120,7 @@ hpmain = do
Merge pkg -> merge pkg
DiffTree mode -> diff mode
Update -> update
- OverlayOnly portdir -> overlayonly portdir
+ OverlayOnly -> overlayonly
main :: IO ()
main = performHPAction hpmain
View
88 OverlayPortageDiff.hs
@@ -0,0 +1,88 @@
+module OverlayPortageDiff where
+--module OverlayPortageDiff where
+
+import Action
+import AnsiColor
+import Bash
+import Config
+import Diff
+import Portage
+import P2
+
+import Control.Monad.Error
+import Control.Monad.State
+
+import qualified Data.List as List
+import Data.Version
+import Distribution.Package
+
+import qualified Data.ByteString.Lazy.Char8 as L
+
+import Data.Char
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+data Diff a = D
+ { sameSame :: [a] -- ^ file exists in both portdirs, and are identical
+ , fileDiffers :: [a] -- ^ file exists in both portdirs, but are different
+ , only1 :: [a] -- ^ only exist in the first dir
+ , only2 :: [a] -- ^ only exist in the second dir
+ }
+
+overlayonly :: HPAction ()
+overlayonly = do
+ cfg <- getCfg
+ portdir <- getPortDir
+ overlayPath <- getOverlayPath
+ portage <- liftIO $ readPortageTree portdir
+ overlay <- liftIO $ readPortageTree overlayPath
+ info "These packages are in the overlay but not in the portage tree:"
+ let (over, both) = portageDiff overlay portage
+
+ forM_ (Map.toAscList both) $ \(package, ebuilds) -> liftIO $ do
+ print package
+ forM_ ebuilds $ \e -> do
+ -- can't fail, we know the ebuild exists in both portagedirs
+ 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)
+ let c | eq = Green
+ | otherwise = Yellow
+ putStrLn (showDoc (color (text $ show $ eVersion e) c) True)
+
+ liftIO $ putStrLn "**"
+ forM_ (Map.toAscList over) $ \(package, ebuilds) -> liftIO $ do
+ print package
+ forM_ ebuilds $ \e -> do print (eVersion e)
+
+-- incomplete
+portageDiff :: Portage -> Portage -> (Portage, Portage)
+portageDiff p1 p2 = (in1, ins)
+ where ins = Map.filter (not . null) $
+ Map.intersectionWith (List.intersectBy $ comparing eVersion) p1 p2
+ in1 = Map.filter (not . null) $
+ Map.differenceWith (\xs ys ->
+ let lst = filter (\x -> any (\y -> eVersion x == eVersion y) ys) xs in
+ if null lst
+ then Nothing
+ else Just lst
+ ) p1 p2
+
+comparing f x y = f x == f 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
+
View
83 P2.hs
@@ -0,0 +1,83 @@
+module P2 where
+
+import qualified Data.Set as Set
+
+import Control.Arrow
+import Control.Monad
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe
+import qualified Data.List as List
+
+import System
+import System.Directory
+import System.IO
+import System.IO.Unsafe
+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 }
+ deriving (Eq, Show)
+
+data Package = P String String
+ deriving (Eq, Ord)
+
+instance Show Package where
+ show (P c p) = c ++ '/':p
+
+lookupEbuildWith :: Portage -> Package -> (Ebuild -> Bool) -> Maybe Ebuild
+lookupEbuildWith portage package comp = do
+ es <- Map.lookup package portage
+ List.find comp es
+
+
+main' = do
+ args <- getArgs
+ portdir <- case args of
+ [] -> return "/usr/portage"
+ [x] -> return x
+ print =<< (readPortageTree portdir)
+
+readPortageTree :: FilePath -> IO (Map Package [Ebuild])
+readPortageTree portdir = do
+ categories <- getDirectories portdir
+ packages <- fmap concat $ forM categories $ \c -> do
+ putStr "."
+ pkg <- getDirectories (portdir </> c)
+ return (map ((,) c) pkg)
+ putStrLn ""
+ ebuild_map <- forM packages $ \package -> do
+ ebuilds <- unsafeInterleaveIO (getPackageVersions package)
+ return (uncurry P package, ebuilds)
+ return $ Map.fromList ebuild_map
+
+ where
+ getPackageVersions :: (String, String) -> IO [Ebuild]
+ getPackageVersions (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 (Ebuild (P category package))) 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$")
+
+getDirectories :: FilePath -> IO [String]
+getDirectories fp = do
+ files <- fmap (filter (`notElem` [".", ".."])) $ getDirectoryContents fp
+ filterM (doesDirectoryExist . (fp </>)) files
View
116 Version.hs
@@ -0,0 +1,116 @@
+{-|
+ 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(..),
+ showVersion,
+ showSuffix,
+ readVersion,
+ parseVersion,
+ getVersion,
+ showRevPR
+ ) where
+
+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
+
+-- | 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)
+ )
View
2  hackport.cabal
@@ -2,7 +2,7 @@ Name: HackPort
Version: 0.2
License: GPL
Author: Henning Günther
-Build-Depends: base, network, mtl, HTTP, Cabal < 1.1.7, filepath, regex-compat, tar, zlib
+Build-Depends: base, network, mtl, HTTP, Cabal < 1.1.7, filepath, regex-compat, tar, zlib, parsec, haskell98
Synopsis: Hackage and Portage integration tool
Executable: hackport
Please sign in to comment.
Something went wrong with that request. Please try again.