makes-delta-crash.patch

diff --git a/Distribution/Gentoo/GHC.hs b/Distribution/Gentoo/GHC.hs
index aceeb24..4924325 100644
--- a/Distribution/Gentoo/GHC.hs
+++ b/Distribution/Gentoo/GHC.hs
@@ -9,8 +9,10 @@
  -}
 
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 module Distribution.Gentoo.GHC
        (
@@ -136,6 +138,14 @@ runEnvM v e = do
 
     runReaderT e (v, env)
 
+instance MonadSay EnvM where
+    say s = do
+        v <- askVerbosity
+        liftIO $ sayIO v s
+    vsay s = do
+        v <- askVerbosity
+        liftIO $ vsayIO v s
+
 askGhcConfMap :: EnvM GhcConfMap
 askGhcConfMap = asks (\(_,(m,_,_)) -> m)
 
@@ -168,13 +178,12 @@ listConfFiles subdir = liftIO $ do
 
 -- Fold Gentoo .conf files from the current GHC version and
 -- create a Map
-foldConf :: (MonadSay m a, Foldable t)
+foldConf :: (MonadSay m, MonadIO m, Foldable t)
     => t FilePath -> m ConfMap
 foldConf = foldM addConf Map.empty
 
 -- | Add this .conf file to the Map
-addConf :: (MonadSay m a, MonadIO m)
-    => ConfMap -> FilePath -> m ConfMap
+addConf :: (MonadSay m, MonadIO m) => ConfMap -> FilePath -> m ConfMap
 addConf cmp conf = do
     cont <- liftIO $ BS.readFile conf
     -- empty files are created for
@@ -224,9 +233,8 @@ brokenPkgs = do
     pure (pkgs, pns, orphanGentooFiles)
 
 -- | Returns: broken, unknown_files
-checkPkgs
-    :: Set FilePath
-    -> EnvM (Set Package, Set FilePath)
+checkPkgs :: (MonadSay m, MonadIO m)
+    => Set FilePath -> m (Set Package, Set FilePath)
 checkPkgs brokenConfs = do
        files_to_pkgs <- liftIO $ resolveFiles brokenConfs
        let gentooFiles = Map.keysSet files_to_pkgs
@@ -295,12 +303,12 @@ findBrokenConfs =
 
 -- Return the closure of all packages affected by breakage
 -- in format of ["name-version", ... ]
-getBrokenGhcPkg :: EnvM (Set Cabal.PackageId)
+getBrokenGhcPkg :: (MonadSay m, MonadIO m) => m (Set Cabal.PackageId)
 getBrokenGhcPkg = do
     s <- ghcPkgRawOut ["check", "--simple-output"]
     Set.fromList . catMaybes <$> traverse check (words s)
   where
-    check :: String -> EnvM (Maybe Cabal.PackageId)
+    check :: MonadSay m => String -> m (Maybe Cabal.PackageId)
     check s = do
         let mpid = simpleParsec s
         unless (isJust mpid) $
@@ -369,7 +377,7 @@ getRegisteredTwice = do
 -- -----------------------------------------------------------------------------
 
 -- Finding packages installed with other versions of GHC
-oldGhcPkgs :: EnvM (Set Package)
+oldGhcPkgs :: (MonadSay m, MonadIO m) => m (Set Package)
 oldGhcPkgs =
     do thisGhc <- ghcLibDir
        vsay $ "oldGhcPkgs ghc lib: " ++ show thisGhc
@@ -381,7 +389,8 @@ oldGhcPkgs =
 
 -- Find packages installed by other versions of GHC in this possible
 -- library directory.
-checkLibDirs :: BSFilePath -> [BSFilePath] -> EnvM [Package]
+checkLibDirs :: (MonadSay m, MonadIO m)
+    => BSFilePath -> [BSFilePath] -> m [Package]
 checkLibDirs thisGhc libDirs =
     do vsay $ "checkLibDir ghc libs: " ++ show (thisGhc, libDirs)
        liftIO $ pkgsHaveContent (hasDirMatching wanted)
@@ -420,7 +429,7 @@ libFronts = map BS.pack
 -- Return all installed haskell packages
 -- -----------------------------------------------------------------------------
 
-allInstalledPackages :: EnvM (Set Package)
+allInstalledPackages :: MonadIO m => m (Set Package)
 allInstalledPackages = do libDir <- ghcLibDir
                           let libDir' = BS.pack libDir
                           fmap (Set.fromList . notGHC) $ liftIO $ pkgsHaveContent
diff --git a/Main.hs b/Main.hs
index 2a89ba1..9ba00bf 100644
--- a/Main.hs
+++ b/Main.hs
@@ -56,7 +56,7 @@ type DriverHistory = M.Map (Set.Set Package) Int
 initialHistory :: DriverHistory
 initialHistory = M.empty
 
-dumpHistory :: DriverHistory -> EnvM ()
+dumpHistory :: MonadSay m => DriverHistory -> m ()
 dumpHistory historyMap = do
     say "Updater's past history:"
     forM_ historyList $ \(n, entry) ->
@@ -308,13 +308,13 @@ options =
 -- -----------------------------------------------------------------------------
 -- Printing information.
 
-help :: SayM a
+help :: (MonadSay m, MonadIO m) => m a
 help = progInfo >>= success
 
-version :: SayM a
+version :: (MonadSay m, MonadIO m) => m a
 version = fmap (++ '-' : showVersion Paths.version) (liftIO getProgName) >>= success
 
-progInfo :: SayM String
+progInfo :: (MonadSay m, MonadIO m) => m String
 progInfo = do pName <- liftIO getProgName
               return $ usageInfo (header pName) options
   where
@@ -346,7 +346,7 @@ systemInfo rm t = do
 -- -----------------------------------------------------------------------------
 -- Utility functions
 
-success :: MonadSay m a => String -> m b
+success :: (MonadSay m, MonadIO m) => String -> m b
 success msg = do say msg
                  liftIO exitSuccess
 
diff --git a/Output.hs b/Output.hs
index 6415e4c..f6273af 100644
--- a/Output.hs
+++ b/Output.hs
@@ -6,17 +6,18 @@
    Fancy output facility.
 -}
 
-{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 module Output (
-                MonadSay
+                MonadSay(..)
               , SayM
               , runSayM
+              , sayIO
+              , vsayIO
               , pkgListPrintLn
               , printList
-              , say
-              , vsay
               , Verbosity(..)
               ) where
 
@@ -31,38 +32,50 @@ data Verbosity = Quiet
                | Verbose
      deriving (Eq, Ord, Show, Read)
 
--- | Works with EnvM and SayM
-type MonadSay m a = (MonadReader (Verbosity, a) m, MonadIO m)
+-- | A class for monads which carry 'Verbosity' and can 'say' something. It
+--   is left without any stringent requirements (such as 'MonadIO') so non-IO
+--   tests can be run on 'MonadSay' actions.
+class Monad m => MonadSay m where
+    say  :: String -> m () -- ^ Say something under normal conditions
+    vsay :: String -> m () -- ^ Say something only when 'Verbose' is selected
 
 -- | A simpler 'MonadSay' when we don't want to set up the full environment yet
-type SayM = ReaderT (Verbosity,()) IO
+type SayM = ReaderT Verbosity IO
 
 runSayM :: Verbosity -> SayM a -> IO a
-runSayM v r = runReaderT r (v, ())
+runSayM v r = runReaderT r v
 
-say :: MonadSay m a => String -> m ()
-say msg = do
-    verb_l <- asks fst
-    liftIO $ case verb_l of
+instance MonadSay SayM where
+    say s = do
+        v <- ask
+        liftIO $ sayIO v s
+    vsay s = do
+        v <- ask
+        liftIO $ vsayIO v s
+
+-- Default implementation of 'say'
+sayIO :: Verbosity -> String -> IO ()
+sayIO v msg = do
+    case v of
         Quiet   -> return ()
         Normal  -> hPutStrLn stderr msg
         Verbose -> hPutStrLn stderr msg
 
-vsay :: MonadSay m a => String -> m ()
-vsay msg = do
-    verb_l <- asks fst
-    liftIO $ case verb_l of
+-- Default implementation of 'vsay'
+vsayIO :: Verbosity -> String -> IO ()
+vsayIO v msg = do
+    case v of
         Quiet   -> return ()
         Normal  -> return ()
         Verbose -> hPutStrLn stderr msg
 
 -- Print a bullet list of values with one value per line.
-printList :: (MonadSay m x, Foldable t)
+printList :: (MonadSay m, Foldable t)
     => (a -> String) -> t a -> m ()
 printList f = mapM_ (say . (++) "  * " . f)
 
 -- Print a list of packages, with a description of what they are.
-pkgListPrintLn :: (MonadSay m a, Foldable t)
+pkgListPrintLn :: (MonadSay m, Foldable t)
     => String -> t Package -> m ()
 pkgListPrintLn desc pkgs = do
       if null pkgs