Drop double installation of Hadrian dependencies
[ghc.git] / src / Hadrian / Oracles / KeyValue.hs
1 {-# LANGUAGE TypeFamilies #-}
2 module Hadrian.Oracles.KeyValue (
3 lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues,
4 lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, keyValueOracle
5 ) where
6
7 import Control.Monad
8 import qualified Data.HashMap.Strict as Map
9 import Data.Maybe
10 import Development.Shake
11 import Development.Shake.Classes
12 import Development.Shake.Config
13
14 import Hadrian.Utilities
15
16 newtype KeyValue = KeyValue (FilePath, String)
17 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
18 type instance RuleResult KeyValue = Maybe String
19
20 newtype KeyValues = KeyValues (FilePath, String)
21 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
22 type instance RuleResult KeyValues = Maybe [String]
23
24 -- | Lookup a value in a text file, tracking the result. Each line of the file
25 -- is expected to have @key = value@ format.
26 lookupValue :: FilePath -> String -> Action (Maybe String)
27 lookupValue file key = askOracle $ KeyValue (file, key)
28
29 -- | Like 'lookupValue' but returns the empty string if the key is not found.
30 lookupValueOrEmpty :: FilePath -> String -> Action String
31 lookupValueOrEmpty file key = fromMaybe "" <$> lookupValue file key
32
33 -- | Like 'lookupValue' but raises an error if the key is not found.
34 lookupValueOrError :: FilePath -> String -> Action String
35 lookupValueOrError file key = (fromMaybe $ error msg) <$> lookupValue file key
36 where
37 msg = "Key " ++ quote key ++ " not found in file " ++ quote file
38
39 -- | Lookup a list of values in a text file, tracking the result. Each line of
40 -- the file is expected to have @key value1 value2 ...@ format.
41 lookupValues :: FilePath -> String -> Action (Maybe [String])
42 lookupValues file key = askOracle $ KeyValues (file, key)
43
44 -- | Like 'lookupValues' but returns the empty list if the key is not found.
45 lookupValuesOrEmpty :: FilePath -> String -> Action [String]
46 lookupValuesOrEmpty file key = fromMaybe [] <$> lookupValues file key
47
48 -- | Like 'lookupValues' but raises an error if the key is not found.
49 lookupValuesOrError :: FilePath -> String -> Action [String]
50 lookupValuesOrError file key = (fromMaybe $ error msg) <$> lookupValues file key
51 where
52 msg = "Key " ++ quote key ++ " not found in file " ++ quote file
53
54 -- | The 'Action' @lookupDependencies depFile file@ looks up dependencies of a
55 -- @file@ in a (typically generated) dependency file @depFile@. The action
56 -- returns a pair @(source, files)@, such that the @file@ can be produced by
57 -- compiling @source@, which in turn also depends on a number of other @files@.
58 lookupDependencies :: FilePath -> FilePath -> Action (FilePath, [FilePath])
59 lookupDependencies depFile file = do
60 deps <- lookupValues depFile file
61 case deps of
62 Nothing -> error $ "No dependencies found for file " ++ quote file
63 Just [] -> error $ "No source file found for file " ++ quote file
64 Just (source : files) -> return (source, files)
65
66 -- | This oracle reads and parses text files to answer 'lookupValue' and
67 -- 'lookupValues' queries, as well as their derivatives, tracking the results.
68 keyValueOracle :: Rules ()
69 keyValueOracle = void $ do
70 kv <- newCache $ \file -> do
71 need [file]
72 putLoud $ "Reading " ++ file ++ "..."
73 liftIO $ readConfigFile file
74 kvs <- newCache $ \file -> do
75 need [file]
76 putLoud $ "Reading " ++ file ++ "..."
77 contents <- map words <$> readFileLines file
78 return $ Map.fromList [ (key, values) | (key:values) <- contents ]
79 void $ addOracle $ \(KeyValue (file, key)) -> Map.lookup key <$> kv file
80 void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file