/
DistroMap.hs
158 lines (122 loc) · 5.97 KB
/
DistroMap.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
{-# OPTIONS -XPatternGuards #-}
{-
Generate a distromap, like these:
http://hackage.haskell.org/packages/archive/00-distromap/
Format:
("xmobar","0.8",Just "http://packages.gentoo.org/package/x11-misc/xmobar")
("xmobar","0.9",Just "http://packages.gentoo.org/package/x11-misc/xmobar")
("xmobar","0.9.2",Just "http://packages.gentoo.org/package/x11-misc/xmobar")
("xmonad","0.5",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
("xmonad","0.6",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
("xmonad","0.7",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
("xmonad","0.8",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
("xmonad","0.8.1",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
("xmonad","0.9",Just "http://packages.gentoo.org/package/x11-wm/xmonad")
("xmonad","0.9.1",Just "http://en.gentoo-wiki.com/wiki/Haskell/overlay")
Multiple entries for each package is allowed, given that there are different versions.
Setup:
Join all packages from portage and the overlay into a big map;
From Portage.PackageId: PackageName = category/package
PVULine = (packagename, versionstring, url)
Create such a map: Map PackageName DistroLine
Only one PVULine per version, and prefer portage over the overlay.
Algorithm;
1. Take a package from hackage
2. Look for it in the map
a. For each version:
find a match in the list of versions:
yield the PVULine
-}
module DistroMap
( distroMap ) where
import Control.Applicative
import qualified Data.List as List ( nub )
import qualified Data.Map as Map
import Data.Map ( Map )
import System.FilePath ( (</>) )
import Debug.Trace ( trace )
import Data.Maybe ( fromJust )
import Distribution.Verbosity
import Distribution.Text ( display )
import Distribution.Client.Types ( Repo, SourcePackageDb(..), SourcePackage(..) )
import Distribution.Simple.Utils ( info )
import qualified Data.Version as Cabal
import qualified Distribution.Package as Cabal
import qualified Distribution.Client.PackageIndex as CabalInstall
import qualified Distribution.Client.IndexUtils as CabalInstall
import Portage.Overlay ( readOverlayByPackage, getDirectoryTree )
import qualified Portage.PackageId as Portage
import qualified Portage.Version as Portage
type PVU = (Cabal.PackageName, Cabal.Version, Maybe String)
type PVU_Map = Map Portage.PackageName [(Cabal.Version, Maybe String)]
distroMap :: Verbosity -> Repo -> FilePath -> FilePath -> [String] -> IO ()
distroMap verbosity repo portagePath overlayPath args = do
info verbosity "distro map called"
info verbosity ("verbosity: " ++ show verbosity)
info verbosity ("portage: " ++ portagePath)
info verbosity ("overlay: " ++ overlayPath)
info verbosity ("args: " ++ show args)
portage <- readOverlayByPackage <$> getDirectoryTree portagePath
overlay <- readOverlayByPackage <$> getDirectoryTree overlayPath
info verbosity ("portage packages: " ++ show (length portage))
info verbosity ("overlay packages: " ++ show (length overlay))
let portageMap = buildPortageMap portage
overlayMap = buildOverlayMap overlay
completeMap = unionMap portageMap overlayMap
info verbosity ("portage map: " ++ show (Map.size portageMap))
info verbosity ("overlay map: " ++ show (Map.size overlayMap))
info verbosity ("complete map: " ++ show (Map.size completeMap))
SourcePackageDb { packageIndex = packageIndex } <-
CabalInstall.getSourcePackages verbosity [repo]
let pkgs0 = map (map packageInfoId) (CabalInstall.allPackagesByName packageIndex)
hackagePkgs = [ (Cabal.pkgName (head p), map Cabal.pkgVersion p) | p <- pkgs0 ]
info verbosity ("cabal packages: " ++ show (length hackagePkgs))
let pvus = concat $ map (\(p,vs) -> lookupPVU completeMap p vs) hackagePkgs
info verbosity ("found pvus: " ++ show (length pvus))
mapM_ (putStrLn . showPVU) pvus
return ()
showPVU :: PVU -> String
showPVU (p,v,u) = show $ (display p, display v, u)
-- building the PVU_Map
reduceVersion :: Portage.Version -> Portage.Version
reduceVersion (Portage.Version ns _ _ _) = Portage.Version ns Nothing [] 0
reduceVersions :: [Portage.Version] -> [Portage.Version]
reduceVersions = List.nub . map reduceVersion
buildMap :: [(Portage.PackageName, [Portage.Version])]
-> (Portage.PackageName -> Portage.Version -> Maybe String)
-> PVU_Map
buildMap pvs f = Map.mapWithKey (\p vs -> [ (fromJust $ Portage.toCabalVersion v, f p v)
| v <- reduceVersions vs ])
(Map.fromList pvs)
buildPortageMap :: [(Portage.PackageName, [Portage.Version])] -> PVU_Map
buildPortageMap lst = buildMap lst $ \ (Portage.PackageName c p) _v ->
Just $ "http://packages.gentoo.org/package" </> display c </> display p
buildOverlayMap :: [(Portage.PackageName, [Portage.Version])] -> PVU_Map
buildOverlayMap lst = buildMap lst $ \_ _ -> Just "http://en.gentoo-wiki.com/wiki/Haskell/overlay"
unionMap :: PVU_Map -> PVU_Map -> PVU_Map
unionMap = Map.unionWith f
where
f :: [(Cabal.Version, Maybe String)]
-> [(Cabal.Version, Maybe String)]
-> [(Cabal.Version, Maybe String)]
f vas vbs = Map.toList (Map.union (Map.fromList vas) (Map.fromList vbs))
-- resolving Cabal.PackageName to Portage.PackageName
lookupPVU :: PVU_Map -> Cabal.PackageName -> [Cabal.Version] -> [PVU]
lookupPVU pvu_map pn cvs =
case findItems (Portage.normalizeCabalPackageName pn) of
[] -> []
[item] -> ret item
items | [item] <- preferableItem items -> ret item
| otherwise -> trace (noDefaultText items) []
where
noDefaultText is = unlines $ ("no default for package: " ++ display pn)
: [ " * " ++ (display cat)
| (Portage.PackageName cat _, _) <- is]
ret (_, vs) = [ (pn, v, u) | (v, u) <- vs, v `elem` cvs ]
preferableItem items =
[ item
| item@(Portage.PackageName cat _pn, _vs) <- items
, cat == Portage.Category "dev-haskell"]
findItems cpn = Map.toList $ Map.filterWithKey f pvu_map
where
f (Portage.PackageName _cat _pn) _vs = cpn == pn