delta release logic, and 7.10.2-a

Author: mzero

hptool/src/Main.hs

@@ -82,7 +82,7 @@ main = shakeArgsWith opts flags main'
 
     opts = shakeOptions
 
-    hpRelease = hp_7_10_2
+    hpRelease = hp_7_10_2_a
     hpFullName = show $ relVersion hpRelease
     srcTarFile = productDir </> hpFullName <.> "tar.gz"
 

hptool/src/PlatformDB.hs

@@ -1,5 +1,5 @@
 module PlatformDB
-    ( release,
+    ( release, deltaFrom,
       incGHC, incGHCLib, incGHCTool, incLib, incTool,
       notWindows, onlyWindows,
 
@@ -11,6 +11,7 @@ module PlatformDB
       isGhc, isWindows, isNotWindows, isLib, isTool
     ) where
 
+import Data.List (partition)
 
 import Types
 import Utils (version)
@@ -19,6 +20,20 @@ import Utils (version)
 release :: String -> [Include] -> Release
 release vstr incs = Release (HpVersion $ version vstr) incs
 
+-- | Construct list of Includes as a delta to packages in another release
+deltaFrom :: Release -> [Include] -> [Include]
+deltaFrom base deltas = go (relIncludes base) deltas
+  where
+    go []             dIncs = dIncs
+    go (bInc : bIncs) dIncs =
+        let (updates, dIncs') = partition (match bInc) dIncs
+        in merge bInc updates : go bIncs dIncs'
+
+    match (_, bPkg) (_, dPkg) = pkgName bPkg == pkgName dPkg
+
+    merge bInc []          = bInc
+    merge _    [updateInc] = updateInc
+    merge bInc _ = error $ "multiple updates for package " ++ show (snd bInc)
 
 buildInc :: IncludeType -> PackageName -> String -> Include
 buildInc inc name vstr = (inc, Package name $ version vstr)

hptool/src/Releases2015.hs

@@ -4,7 +4,7 @@ import PlatformDB
 import Types
 
 releases2015 :: [Release]
-releases2015 = [hp_7_10_2]
+releases2015 = [hp_7_10_2, hp_7_10_2_a]
 
 hp_7_10_2 :: Release
 hp_7_10_2 =
@@ -109,3 +109,11 @@ hp_7_10_2 =
         , incGHCTool "haddock"              "2.16.1"
         ]
 
+hp_7_10_2_a :: Release
+hp_7_10_2_a =
+    release "7.10.2-a" $ deltaFrom hp_7_10_2
+        [ incLib "text"                     "1.2.1.3"
+        , incLib "fgl"                      "5.5.2.1"
+        ]
+
+