[commit: ghc] wip/nfs-locking: Move DirectoryContents oracle to the library (7ff841e)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 01:22:14 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/7ff841eb492e16bedfb1d72152e5fc0de4d52c77/ghc
>---------------------------------------------------------------
commit 7ff841eb492e16bedfb1d72152e5fc0de4d52c77
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Sun Aug 6 01:31:02 2017 +0100
Move DirectoryContents oracle to the library
See #347
>---------------------------------------------------------------
7ff841eb492e16bedfb1d72152e5fc0de4d52c77
hadrian.cabal | 3 ++-
src/Base.hs | 14 +-------------
src/{ => Hadrian}/Oracles/DirectoryContents.hs | 18 +++++++++++-------
src/Hadrian/Utilities.hs | 19 +++++++++++++++++++
src/Rules/Install.hs | 3 ++-
src/Rules/Oracles.hs | 4 ++--
src/Rules/SourceDist.hs | 3 ++-
src/Util.hs | 2 +-
8 files changed, 40 insertions(+), 26 deletions(-)
diff --git a/hadrian.cabal b/hadrian.cabal
index 121ba74..b757549 100644
--- a/hadrian.cabal
+++ b/hadrian.cabal
@@ -28,12 +28,13 @@ executable hadrian
, GHC
, Hadrian.Expression
, Hadrian.Oracles.ArgsHash
+ , Hadrian.Oracles.DirectoryContents
, Hadrian.Target
+ , Hadrian.Utilities
, Oracles.Config
, Oracles.Config.Flag
, Oracles.Config.Setting
, Oracles.Dependencies
- , Oracles.DirectoryContents
, Oracles.ModuleFiles
, Oracles.PackageData
, Oracles.Path
diff --git a/src/Base.hs b/src/Base.hs
index 9e2922b..7443438 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -33,6 +33,7 @@ import Data.Semigroup
import Development.Shake hiding (parallel, unit, (*>), Normal)
import Development.Shake.Classes
import Development.Shake.FilePath
+import Hadrian.Utilities
import System.Console.ANSI
import System.IO
import System.Info
@@ -72,19 +73,6 @@ replaceWhen p to = map (\from -> if p from then to else from)
quote :: String -> String
quote s = "'" ++ s ++ "'"
--- | Normalise a path and convert all path separators to @/@, even on Windows.
-unifyPath :: FilePath -> FilePath
-unifyPath = toStandard . normaliseEx
-
--- | Combine paths with a forward slash regardless of platform.
-(-/-) :: FilePath -> FilePath -> FilePath
-"" -/- b = b
-a -/- b
- | last a == '/' = a ++ b
- | otherwise = a ++ '/' : b
-
-infixr 6 -/-
-
-- Explicit definition to avoid dependency on Data.List.Ordered
-- | Difference of two ordered lists.
minusOrd :: Ord a => [a] -> [a] -> [a]
diff --git a/src/Oracles/DirectoryContents.hs b/src/Hadrian/Oracles/DirectoryContents.hs
similarity index 82%
rename from src/Oracles/DirectoryContents.hs
rename to src/Hadrian/Oracles/DirectoryContents.hs
index 1f016ff..e52c5c5 100644
--- a/src/Oracles/DirectoryContents.hs
+++ b/src/Hadrian/Oracles/DirectoryContents.hs
@@ -1,12 +1,15 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric #-}
-module Oracles.DirectoryContents (
+module Hadrian.Oracles.DirectoryContents (
directoryContents, directoryContentsOracle, Match (..), matchAll
) where
-import System.Directory.Extra
+import Control.Monad
+import Development.Shake
+import Development.Shake.Classes
import GHC.Generics
+import System.Directory.Extra
-import Base
+import Hadrian.Utilities
newtype DirectoryContents = DirectoryContents (Match, FilePath)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
@@ -14,6 +17,10 @@ newtype DirectoryContents = DirectoryContents (Match, FilePath)
data Match = Test FilePattern | Not Match | And [Match] | Or [Match]
deriving (Generic, Eq, Show, Typeable)
+instance Binary Match
+instance Hashable Match
+instance NFData Match
+
-- | A 'Match' expression that always evaluates to 'True' (i.e. always matches).
matchAll :: Match
matchAll = And []
@@ -30,11 +37,8 @@ matches (Or ms) f = any (`matches` f) ms
directoryContents :: Match -> FilePath -> Action [FilePath]
directoryContents expr dir = askOracle $ DirectoryContents (expr, dir)
+-- | This oracle answers 'directoryContents' queries and tracks the results.
directoryContentsOracle :: Rules ()
directoryContentsOracle = void $
addOracle $ \(DirectoryContents (expr, dir)) -> liftIO $ map unifyPath .
filter (matches expr) <$> listFilesInside (return . matches expr) dir
-
-instance Binary Match
-instance Hashable Match
-instance NFData Match
diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs
new file mode 100644
index 0000000..2103452
--- /dev/null
+++ b/src/Hadrian/Utilities.hs
@@ -0,0 +1,19 @@
+module Hadrian.Utilities (
+ -- * FilePath manipulation
+ unifyPath, (-/-)
+ ) where
+
+import Development.Shake.FilePath
+
+-- | Normalise a path and convert all path separators to @/@, even on Windows.
+unifyPath :: FilePath -> FilePath
+unifyPath = toStandard . normaliseEx
+
+-- | Combine paths with a forward slash regardless of platform.
+(-/-) :: FilePath -> FilePath -> FilePath
+"" -/- b = b
+a -/- b
+ | last a == '/' = a ++ b
+ | otherwise = a ++ '/' : b
+
+infixr 6 -/-
diff --git a/src/Rules/Install.hs b/src/Rules/Install.hs
index 66e57bf..f90b480 100644
--- a/src/Rules/Install.hs
+++ b/src/Rules/Install.hs
@@ -1,6 +1,8 @@
{-# LANGUAGE FlexibleContexts #-}
module Rules.Install (installRules) where
+import Hadrian.Oracles.DirectoryContents
+
import Base
import Target
import Context
@@ -16,7 +18,6 @@ import Rules.Generate
import Settings.Packages.Rts
import Oracles.Config.Setting
import Oracles.Dependencies
-import Oracles.DirectoryContents
import Oracles.Path
import qualified System.Directory as IO
diff --git a/src/Rules/Oracles.hs b/src/Rules/Oracles.hs
index a12bec4..59b55d9 100644
--- a/src/Rules/Oracles.hs
+++ b/src/Rules/Oracles.hs
@@ -1,11 +1,11 @@
module Rules.Oracles (oracleRules) where
import qualified Hadrian.Oracles.ArgsHash
+import qualified Hadrian.Oracles.DirectoryContents
import Base
import qualified Oracles.Config
import qualified Oracles.Dependencies
-import qualified Oracles.DirectoryContents
import qualified Oracles.ModuleFiles
import qualified Oracles.PackageData
import qualified Oracles.Path
@@ -15,9 +15,9 @@ import Settings
oracleRules :: Rules ()
oracleRules = do
Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs
+ Hadrian.Oracles.DirectoryContents.directoryContentsOracle
Oracles.Config.configOracle
Oracles.Dependencies.dependenciesOracles
- Oracles.DirectoryContents.directoryContentsOracle
Oracles.ModuleFiles.moduleFilesOracle
Oracles.PackageData.packageDataOracle
Oracles.Path.pathOracle
diff --git a/src/Rules/SourceDist.hs b/src/Rules/SourceDist.hs
index 40a4156..879ae34 100644
--- a/src/Rules/SourceDist.hs
+++ b/src/Rules/SourceDist.hs
@@ -1,9 +1,10 @@
module Rules.SourceDist (sourceDistRules) where
+import Hadrian.Oracles.DirectoryContents
+
import Base
import Builder
import Oracles.Config.Setting
-import Oracles.DirectoryContents
import Rules.Clean
import UserSettings
import Util
diff --git a/src/Util.hs b/src/Util.hs
index c4b888d..a616b04 100644
--- a/src/Util.hs
+++ b/src/Util.hs
@@ -12,13 +12,13 @@ import qualified System.IO as IO
import qualified Control.Exception.Base as IO
import Hadrian.Oracles.ArgsHash
+import Hadrian.Oracles.DirectoryContents
import Base
import CmdLineFlag
import Context
import Expression
import GHC
-import Oracles.DirectoryContents
import Oracles.Path
import Oracles.Config.Setting
import Settings
More information about the ghc-commits
mailing list