Commit cbee74bf authored by Andrey Mokhov's avatar Andrey Mokhov

Minor revision, drop old TODO

See #250
parent 837675cd
......@@ -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
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment