/
Status.hs
174 lines (148 loc) · 6.04 KB
/
Status.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
module Status
( FileStatus(..)
, fromStatus
, status
, runStatus
) where
import AnsiColor
import Portage.Overlay
import Portage.PackageId
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
import Control.Applicative
-- cabal
import Distribution.Verbosity
import Distribution.Simple.Utils (equating, comparing)
import Distribution.Text ( display, simpleParse )
import Distribution.Simple.Utils ( die )
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 PackageName [FileStatus ExistingEbuild])
status _verbosity portdir overlaydir = do
overlay <- loadLazy overlaydir
portage <- filterByHerd ("haskell" `elem`) <$> loadLazy portdir
let (over, both, port) = portageDiff (overlayMap overlay) (overlayMap 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 (overlayMap portage) (ebuildId e)
(Just e2) = lookupEbuildWith (overlayMap overlay) (ebuildId e)
eq <- equals (ebuildPath e1) (ebuildPath e2)
return $ if eq
then Same e1
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
type EMap = Map PackageName [ExistingEbuild]
lookupEbuildWith :: EMap -> PackageId -> Maybe ExistingEbuild
lookupEbuildWith overlay pkgid = do
ebuilds <- Map.lookup (packageId pkgid) overlay
List.find (\e -> ebuildId e == pkgid) ebuilds
runStatus :: Verbosity -> FilePath -> FilePath -> Bool -> [String] -> IO ()
runStatus verbosity portdir overlaydir toPortageFlag pkgs = do
let pkgFilter | toPortageFlag = toPortageFilter
| otherwise = id
pkgs' <- forM pkgs $ \p ->
case simpleParse p of
Nothing -> die ("Could not parse package name: " ++ p ++ ". Format cat/pkg")
Just pn -> return pn
tree0 <- status verbosity portdir overlaydir
let tree = pkgFilter tree0
if (null pkgs')
then statusPrinter tree
else forM_ pkgs' $ \pkg -> statusPrinter (Map.filterWithKey (\k _ -> k == pkg) tree)
-- |Only return packages that seems interesting to sync to portage;
--
-- * Ebuild differs, or
-- * Newer version in overlay than in portage
toPortageFilter :: Map PackageName [FileStatus ExistingEbuild] -> Map PackageName [FileStatus ExistingEbuild]
toPortageFilter = Map.mapMaybe $ \ sts ->
let inPortage = flip filter sts $ \st ->
case st of
OverlayOnly _ -> False
_ -> True
latestPortageVersion = List.maximum $ map (pkgVersion . ebuildId . fromStatus) inPortage
interestingPackages = flip filter sts $ \st ->
case st of
Differs _ _ -> True
_ | pkgVersion (ebuildId (fromStatus st)) > latestPortageVersion -> True
| otherwise -> False
in if not (null inPortage) && not (null interestingPackages)
then Just sts
else Nothing
statusPrinter :: Map PackageName [FileStatus ExistingEbuild] -> 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 (PackageName c p) = pkg
putStr $ display c ++ '/' : bold (display p)
putStr " "
forM_ ebuilds $ \e -> do
putStr $ toColor (fmap (display . pkgVersion . ebuildId) 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 :: EMap -> EMap -> (EMap, EMap, EMap)
portageDiff p1 p2 = (in1, ins, in2)
where ins = Map.filter (not . null) $ Map.intersectionWith (List.intersectBy $ equating ebuildId) 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 ebuildId)) 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