[commit: ghc] wip/nfs-locking: Drop parameterisation by monad in Expression. (fdb6117)

[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/fdb6117f21e3bc39ae97bf0f12c0fc3caf10e093/ghc

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

commit fdb6117f21e3bc39ae97bf0f12c0fc3caf10e093
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Mon Jun 8 02:07:09 2015 +0100

    Drop parameterisation by monad in Expression.


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

fdb6117f21e3bc39ae97bf0f12c0fc3caf10e093
 src/Expression.hs | 51 ++++++++++++++++++++++++++++-----------------------
 1 file changed, 28 insertions(+), 23 deletions(-)

diff --git a/src/Expression.hs b/src/Expression.hs
index fc70be1..de5fae9 100644
--- a/src/Expression.hs
+++ b/src/Expression.hs
@@ -2,13 +2,11 @@
 module Expression (
     module Control.Monad.Reader,
     Ways,
-    Packages,
-    TargetDir,
     Predicate,
     Expression,
-    Environment (..),
+    Environment (..), defaultEnvironment,
     interpret,
-    whenPredicate, (?), stage, notStage, package,
+    whenPredicate, (?), (??), stage, notStage, builder, notBuilder, package,
     configKeyValue, configKeyValues,
     configKeyYes, configKeyNo, configKeyNonEmpty
     ) where
@@ -34,51 +32,58 @@ defaultEnvironment = Environment
         getPackage = error "Package not set in the environment"
     }
 
-type Expression m a = ReaderT Environment m a
+type Expression a = ReaderT Environment Action a
 
-type Ways      m = Expression m [Way]
-type Packages  m = Expression m [Package]
-type Predicate m = Expression m Bool
-type TargetDir m = Expression m FilePath
+type Ways      = Expression [Way]
+type Predicate = Expression Bool
 
-instance (Monad m, Monoid a) => Monoid (Expression m a) where
+instance Monoid a => Monoid (Expression a) where
     mempty  = return mempty
     mappend = liftM2 mappend
 
-interpret :: (Monad m, Monoid a) => Expression m a -> Environment -> m a
-interpret = runReaderT
+interpret :: Environment -> Expression a -> Action a
+interpret = flip runReaderT
 
-whenPredicate :: (Monad m, Monoid a) => Predicate m -> Expression m a -> Expression m a
+whenPredicate :: Monoid a => Predicate -> Expression a -> Expression a
 whenPredicate predicate expr = do
     bool <- predicate
     if bool then expr else return mempty
 
-(?) :: (Monad m, Monoid a) => Predicate m -> Expression m a -> Expression m a
+(?) :: Monoid a => Predicate -> Expression a -> Expression a
 (?) = whenPredicate
 
+(??) :: Monoid a => Predicate -> (Expression a, Expression a) -> Expression a
+p ?? (t, f) = p ? t <> (liftM not p) ? f
+
 infixr 8 ?
 
-stage :: Monad m => Stage -> Predicate m
+stage :: Stage -> Predicate
 stage s = liftM (s ==) (asks getStage)
 
-notStage :: Monad m => Stage -> Predicate m
+notStage :: Stage -> Predicate
 notStage = liftM not . stage
 
-package :: Monad m => Package -> Predicate m
+builder :: Builder -> Predicate
+builder b = liftM (b ==) (asks getBuilder)
+
+notBuilder :: Builder -> Predicate
+notBuilder = liftM not . builder
+
+package :: Package -> Predicate
 package p = liftM (p ==) (asks getPackage)
 
-configKeyValue :: String -> String -> Predicate Action
+configKeyValue :: String -> String -> Predicate
 configKeyValue key value = liftM (value ==) (lift $ askConfig key)
 
 -- checks if there is at least one match
-configKeyValues :: String -> [String] -> Predicate Action
+configKeyValues :: String -> [String] -> Predicate
 configKeyValues key values = liftM (flip elem $ values) (lift $ askConfig key)
 
-configKeyYes :: String -> Predicate Action
+configKeyYes :: String -> Predicate
 configKeyYes key = configKeyValue key "YES"
 
-configKeyNo :: String -> Predicate Action
+configKeyNo :: String -> Predicate
 configKeyNo key = configKeyValue key "NO"
 
-configKeyNonEmpty :: String -> Predicate Action
-configKeyNonEmpty key = configKeyValue key ""
+configKeyNonEmpty :: String -> Predicate
+configKeyNonEmpty key = liftM not $ configKeyValue key ""