400171e48d9f83480af016bbc595fac1703f7560
[ghc.git] / src / Hadrian / Oracles / TextFile.hs
1 {-# LANGUAGE TypeFamilies #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Hadrian.Oracles.TextFile
5 -- Copyright : (c) Andrey Mokhov 2014-2017
6 -- License : MIT (see the file LICENSE)
7 -- Maintainer : andrey.mokhov@gmail.com
8 -- Stability : experimental
9 --
10 -- Read and parse text files, tracking their contents. This oracle can be used
11 -- to read configuration or package metadata files and cache the parsing.
12 -----------------------------------------------------------------------------
13 module Hadrian.Oracles.TextFile (
14 readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError,
15 lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies,
16 readCabalFile, readPackageDataFile, textFileOracle
17 ) where
18
19 import Control.Monad
20 import qualified Data.HashMap.Strict as Map
21 import Data.Maybe
22 import Development.Shake
23 import Development.Shake.Classes
24 import Development.Shake.Config
25
26 import Context.Type
27 import Hadrian.Haskell.Cabal.PackageData
28 import Hadrian.Haskell.Cabal.Type
29 import {-# SOURCE #-} Hadrian.Haskell.Cabal.Parse
30 import Hadrian.Package
31 import Hadrian.Utilities
32 import Stage
33
34 newtype TextFile = TextFile FilePath
35 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
36 type instance RuleResult TextFile = String
37
38 newtype CabalFile = CabalFile Context
39 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
40 type instance RuleResult CabalFile = Maybe Cabal
41
42 newtype PackageDataFile = PackageDataFile Context
43 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
44 type instance RuleResult PackageDataFile = Maybe PackageData
45
46 newtype KeyValue = KeyValue (FilePath, String)
47 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
48 type instance RuleResult KeyValue = Maybe String
49
50 newtype KeyValues = KeyValues (FilePath, String)
51 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
52 type instance RuleResult KeyValues = Maybe [String]
53
54 -- | Read a text file, caching and tracking the result. To read and track
55 -- individual lines of a text file use 'lookupValue' and its derivatives.
56 readTextFile :: FilePath -> Action String
57 readTextFile = askOracle . TextFile
58
59 -- | Lookup a value in a text file, tracking the result. Each line of the file
60 -- is expected to have @key = value@ format.
61 lookupValue :: FilePath -> String -> Action (Maybe String)
62 lookupValue file key = askOracle $ KeyValue (file, key)
63
64 -- | Like 'lookupValue' but returns the empty string if the key is not found.
65 lookupValueOrEmpty :: FilePath -> String -> Action String
66 lookupValueOrEmpty file key = fromMaybe "" <$> lookupValue file key
67
68 -- | Like 'lookupValue' but raises an error if the key is not found.
69 lookupValueOrError :: FilePath -> String -> Action String
70 lookupValueOrError file key = fromMaybe (error msg) <$> lookupValue file key
71 where
72 msg = "Key " ++ quote key ++ " not found in file " ++ quote file
73
74 -- | Lookup a list of values in a text file, tracking the result. Each line of
75 -- the file is expected to have @key value1 value2 ...@ format.
76 lookupValues :: FilePath -> String -> Action (Maybe [String])
77 lookupValues file key = askOracle $ KeyValues (file, key)
78
79 -- | Like 'lookupValues' but returns the empty list if the key is not found.
80 lookupValuesOrEmpty :: FilePath -> String -> Action [String]
81 lookupValuesOrEmpty file key = fromMaybe [] <$> lookupValues file key
82
83 -- | Like 'lookupValues' but raises an error if the key is not found.
84 lookupValuesOrError :: FilePath -> String -> Action [String]
85 lookupValuesOrError file key = fromMaybe (error msg) <$> lookupValues file key
86 where
87 msg = "Key " ++ quote key ++ " not found in file " ++ quote file
88
89 -- | The 'Action' @lookupDependencies depFile file@ looks up dependencies of a
90 -- @file@ in a (typically generated) dependency file @depFile@. The action
91 -- returns a pair @(source, files)@, such that the @file@ can be produced by
92 -- compiling @source@, which in turn also depends on a number of other @files@.
93 lookupDependencies :: FilePath -> FilePath -> Action (FilePath, [FilePath])
94 lookupDependencies depFile file = do
95 deps <- lookupValues depFile file
96 case deps of
97 Nothing -> error $ "No dependencies found for file " ++ quote file
98 Just [] -> error $ "No source file found for file " ++ quote file
99 Just (source : files) -> return (source, files)
100
101 -- | Read and parse a @.cabal@ file, caching and tracking the result.
102 readCabalFile :: Context -> Action (Maybe Cabal)
103 readCabalFile = askOracle . CabalFile
104
105 readPackageDataFile :: Context -> Action (Maybe PackageData)
106 readPackageDataFile = askOracle . PackageDataFile
107
108 -- | This oracle reads and parses text files to answer 'readTextFile' and
109 -- 'lookupValue' queries, as well as their derivatives, tracking the results.
110 textFileOracle :: Rules ()
111 textFileOracle = do
112 text <- newCache $ \file -> do
113 need [file]
114 putLoud $ "| TextFile oracle: reading " ++ quote file ++ "..."
115 liftIO $ readFile file
116 void $ addOracle $ \(TextFile file) -> text file
117
118 kv <- newCache $ \file -> do
119 need [file]
120 putLoud $ "| KeyValue oracle: reading " ++ quote file ++ "..."
121 liftIO $ readConfigFile file
122 void $ addOracle $ \(KeyValue (file, key)) -> Map.lookup key <$> kv file
123
124 kvs <- newCache $ \file -> do
125 need [file]
126 putLoud $ "| KeyValues oracle: reading " ++ quote file ++ "..."
127 contents <- map words <$> readFileLines file
128 return $ Map.fromList [ (key, values) | (key:values) <- contents ]
129 void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file
130
131 cabal <- newCache $ \(ctx@Context {..}) -> do
132 case pkgCabalFile package of
133 Just file -> do
134 need [file]
135 putLoud $ "| CabalFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..."
136 Just <$> parseCabal ctx
137 Nothing -> return Nothing
138
139 void $ addOracle $ \(CabalFile ctx) -> cabal ctx
140
141 confCabal <- newCache $ \(ctx@Context {..}) -> do
142 case pkgCabalFile package of
143 Just file -> do
144 need [file]
145 putLoud $ "| PackageDataFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..."
146 Just <$> parsePackageData ctx
147 Nothing -> return Nothing
148
149 void $ addOracle $ \(PackageDataFile ctx) -> confCabal ctx