X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=distrib%2Fcompare%2FBuildInfo.hs;h=1101bf450d011866fac2c7ddd3ba3b3d5413b6d7;hb=1e3348f855578fc60ed52fa62bb4846798a5cd3e;hp=547e5ac85372cc56a89a1de9b4040d734af9152b;hpb=42b40db07ce70b89f867247809c4e930fd82a6f6;p=ghc-hetmet.git

diff --git a/distrib/compare/BuildInfo.hs b/distrib/compare/BuildInfo.hs
index 547e5ac..1101bf4 100644
--- a/distrib/compare/BuildInfo.hs
+++ b/distrib/compare/BuildInfo.hs
@@ -3,39 +3,57 @@ module BuildInfo where
 
 import Control.Monad.State
 
+type BIMonad = StateT BuildInfo Maybe
+
 data BuildInfo = BuildInfo {
                      biThingVersionMap :: ThingVersionMap,
-                     biWays :: Ways
+                     biThingHashMap :: ThingHashMap,
+                     biMaybeWays :: Maybe Ways
                  }
+    deriving Show
+
+type ThingMap = [(String, String)]
 -- Mapping from thing (e.g. "Cabal") to version (e.g. "1.10.0.0")
-type ThingVersionMap = [(String, String)]
+type ThingVersionMap = ThingMap
+-- Mapping from thing (e.g. "Cabal") to ABI hash
+-- (e.g. "e1f7c380581d61d42b0360d440cc35ed")
+type ThingHashMap = ThingMap
 -- The list of ways in the order the build system uses them, e.g.
 -- ["v", "p", "dyn"] => we have ".depend-v-p-dyn.haskell" files
 type Ways = [String]
 
-addThingVersion :: ThingVersionMap -> String -> String -> Maybe ThingVersionMap
-addThingVersion mapping thing version
+emptyBuildInfo :: Maybe Ways -> BuildInfo
+emptyBuildInfo mWays = BuildInfo {
+                           biThingVersionMap = [],
+                           biThingHashMap = [],
+                           biMaybeWays = mWays
+                       }
+
+addThingMap :: ThingMap -> String -> String -> Maybe ThingMap
+addThingMap mapping thing str
  = case lookup thing mapping of
-   Just version' ->
-       if version == version'
+   Just str' ->
+       if str == str'
        then Just mapping
        else Nothing
    Nothing ->
-       Just ((thing, version) : mapping)
-
-getThingVersionMap :: State BuildInfo ThingVersionMap
-getThingVersionMap = do st <- get
-                        return $ biThingVersionMap st
-
-getWays :: State BuildInfo Ways
-getWays = do st <- get
-             return $ biWays st
-
-putThingVersionMap :: ThingVersionMap -> State BuildInfo ()
-putThingVersionMap tm = do st <- get
-                           put $ st { biThingVersionMap = tm }
-
-putWays :: Ways -> State BuildInfo ()
-putWays ws = do st <- get
-                put $ st { biWays = ws }
+       Just ((thing, str) : mapping)
+
+getMaybeWays :: BIMonad (Maybe Ways)
+getMaybeWays = do st <- get
+                  return $ biMaybeWays st
+
+haveThingVersion :: String -> String -> BIMonad ()
+haveThingVersion thing thingVersion
+ = do st <- get
+      case addThingMap (biThingVersionMap st) thing thingVersion of
+          Nothing  -> fail "Inconsistent version"
+          Just tvm -> put $ st { biThingVersionMap = tvm }
+
+haveThingHash :: String -> String -> BIMonad ()
+haveThingHash thing thingHash
+ = do st <- get
+      case addThingMap (biThingHashMap st) thing thingHash of
+          Nothing  -> fail "Inconsistent hash"
+          Just thm -> put $ st { biThingHashMap = thm }