Oracles.hs 3.07 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
-- TODO: get rid of Bifunctor dependency
Andrey Mokhov's avatar
Andrey Mokhov committed
15
import Data.Bifunctor
16
import Base
17
import Util
18
import Config
19
20
21
22
23
import Oracles.Base
import Oracles.Flag
import Oracles.Option
import Oracles.Builder
import Oracles.PackageData
Andrey Mokhov's avatar
Andrey Mokhov committed
24
import Oracles.DependencyList
25

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

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

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

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

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

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