Oracles.hs 2.84 KB
Newer Older
1
module Oracles (
2
    module Oracles.Base,
3
    configOracle, packageDataOracle, dependencyOracle
4
5
    ) where

6
import Development.Shake.Config
Andrey Mokhov's avatar
Andrey Mokhov committed
7
import Development.Shake.Util
8
import qualified Data.HashMap.Strict as M
Andrey Mokhov's avatar
Andrey Mokhov committed
9
-- TODO: get rid of Bifunctor dependency
Andrey Mokhov's avatar
Andrey Mokhov committed
10
import Data.Bifunctor
11
import Base
12
import Util
13
import Config
14
15
import Oracles.Base
import Oracles.PackageData
16
import Control.Monad.Extra
Andrey Mokhov's avatar
Andrey Mokhov committed
17
import Oracles.DependencyList
18

Andrey Mokhov's avatar
Andrey Mokhov committed
19
20
21
22
defaultConfig, userConfig :: FilePath
defaultConfig = cfgPath </> "default.config"
userConfig    = cfgPath </> "user.config"

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

Andrey Mokhov's avatar
Andrey Mokhov committed
51
-- Oracle for 'package-data.mk' files
Andrey Mokhov's avatar
Andrey Mokhov committed
52
53
packageDataOracle :: Rules ()
packageDataOracle = do
54
55
    pkgData <- newCache $ \file -> do
        need [file]
Andrey Mokhov's avatar
Andrey Mokhov committed
56
        putOracle $ "Reading " ++ file ++ "..."
57
        liftIO $ readConfigFile file
58
59
    addOracle $ \(PackageDataKey (file, key)) ->
        M.lookup key <$> pkgData (unifyPath file)
60
    return ()
Andrey Mokhov's avatar
Andrey Mokhov committed
61

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

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