hackport-0.2.6: Status.hs

module Status
    ( FileStatus(..)
    , fromStatus
    , status
    , runStatus
    ) where

import AnsiColor
import P2

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

-- cabal
import Distribution.Verbosity
import Distribution.Simple.Utils (equating, comparing)
import Distribution.Text(display)

data FileStatus a
        = Same a
        | Differs a a
        | OverlayOnly a
        | PortageOnly a
        deriving (Show,Eq)

instance Ord a => Ord (FileStatus a) where
    compare = comparing fromStatus

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 :: Verbosity -> FilePath -> FilePath -> IO (Map Package [FileStatus Ebuild])
status _verbosity portdir overlayPath = do
    overlay <- readPortageTree overlayPath
    portage <- 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) (equating eVersion e)
                (Just e2) = lookupEbuildWith overlay (ePackage e) (equating 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

runStatus :: Verbosity -> FilePath -> FilePath -> Bool -> [String] -> IO ()
runStatus verbosity portdir overlayPath toPortageFlag pkgs = do
  let pkgFilter | toPortageFlag = toPortageFilter
                | otherwise = id
  tree0 <- status verbosity portdir overlayPath
  let tree = pkgFilter tree0
  if (null pkgs)
    then statusPrinter tree
    else forM_ pkgs $ \pkg -> do
          let filteredTree = Map.filterWithKey (\k _ -> pPackage k == pkg) tree
          statusPrinter filteredTree

-- |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] -> IO ()
statusPrinter packages = do
    putStrLn $ toColor (Same "Green") ++ ": package in portage and overlay are the same"
    putStrLn $ toColor (Differs "Yellow" "") ++ ": package in portage and overlay differs"
    putStrLn $ toColor (OverlayOnly "Red") ++ ": package only exist in the overlay"
    putStrLn $ toColor (PortageOnly "Magenta") ++ ": package only exist in the portage tree"
    forM_ (Map.toAscList packages) $ \(pkg, ebuilds) -> do
        let (P c p) = pkg
        putStr $ c ++ '/' : bold p
        putStr " "
        forM_ ebuilds $ \e -> do
            putStr $ toColor (fmap (display . 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 $ equating 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 (equating 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' = equating 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