[commit: packages/Cabal] ghc-head: Refactoring. (27d63fc)

git at git.haskell.org git at git.haskell.org
Mon Aug 26 23:27:12 CEST 2013


Repository : ssh://git@git.haskell.org/Cabal

On branch  : ghc-head
Link       : http://git.haskell.org/?p=packages/Cabal.git;a=commit;h=27d63fc61abaf0b60392ce4e1c84aaedd7337e70

>---------------------------------------------------------------

commit 27d63fc61abaf0b60392ce4e1c84aaedd7337e70
Author: Mikhail Glushenkov <mikhail.glushenkov at gmail.com>
Date:   Mon Jun 10 01:12:49 2013 +0200

    Refactoring.
    
    Split 'onBuildConfig' into two (local) functions.


>---------------------------------------------------------------

27d63fc61abaf0b60392ce4e1c84aaedd7337e70
 cabal-install/Main.hs |   48 ++++++++++++++++++++++++++++--------------------
 1 file changed, 28 insertions(+), 20 deletions(-)

diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index 9f4d77e..b0dce26 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -377,10 +377,7 @@ reconfigure verbosity distPref     addConfigFlags extraArgs globalFlags
     onBuildConfig :: LBI.LocalBuildInfo -> IO UseSandbox
     onBuildConfig lbi = do
       let configFlags = LBI.configFlags lbi
-          flags = mconcat [configFlags, addConfigFlags, distVerbFlags]
-          savedDistPref = fromFlagOrDefault
-                          (useDistPref defaultSetupScriptOptions)
-                          (configDistPref configFlags)
+          flags       = mconcat [configFlags, addConfigFlags, distVerbFlags]
       (useSandbox, depsReinstalled) <-
         case skipAddSourceDepsCheck of
         DontSkipAddSourceDepsCheck     ->
@@ -390,10 +387,33 @@ reconfigure verbosity distPref     addConfigFlags extraArgs globalFlags
                              globalFlags mempty
           return (useSandbox, NoDepsReinstalled)
 
-      -- Determine what message, if any, to display to the user if
-      -- reconfiguration is required.
-      message <- case depsReinstalled of
-        ReinstalledSomeDeps -> return $! Just $! reinstalledDepsMessage
+      mMsg <- determineMessageToShow lbi configFlags depsReinstalled
+      case mMsg of
+
+        -- No message for the user indicates that reconfiguration
+        -- is not required.
+        Nothing -> return useSandbox
+
+        -- Show the message and reconfigure.
+        Just msg -> do
+          notice verbosity msg
+          configureAction (flags, defaultConfigExFlags)
+            extraArgs globalFlags
+          return useSandbox
+
+    -- Determine what message, if any, to display to the user if reconfiguration
+    -- is required.
+    determineMessageToShow :: LBI.LocalBuildInfo -> ConfigFlags
+                            -> WereDepsReinstalled
+                            -> IO (Maybe String)
+    determineMessageToShow lbi configFlags depsReinstalled = do
+      let savedDistPref = fromFlagOrDefault
+                          (useDistPref defaultSetupScriptOptions)
+                          (configDistPref configFlags)
+      case depsReinstalled of
+        ReinstalledSomeDeps ->
+          -- Some add-source deps were reinstalled.
+          return $! Just $! reinstalledDepsMessage
         NoDepsReinstalled ->
           case checkFlags configFlags of
             -- Flag required by the caller is not set.
@@ -415,18 +435,6 @@ reconfigure verbosity distPref     addConfigFlags extraArgs globalFlags
                             then Just $! outdatedMessage pdFile
                             else Nothing
 
-      case message of
-
-        -- No message for the user indicates that reconfiguration
-        -- is not required.
-        Nothing -> return useSandbox
-
-        Just msg -> do
-          notice verbosity msg
-          configureAction (flags, defaultConfigExFlags)
-            extraArgs globalFlags
-          return useSandbox
-
     defaultFlags = mappend addConfigFlags distVerbFlags
     distVerbFlags = mempty
         { configVerbosity = toFlag verbosity





More information about the ghc-commits mailing list