Fix Windows build, improve error reporting (#565)
[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, unsafeReadCabalFile, 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 import GHC.Stack
26
27 import Context.Type
28 import Hadrian.Haskell.Cabal.PackageData
29 import Hadrian.Haskell.Cabal.Type
30 import {-# SOURCE #-} Hadrian.Haskell.Cabal.Parse
31 import Hadrian.Package
32 import Hadrian.Utilities
33 import Stage
34
35 newtype TextFile = TextFile FilePath
36 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
37 type instance RuleResult TextFile = String
38
39 newtype CabalFile = CabalFile Context
40 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
41 type instance RuleResult CabalFile = Maybe Cabal
42
43 newtype PackageDataFile = PackageDataFile Context
44 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
45 type instance RuleResult PackageDataFile = Maybe PackageData
46
47 newtype KeyValue = KeyValue (FilePath, String)
48 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
49 type instance RuleResult KeyValue = Maybe String
50
51 newtype KeyValues = KeyValues (FilePath, String)
52 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
53 type instance RuleResult KeyValues = Maybe [String]
54
55 -- | Read a text file, caching and tracking the result. To read and track
56 -- individual lines of a text file use 'lookupValue' and its derivatives.
57 readTextFile :: FilePath -> Action String
58 readTextFile = askOracle . TextFile
59
60 -- | Lookup a value in a text file, tracking the result. Each line of the file
61 -- is expected to have @key = value@ format.
62 lookupValue :: FilePath -> String -> Action (Maybe String)
63 lookupValue file key = askOracle $ KeyValue (file, key)
64
65 -- | Like 'lookupValue' but returns the empty string if the key is not found.
66 lookupValueOrEmpty :: FilePath -> String -> Action String
67 lookupValueOrEmpty file key = fromMaybe "" <$> lookupValue file key
68
69 -- | Like 'lookupValue' but raises an error if the key is not found.
70 lookupValueOrError :: FilePath -> String -> Action String
71 lookupValueOrError file key = fromMaybe (error msg) <$> lookupValue file key
72 where
73 msg = "Key " ++ quote key ++ " not found in file " ++ quote file
74
75 -- | Lookup a list of values in a text file, tracking the result. Each line of
76 -- the file is expected to have @key value1 value2 ...@ format.
77 lookupValues :: FilePath -> String -> Action (Maybe [String])
78 lookupValues file key = askOracle $ KeyValues (file, key)
79
80 -- | Like 'lookupValues' but returns the empty list if the key is not found.
81 lookupValuesOrEmpty :: FilePath -> String -> Action [String]
82 lookupValuesOrEmpty file key = fromMaybe [] <$> lookupValues file key
83
84 -- | Like 'lookupValues' but raises an error if the key is not found.
85 lookupValuesOrError :: FilePath -> String -> Action [String]
86 lookupValuesOrError file key = fromMaybe (error msg) <$> lookupValues file key
87 where
88 msg = "Key " ++ quote key ++ " not found in file " ++ quote file
89
90 -- | The 'Action' @lookupDependencies depFile file@ looks up dependencies of a
91 -- @file@ in a (typically generated) dependency file @depFile@. The action
92 -- returns a pair @(source, files)@, such that the @file@ can be produced by
93 -- compiling @source@, which in turn also depends on a number of other @files@.
94 lookupDependencies :: FilePath -> FilePath -> Action (FilePath, [FilePath])
95 lookupDependencies depFile file = do
96 deps <- lookupValues depFile file
97 case deps of
98 Nothing -> error $ "No dependencies found for file " ++ quote file
99 Just [] -> error $ "No source file found for file " ++ quote file
100 Just (source : files) -> return (source, files)
101
102 -- | Read and parse a @.cabal@ file, caching and tracking the result.
103 readCabalFile :: Context -> Action (Maybe Cabal)
104 readCabalFile = askOracle . CabalFile
105
106 -- | Like 'readCabalFile' but raises an error on a non-Cabal context.
107 unsafeReadCabalFile :: HasCallStack => Context -> Action Cabal
108 unsafeReadCabalFile context = fromMaybe (error msg) <$> readCabalFile context
109 where
110 msg = "[unsafeReadCabalFile] Non-Cabal context: " ++ show context
111
112 readPackageDataFile :: Context -> Action (Maybe PackageData)
113 readPackageDataFile = askOracle . PackageDataFile
114
115 -- | This oracle reads and parses text files to answer 'readTextFile' and
116 -- 'lookupValue' queries, as well as their derivatives, tracking the results.
117 textFileOracle :: Rules ()
118 textFileOracle = do
119 text <- newCache $ \file -> do
120 need [file]
121 putLoud $ "| TextFile oracle: reading " ++ quote file ++ "..."
122 liftIO $ readFile file
123 void $ addOracle $ \(TextFile file) -> text file
124
125 kv <- newCache $ \file -> do
126 need [file]
127 putLoud $ "| KeyValue oracle: reading " ++ quote file ++ "..."
128 liftIO $ readConfigFile file
129 void $ addOracle $ \(KeyValue (file, key)) -> Map.lookup key <$> kv file
130
131 kvs <- newCache $ \file -> do
132 need [file]
133 putLoud $ "| KeyValues oracle: reading " ++ quote file ++ "..."
134 contents <- map words <$> readFileLines file
135 return $ Map.fromList [ (key, values) | (key:values) <- contents ]
136 void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file
137
138 cabal <- newCache $ \(ctx@Context {..}) -> do
139 case pkgCabalFile package of
140 Just file -> do
141 need [file]
142 putLoud $ "| CabalFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..."
143 Just <$> parseCabal ctx
144 Nothing -> return Nothing
145
146 void $ addOracle $ \(CabalFile ctx) -> cabal ctx
147
148 confCabal <- newCache $ \(ctx@Context {..}) -> do
149 case pkgCabalFile package of
150 Just file -> do
151 need [file]
152 putLoud $ "| PackageDataFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..."
153 Just <$> parsePackageData ctx
154 Nothing -> return Nothing
155
156 void $ addOracle $ \(PackageDataFile ctx) -> confCabal ctx