[commit: ghc] wip/nfs-locking: Factor out generic predicates into the library (65c5d7c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/65c5d7c6f75a583439b6c52ce4a89e6026cf76dc/ghc

>---------------------------------------------------------------

commit 65c5d7c6f75a583439b6c52ce4a89e6026cf76dc
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sun Aug 6 23:18:51 2017 +0100

    Factor out generic predicates into the library
    
    See #347


>---------------------------------------------------------------

65c5d7c6f75a583439b6c52ce4a89e6026cf76dc
 hadrian.cabal                   |  3 ++-
 src/Expression.hs               | 16 ---------------
 src/Hadrian/Expression.hs       | 43 +++++++++++++++++++++++++++++++----------
 src/Hadrian/Oracles/ArgsHash.hs |  2 +-
 4 files changed, 36 insertions(+), 28 deletions(-)

diff --git a/hadrian.cabal b/hadrian.cabal
index e1505aa..93a755c 100644
--- a/hadrian.cabal
+++ b/hadrian.cabal
@@ -102,7 +102,6 @@ executable hadrian
                        , UserSettings
                        , Util
                        , Way
-
     default-language:    Haskell2010
     default-extensions:  RecordWildCards
     other-extensions:    DeriveFunctor
@@ -110,8 +109,10 @@ executable hadrian
                        , FlexibleInstances
                        , GeneralizedNewtypeDeriving
                        , LambdaCase
+                       , MultiParamTypeClasses
                        , OverloadedStrings
                        , ScopedTypeVariables
+                       , TypeFamilies
     build-depends:       base >= 4.8 && < 5
                        , ansi-terminal        == 0.6.*
                        , Cabal                == 2.0.0.2
diff --git a/src/Expression.hs b/src/Expression.hs
index 274613c..0442c23 100644
--- a/src/Expression.hs
+++ b/src/Expression.hs
@@ -29,7 +29,6 @@ module Expression (
 
 import Control.Monad.Extra
 import Data.Semigroup
-import Development.Shake
 
 import qualified Hadrian.Expression as H
 import Hadrian.Expression hiding (Expr, Predicate, Args)
@@ -107,18 +106,3 @@ notPackage = notM . package
 libraryPackage :: Predicate
 libraryPackage = isLibrary <$> getPackage
 
--- | Does any of the input files match a given pattern?
-input :: FilePattern -> Predicate
-input f = any (f ?==) <$> getInputs
-
--- | Does any of the input files match any of the given patterns?
-inputs :: [FilePattern] -> Predicate
-inputs = anyM input
-
--- | Does any of the output files match a given pattern?
-output :: FilePattern -> Predicate
-output f = any (f ?==) <$> getOutputs
-
--- | Does any of the output files match any of the given patterns?
-outputs :: [FilePattern] -> Predicate
-outputs = anyM output
diff --git a/src/Hadrian/Expression.hs b/src/Hadrian/Expression.hs
index 8010695..4022f02 100644
--- a/src/Hadrian/Expression.hs
+++ b/src/Hadrian/Expression.hs
@@ -1,11 +1,14 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
 module Hadrian.Expression (
     -- * Expressions
     Expr, Predicate, Args,
 
     -- ** Construction and modification
-    expr, exprIO, arg, remove, (?),
+    expr, exprIO, arg, remove,
+
+    -- ** Predicates
+    (?), input, inputs, output, outputs,
 
     -- ** Evaluation
     interpret, interpretInContext,
@@ -14,12 +17,14 @@ module Hadrian.Expression (
     getContext, getBuilder, getOutputs, getInputs, getInput, getOutput
     ) where
 
+import Control.Monad.Extra
 import Control.Monad.Trans
 import Control.Monad.Trans.Reader
 import Data.Semigroup
 import Development.Shake
 
-import Hadrian.Target
+import qualified Hadrian.Target as Target
+import Hadrian.Target (Target, target)
 import Hadrian.Utilities
 
 -- | 'Expr' @c b a@ is a computation that produces a value of type 'Action' @a@
@@ -71,7 +76,7 @@ p ? e = do
     bool <- toPredicate p
     if bool then e else mempty
 
-instance ToPredicate (Predicate c b) c b where
+instance (c ~ c', b ~ b') => ToPredicate (Predicate c b) c' b' where
     toPredicate = id
 
 instance ToPredicate Bool c b where
@@ -93,28 +98,46 @@ interpretInContext c = interpret $ target c
 
 -- | Get the current build 'Context'.
 getContext :: Expr c b c
-getContext = Expr $ asks context
+getContext = Expr $ asks Target.context
 
 -- | Get the 'Builder' for the current 'Target'.
 getBuilder :: Expr c b b
-getBuilder = Expr $ asks builder
+getBuilder = Expr $ asks Target.builder
 
 -- | Get the input files of the current 'Target'.
 getInputs :: Expr c b [FilePath]
-getInputs = Expr $ asks inputs
+getInputs = Expr $ asks Target.inputs
 
 -- | Run 'getInputs' and check that the result contains one input file only.
 getInput :: (Show b, Show c) => Expr c b FilePath
 getInput = Expr $ do
     target <- ask
-    fromSingleton ("Exactly one input file expected in " ++ show target) <$> asks inputs
+    fromSingleton ("Exactly one input file expected in " ++ show target) <$>
+        asks Target.inputs
 
 -- | Get the files produced by the current 'Target'.
 getOutputs :: Expr c b [FilePath]
-getOutputs = Expr $ asks outputs
+getOutputs = Expr $ asks Target.outputs
 
 -- | Run 'getOutputs' and check that the result contains one output file only.
 getOutput :: (Show b, Show c) => Expr c b FilePath
 getOutput = Expr $ do
     target <- ask
-    fromSingleton ("Exactly one output file expected in " ++ show target) <$> asks outputs
+    fromSingleton ("Exactly one output file expected in " ++ show target) <$>
+        asks Target.outputs
+
+-- | Does any of the input files match a given pattern?
+input :: FilePattern -> Predicate c b
+input f = any (f ?==) <$> getInputs
+
+-- | Does any of the input files match any of the given patterns?
+inputs :: [FilePattern] -> Predicate c b
+inputs = anyM input
+
+-- | Does any of the output files match a given pattern?
+output :: FilePattern -> Predicate c b
+output f = any (f ?==) <$> getOutputs
+
+-- | Does any of the output files match any of the given patterns?
+outputs :: [FilePattern] -> Predicate c b
+outputs = anyM output
\ No newline at end of file
diff --git a/src/Hadrian/Oracles/ArgsHash.hs b/src/Hadrian/Oracles/ArgsHash.hs
index 68b67e2..e07fc3f 100644
--- a/src/Hadrian/Oracles/ArgsHash.hs
+++ b/src/Hadrian/Oracles/ArgsHash.hs
@@ -7,7 +7,7 @@ import Control.Monad
 import Development.Shake
 import Development.Shake.Classes
 
-import Hadrian.Expression
+import Hadrian.Expression hiding (inputs, outputs)
 import Hadrian.Target
 
 -- | 'TrackArgument' is used to specify the arguments that should be tracked by