Minor revision, drop old TODO
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Mon, 9 Oct 2017 23:37:42 +0000 (00:37 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Mon, 9 Oct 2017 23:37:42 +0000 (00:37 +0100)
See #250

src/CommandLine.hs
src/Hadrian/Utilities.hs
src/Settings/Flavours/Development.hs

index a069c0e..ed6441c 100644 (file)
@@ -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
index 06ee663..4d2ae48 100644 (file)
@@ -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
 
index a6a2892..713e409 100644 (file)
@@ -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)