Oracles.hs 2.03 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 9
import qualified Data.HashMap.Strict as M
import Base
10
import Util
11
import Config
12
import Control.Monad.Extra
13 14
import Oracles.Base
import Oracles.PackageData
Andrey Mokhov's avatar
Andrey Mokhov committed
15
import Oracles.DependencyList
16
import Data.List
17

Andrey Mokhov's avatar
Andrey Mokhov committed
18
-- Oracle for configuration files
Andrey Mokhov's avatar
Andrey Mokhov committed
19 20
configOracle :: Rules ()
configOracle = do
21
    let configFile = cfgPath </> "system.config"
22
    cfg <- newCache $ \() -> do
23 24
        unlessM (doesFileExist $ configFile <.> "in") $
            redError_ $ "\nConfiguration file '" ++ (configFile <.> "in")
Andrey Mokhov's avatar
Andrey Mokhov committed
25
                      ++ "' is missing; unwilling to proceed."
26 27 28
        need [configFile]
        putOracle $ "Reading " ++ unifyPath configFile ++ "..."
        liftIO $ readConfigFile configFile
29
    addOracle $ \(ConfigKey key) -> M.lookup key <$> cfg ()
Andrey Mokhov's avatar
Andrey Mokhov committed
30
    return ()
31

Andrey Mokhov's avatar
Andrey Mokhov committed
32
-- Oracle for 'package-data.mk' files
Andrey Mokhov's avatar
Andrey Mokhov committed
33 34
packageDataOracle :: Rules ()
packageDataOracle = do
35 36
    pkgData <- newCache $ \file -> do
        need [file]
Andrey Mokhov's avatar
Andrey Mokhov committed
37
        putOracle $ "Reading " ++ file ++ "..."
38
        liftIO $ readConfigFile file
39 40
    addOracle $ \(PackageDataKey (file, key)) ->
        M.lookup key <$> pkgData (unifyPath file)
41
    return ()
Andrey Mokhov's avatar
Andrey Mokhov committed
42

43 44 45
bimap :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
bimap f g (x, y) = (f x, g y)

Andrey Mokhov's avatar
Andrey Mokhov committed
46 47 48
-- Oracle for 'path/dist/*.deps' files
dependencyOracle :: Rules ()
dependencyOracle = do
49 50
    deps <- newCache $ \file -> do
        need [file]
Andrey Mokhov's avatar
Andrey Mokhov committed
51
        putOracle $ "Reading " ++ file ++ "..."
52
        contents <- parseMakefile <$> (liftIO $ readFile file)
Andrey Mokhov's avatar
Andrey Mokhov committed
53
        return $ M.fromList
54
               $ map (bimap unifyPath (map unifyPath))
Andrey Mokhov's avatar
Andrey Mokhov committed
55 56 57
               $ map (bimap head concat . unzip)
               $ groupBy ((==) `on` fst)
               $ sortBy (compare `on` fst) contents
58
    addOracle $ \(DependencyListKey (file, obj)) ->
59
        M.lookup (unifyPath obj) <$> deps (unifyPath file)
Andrey Mokhov's avatar
Andrey Mokhov committed
60 61 62 63 64
    return ()

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