Commit aff54c85 authored by Moritz Angermann's avatar Moritz Angermann
Browse files

Adds Oracle

parent b47bd516
...@@ -22,6 +22,7 @@ executable ghc-shake ...@@ -22,6 +22,7 @@ executable ghc-shake
, Expression , Expression
, GHC , GHC
, Oracles , Oracles
, Oracles.AbsoluteCommand
, Oracles.ArgsHash , Oracles.ArgsHash
, Oracles.Config , Oracles.Config
, Oracles.Config.Flag , Oracles.Config.Flag
...@@ -114,7 +115,6 @@ executable ghc-shake ...@@ -114,7 +115,6 @@ executable ghc-shake
, extra >= 1.4 , extra >= 1.4
, mtl >= 2.2 , mtl >= 2.2
, shake >= 0.15 , shake >= 0.15
, split >= 0.2
, transformers >= 0.4 , transformers >= 0.4
, unordered-containers >= 0.2 , unordered-containers >= 0.2
default-language: Haskell2010 default-language: Haskell2010
......
module Oracles ( module Oracles (
module Oracles.AbsoluteCommand,
module Oracles.Config, module Oracles.Config,
module Oracles.Config.Flag, module Oracles.Config.Flag,
module Oracles.Config.Setting, module Oracles.Config.Setting,
...@@ -8,6 +9,7 @@ module Oracles ( ...@@ -8,6 +9,7 @@ module Oracles (
module Oracles.WindowsRoot module Oracles.WindowsRoot
) where ) where
import Oracles.AbsoluteCommand
import Oracles.Config import Oracles.Config
import Oracles.Config.Flag import Oracles.Config.Flag
import Oracles.Config.Setting import Oracles.Config.Setting
......
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module Oracles.AbsoluteCommand (
lookupInPath, absoluteCommandOracle
) where
import Base
newtype AbsoluteCommand = AbsoluteCommand String
deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
absoluteCommand :: String -> Action String
absoluteCommand = askOracle . AbsoluteCommand
-- | Lookup a @command@ in @PATH@ environment.
lookupInPath :: FilePath -> Action FilePath
lookupInPath c
| c /= takeFileName c = return c
| otherwise = absoluteCommand c
-- | Split function. Splits a string @s@ into chunks
-- when the predicate @p@ holds. See: http://stackoverflow.com/a/4981265
wordsWhen :: (Char -> Bool) -> String -> [String]
wordsWhen p s =
case dropWhile p s of
"" -> []
s' -> w : wordsWhen p s''
where (w, s'') = break p s'
absoluteCommandOracle :: Rules ()
absoluteCommandOracle = do
o <- newCache $ \c -> do
envPaths <- wordsWhen (== ':') <$> getEnvWithDefault "" "PATH"
let candidates = map (-/- c) envPaths
-- this will crash if we do not find any valid candidate.
fullCommand <- head <$> filterM doesFileExist candidates
putOracle $ "Found '" ++ c ++ "' at " ++ "'" ++ fullCommand ++ "'"
return fullCommand
_ <- addOracle $ \(AbsoluteCommand c) -> o c
return ()
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module Oracles.WindowsRoot ( module Oracles.WindowsRoot (
windowsRoot, fixAbsolutePathOnWindows, lookupInPath, topDirectory, windowsRootOracle windowsRoot, fixAbsolutePathOnWindows, topDirectory, windowsRootOracle
) where ) where
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.List.Split (splitOn)
import Base import Base
import Oracles.Config.Setting import Oracles.Config.Setting
...@@ -39,16 +38,6 @@ fixAbsolutePathOnWindows path = do ...@@ -39,16 +38,6 @@ fixAbsolutePathOnWindows path = do
else else
return path return path
-- | Lookup a @command@ in @PATH@ environment.
lookupInPath :: FilePath -> Action FilePath
lookupInPath c
| c /= takeFileName c = return c
| otherwise = do
envPaths <- splitOn ":" <$> getEnvWithDefault "" "PATH"
let candidates = map (-/- c) envPaths
-- this will crash if we do not find any valid candidate.
head <$> filterM doesFileExist candidates
-- Oracle for windowsRoot. This operation requires caching as looking up -- Oracle for windowsRoot. This operation requires caching as looking up
-- the root is slow (at least the current implementation). -- the root is slow (at least the current implementation).
windowsRootOracle :: Rules () windowsRootOracle :: Rules ()
......
...@@ -7,10 +7,11 @@ import Oracles.ModuleFiles ...@@ -7,10 +7,11 @@ import Oracles.ModuleFiles
oracleRules :: Rules () oracleRules :: Rules ()
oracleRules = do oracleRules = do
argsHashOracle -- see Oracles.ArgsHash absoluteCommandOracle -- see Oracles.WindowsRoot
configOracle -- see Oracles.Config argsHashOracle -- see Oracles.ArgsHash
dependenciesOracle -- see Oracles.Dependencies configOracle -- see Oracles.Config
moduleFilesOracle -- see Oracles.ModuleFiles dependenciesOracle -- see Oracles.Dependencies
packageDataOracle -- see Oracles.PackageData moduleFilesOracle -- see Oracles.ModuleFiles
packageDepsOracle -- see Oracles.PackageDeps packageDataOracle -- see Oracles.PackageData
windowsRootOracle -- see Oracles.WindowsRoot packageDepsOracle -- see Oracles.PackageDeps
windowsRootOracle -- see Oracles.WindowsRoot
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