Commit a644c321 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Add DependencyList oracle.

parent a5a2fed8
......@@ -4,11 +4,14 @@ module Oracles (
module Oracles.Option,
module Oracles.Builder,
module Oracles.PackageData,
module Oracles.DependencyList,
oracleRules
) where
import Development.Shake.Config
import Development.Shake.Util
import qualified Data.HashMap.Strict as M
import Data.Bifunctor
import Base
import Util
import Config
......@@ -17,49 +20,67 @@ import Oracles.Flag
import Oracles.Option
import Oracles.Builder
import Oracles.PackageData
import Oracles.DependencyList
defaultConfig, userConfig :: FilePath
defaultConfig = cfgPath </> "default.config"
userConfig = cfgPath </> "user.config"
-- Oracle for configuration files.
-- Oracle for configuration files
configOracle :: Rules ()
configOracle = do
cfg <- newCache $ \() -> do
unless (doesFileExist $ defaultConfig <.> "in") $ do
error $ "\nDefault configuration file '"
++ (defaultConfig <.> "in")
++ "' is missing; unwilling to proceed."
return ()
unless (doesFileExist $ defaultConfig <.> "in") $
redError_ $ "\nDefault configuration file '"
++ (defaultConfig <.> "in")
++ "' is missing; unwilling to proceed."
need [defaultConfig]
putNormal $ "Parsing " ++ toStandard defaultConfig ++ "..."
putOracle $ "Parsing " ++ toStandard defaultConfig ++ "..."
cfgDefault <- liftIO $ readConfigFile defaultConfig
existsUser <- doesFileExist userConfig
cfgUser <- if existsUser
then do
putNormal $ "Parsing "
putOracle $ "Parsing "
++ toStandard userConfig ++ "..."
liftIO $ readConfigFile userConfig
else do
putColoured Dull Red $
putColoured Red $
"\nUser defined configuration file '"
++ userConfig ++ "' is missing; "
++ "proceeding with default configuration.\n"
return M.empty
putColoured Vivid Green $ "Finished processing configuration files."
putColoured Green $ "Finished processing configuration files."
return $ cfgUser `M.union` cfgDefault
addOracle $ \(ConfigKey key) -> M.lookup key <$> cfg ()
return ()
-- Oracle for 'package-data.mk' files.
-- Oracle for 'package-data.mk' files
packageDataOracle :: Rules ()
packageDataOracle = do
pkgData <- newCache $ \file -> do
need [file]
putNormal $ "Parsing " ++ toStandard file ++ "..."
putOracle $ "Parsing " ++ toStandard file ++ "..."
liftIO $ readConfigFile file
addOracle $ \(PackageDataKey (file, key)) -> M.lookup key <$> pkgData file
return ()
-- 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 ()
oracleRules :: Rules ()
oracleRules = configOracle <> packageDataOracle
oracleRules = configOracle <> packageDataOracle <> dependencyOracle
-- Make oracle's output more distinguishable
putOracle :: String -> Action ()
putOracle = putColoured Blue
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module Oracles.DependencyList (
DependencyList (..),
DependencyListKey (..)
) where
import Development.Shake.Classes
import Base
import Data.Maybe
data DependencyList = DependencyList FilePath FilePath
newtype DependencyListKey = DependencyListKey (FilePath, FilePath)
deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
instance ShowArgs DependencyList where
showArgs (DependencyList file obj) = do
res <- askOracle $ DependencyListKey (file, obj)
return $ fromMaybe [] res
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment