Oracles.hs 2.96 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]
Andrey Mokhov's avatar
Andrey Mokhov committed
38
        putOracle $ "Parsing " ++ toStandard 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
45
                                    ++ toStandard userConfig ++ "..."
                          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]
Andrey Mokhov's avatar
Andrey Mokhov committed
62
        putOracle $ "Parsing " ++ toStandard file ++ "..."
63
        liftIO $ readConfigFile file
Andrey Mokhov's avatar
Andrey Mokhov committed
64
    addOracle $ \(PackageDataKey (file, key)) -> M.lookup key <$> pkgData file
65
    return ()
Andrey Mokhov's avatar
Andrey Mokhov committed
66

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

Andrey Mokhov's avatar
Andrey Mokhov committed
81
oracleRules :: Rules ()
Andrey Mokhov's avatar
Andrey Mokhov committed
82
83
84
85
86
oracleRules = configOracle <> packageDataOracle <> dependencyOracle

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