Rewritten overlayonly functionality

Initial attempt. Code hackish and chainsawed

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 ()

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 ""))

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
 

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

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

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

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
+

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