distrib/compare/BuildInfo.hs

   1
   2 module BuildInfo where
   3
   4 import Control.Monad.State
   5
   6 type BIMonad = StateT BuildInfo Maybe
   7
   8 data BuildInfo = BuildInfo {
   9                      biThingVersionMap :: ThingVersionMap,
  10                      biThingHashMap :: ThingHashMap,
  11                      biMaybeWays :: Maybe Ways
  12                  }
  13     deriving Show
  14
  15 type ThingMap = [(String, String)]
  16 -- Mapping from thing (e.g. "Cabal") to version (e.g. "1.10.0.0")
  17 type ThingVersionMap = ThingMap
  18 -- Mapping from thing (e.g. "Cabal") to ABI hash
  19 -- (e.g. "e1f7c380581d61d42b0360d440cc35ed")
  20 type ThingHashMap = ThingMap
  21 -- The list of ways in the order the build system uses them, e.g.
  22 -- ["v", "p", "dyn"] => we have ".depend-v-p-dyn.haskell" files
  23 type Ways = [String]
  24
  25 emptyBuildInfo :: Maybe Ways -> BuildInfo
  26 emptyBuildInfo mWays = BuildInfo {
  27                            biThingVersionMap = [],
  28                            biThingHashMap = [],
  29                            biMaybeWays = mWays
  30                        }
  31
  32 addThingMap :: ThingMap -> String -> String -> Maybe ThingMap
  33 addThingMap mapping thing str
  34  = case lookup thing mapping of
  35    Just str' ->
  36        if str == str'
  37        then Just mapping
  38        else Nothing
  39    Nothing ->
  40        Just ((thing, str) : mapping)
  41
  42 getMaybeWays :: BIMonad (Maybe Ways)
  43 getMaybeWays = do st <- get
  44                   return $ biMaybeWays st
  45
  46 haveThingVersion :: String -> String -> BIMonad ()
  47 haveThingVersion thing thingVersion
  48  = do st <- get
  49       case addThingMap (biThingVersionMap st) thing thingVersion of
  50           Nothing  -> fail "Inconsistent version"
  51           Just tvm -> put $ st { biThingVersionMap = tvm }
  52
  53 haveThingHash :: String -> String -> BIMonad ()
  54 haveThingHash thing thingHash
  55  = do st <- get
  56       case addThingMap (biThingHashMap st) thing thingHash of
  57           Nothing  -> fail "Inconsistent hash"
  58           Just thm -> put $ st { biThingHashMap = thm }
  59