[commit: ghc] wip/nfs-locking: Minor revision, drop old TODO (cbee74b)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 00:44:09 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/cbee74bfe89e6b2b552c6ae560265ce2d9f5fb17/ghc
>---------------------------------------------------------------
commit cbee74bfe89e6b2b552c6ae560265ce2d9f5fb17
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Tue Oct 10 00:37:42 2017 +0100
Minor revision, drop old TODO
See #250
>---------------------------------------------------------------
cbee74bfe89e6b2b552c6ae560265ce2d9f5fb17
src/CommandLine.hs | 5 +----
src/Hadrian/Utilities.hs | 11 ++++++++---
src/Settings/Flavours/Development.hs | 1 -
3 files changed, 9 insertions(+), 8 deletions(-)
diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index a069c0e..ed6441c 100644
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -5,7 +5,6 @@ module CommandLine (
) where
import Data.Either
-import Data.Maybe
import qualified Data.HashMap.Strict as Map
import Data.List.Extra
import Development.Shake hiding (Normal)
@@ -127,9 +126,7 @@ cmdFlavour :: Action (Maybe String)
cmdFlavour = flavour <$> cmdLineArgs
lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
-lookupFreeze1 m = fromMaybe (freeze1 defaultCommandLineArgs) (freeze1 <$> maybeValue)
- where
- maybeValue = fromDynamic =<< Map.lookup (typeOf defaultCommandLineArgs) m
+lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
cmdInstallDestDir :: Action (Maybe String)
cmdInstallDestDir = installDestDir <$> cmdLineArgs
diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs
index 06ee663..4d2ae48 100644
--- a/src/Hadrian/Utilities.hs
+++ b/src/Hadrian/Utilities.hs
@@ -10,7 +10,7 @@ module Hadrian.Utilities (
unifyPath, (-/-),
-- * Accessing Shake's type-indexed map
- insertExtra, userSetting,
+ insertExtra, lookupExtra, userSetting,
-- * Paths
BuildRoot (..), buildRoot, isGeneratedSource,
@@ -153,13 +153,18 @@ cmdLineLengthLimit | isWindows = 31000
insertExtra :: Typeable a => a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
insertExtra value = Map.insert (typeOf value) (toDyn value)
+-- | Lookup a value in Shake's type-indexed map.
+lookupExtra :: Typeable a => a -> Map.HashMap TypeRep Dynamic -> a
+lookupExtra defaultValue extra = fromMaybe defaultValue maybeValue
+ where
+ maybeValue = fromDynamic =<< Map.lookup (typeOf defaultValue) extra
+
-- | Lookup a user setting in Shake's type-indexed map 'shakeExtra'. If the
-- setting is not found, return the provided default value instead.
userSetting :: Typeable a => a -> Action a
userSetting defaultValue = do
extra <- shakeExtra <$> getShakeOptions
- let maybeValue = fromDynamic =<< Map.lookup (typeOf defaultValue) extra
- return $ fromMaybe defaultValue maybeValue
+ return $ lookupExtra defaultValue extra
newtype BuildRoot = BuildRoot FilePath deriving Typeable
diff --git a/src/Settings/Flavours/Development.hs b/src/Settings/Flavours/Development.hs
index a6a2892..713e409 100644
--- a/src/Settings/Flavours/Development.hs
+++ b/src/Settings/Flavours/Development.hs
@@ -4,7 +4,6 @@ import Flavour
import Expression
import {-# SOURCE #-} Settings.Default
--- TODO: Implement an equivalent of LAX_DEPENDENCIES = YES setting, see #250.
developmentFlavour :: Stage -> Flavour
developmentFlavour ghcStage = defaultFlavour
{ name = "devel" ++ show (fromEnum ghcStage)
More information about the ghc-commits
mailing list