Oracles.hs 3.03 KB
Newer Older
1
module Oracles (
2
3
4
5
6
    module Oracles.Base,
    module Oracles.Flag,
    module Oracles.Option,
    module Oracles.Builder,
    module Oracles.PackageData,
Andrey Mokhov's avatar
Andrey Mokhov committed
7
    module Oracles.DependencyList,
8
9
10
    oracleRules
    ) where

11
import Development.Shake.Config
Andrey Mokhov's avatar
Andrey Mokhov committed
12
import Development.Shake.Util
13
import qualified Data.HashMap.Strict as M
Andrey Mokhov's avatar
Andrey Mokhov committed
14
import Data.Bifunctor
15
import Base
16
import Util
17
import Config
18
19
20
21
22
import Oracles.Base
import Oracles.Flag
import Oracles.Option
import Oracles.Builder
import Oracles.PackageData
Andrey Mokhov's avatar
Andrey Mokhov committed
23
import Oracles.DependencyList
24

Andrey Mokhov's avatar
Andrey Mokhov committed
25
26
27
28
defaultConfig, userConfig :: FilePath
defaultConfig = cfgPath </> "default.config"
userConfig    = cfgPath </> "user.config"

Andrey Mokhov's avatar
Andrey Mokhov committed
29
-- Oracle for configuration files
Andrey Mokhov's avatar
Andrey Mokhov committed
30
31
configOracle :: Rules ()
configOracle = do
32
    cfg <- newCache $ \() -> do
Andrey Mokhov's avatar
Andrey Mokhov committed
33
34
35
36
        unless (doesFileExist $ defaultConfig <.> "in") $
            redError_ $ "\nDefault configuration file '"
                      ++ (defaultConfig <.> "in")
                      ++ "' is missing; unwilling to proceed."
Andrey Mokhov's avatar
Andrey Mokhov committed
37
        need [defaultConfig]
38
        putOracle $ "Parsing " ++ unifyPath defaultConfig ++ "..."
Andrey Mokhov's avatar
Andrey Mokhov committed
39
40
        cfgDefault <- liftIO $ readConfigFile defaultConfig
        existsUser <- doesFileExist userConfig
41
        cfgUser    <- if existsUser
42
                      then do
Andrey Mokhov's avatar
Andrey Mokhov committed
43
                          putOracle $ "Parsing "
44
                                    ++ unifyPath userConfig ++ "..."
45
                          liftIO $ readConfigFile userConfig
46
                      else do
Andrey Mokhov's avatar
Andrey Mokhov committed
47
                          putColoured Red $
48
                              "\nUser defined configuration file '"
Andrey Mokhov's avatar
Andrey Mokhov committed
49
50
                              ++ userConfig ++ "' is missing; "
                              ++ "proceeding with default configuration.\n"
51
                          return M.empty
Andrey Mokhov's avatar
Andrey Mokhov committed
52
        putColoured Green $ "Finished processing configuration files."
53
        return $ cfgUser `M.union` cfgDefault
54
    addOracle $ \(ConfigKey key) -> M.lookup key <$> cfg ()
Andrey Mokhov's avatar
Andrey Mokhov committed
55
    return ()
56

Andrey Mokhov's avatar
Andrey Mokhov committed
57
-- Oracle for 'package-data.mk' files
Andrey Mokhov's avatar
Andrey Mokhov committed
58
59
packageDataOracle :: Rules ()
packageDataOracle = do
60
61
    pkgData <- newCache $ \file -> do
        need [file]
62
        putOracle $ "Parsing " ++ file ++ "..."
63
        liftIO $ readConfigFile file
64
65
    addOracle $ \(PackageDataKey (file, key)) ->
        M.lookup key <$> pkgData (unifyPath file)
66
    return ()
Andrey Mokhov's avatar
Andrey Mokhov committed
67

Andrey Mokhov's avatar
Andrey Mokhov committed
68
69
70
-- Oracle for 'path/dist/*.deps' files
dependencyOracle :: Rules ()
dependencyOracle = do
71
72
73
74
    deps <- newCache $ \file -> do
        need [file]
        putOracle $ "Parsing " ++ file ++ "..."
        contents <- parseMakefile <$> (liftIO $ readFile file)
Andrey Mokhov's avatar
Andrey Mokhov committed
75
        return $ M.fromList
76
               $ map (bimap unifyPath (map unifyPath))
Andrey Mokhov's avatar
Andrey Mokhov committed
77
78
79
               $ map (bimap head concat . unzip)
               $ groupBy ((==) `on` fst)
               $ sortBy (compare `on` fst) contents
80
    addOracle $ \(DependencyListKey (file, obj)) ->
81
        M.lookup (unifyPath obj) <$> deps (unifyPath file)
Andrey Mokhov's avatar
Andrey Mokhov committed
82
83
    return ()

Andrey Mokhov's avatar
Andrey Mokhov committed
84
oracleRules :: Rules ()
Andrey Mokhov's avatar
Andrey Mokhov committed
85
86
87
88
89
oracleRules = configOracle <> packageDataOracle <> dependencyOracle

-- Make oracle's output more distinguishable
putOracle :: String -> Action ()
putOracle = putColoured Blue