diff --git a/Action.hs b/Action.hs index 768bbdf..5ffd49f 100644 --- a/Action.hs +++ b/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 () diff --git a/AnsiColor.hs b/AnsiColor.hs new file mode 100644 index 0000000..effbb22 --- /dev/null +++ b/AnsiColor.hs @@ -0,0 +1,50 @@ +{-| + Maintainer : Andres Loeh + 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 "")) diff --git a/Bash.hs b/Bash.hs index 64c1c8f..5a71f6b 100644 --- a/Bash.hs +++ b/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 diff --git a/Cabal2Ebuild.hs b/Cabal2Ebuild.hs index e73cbf4..cd35f15 100644 --- a/Cabal2Ebuild.hs +++ b/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 diff --git a/Config.hs b/Config.hs index 83ff3e5..97da0a1 100644 --- a/Config.hs +++ b/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 diff --git a/Main.hs b/Main.hs index 5543824..fdc26b5 100644 --- a/Main.hs +++ b/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 diff --git a/OverlayPortageDiff.hs b/OverlayPortageDiff.hs new file mode 100644 index 0000000..760632c --- /dev/null +++ b/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 + diff --git a/P2.hs b/P2.hs new file mode 100644 index 0000000..18a111d --- /dev/null +++ b/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 diff --git a/Version.hs b/Version.hs new file mode 100644 index 0000000..2d612a3 --- /dev/null +++ b/Version.hs @@ -0,0 +1,116 @@ +{-| + Maintainer : Andres Loeh + 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) "" + +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 index f6ee4aa..54e3331 100644 --- a/hackport.cabal +++ b/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