Move `when` to GHC.Base

This allows several modules to avoid importing Control.Monad and thus break
import cycles that manifest themselves when implementing #9586

Reviewed By: austin, ekmett

Differential Revision: https://phabricator.haskell.org/D222

libraries/base/Control/Concurrent.hs

@@ -119,7 +119,6 @@ import GHC.Base
 import System.Posix.Types ( Fd )
 import Foreign.StablePtr
 import Foreign.C.Types
-import Control.Monad
 
 #ifdef mingw32_HOST_OS
 import Foreign.C

libraries/base/Control/Monad.hs

@@ -303,22 +303,7 @@ replicateM_       :: (Monad m) => Int -> m a -> m ()
 {-# SPECIALISE replicateM_ :: Int -> Maybe a -> Maybe () #-}
 replicateM_ n x   = sequence_ (replicate n x)
 
-{- | Conditional execution of monadic expressions. For example, 
-
->       when debug (putStr "Debugging\n")
-
-will output the string @Debugging\\n@ if the Boolean value @debug@ is 'True',
-and otherwise do nothing.
--}
-
-when              :: (Monad m) => Bool -> m () -> m ()
-{-# INLINEABLE when #-}
-{-# SPECIALISE when :: Bool -> IO () -> IO () #-}
-{-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-}
-when p s          =  if p then s else return ()
-
 -- | The reverse of 'when'.
-
 unless            :: (Monad m) => Bool -> m () -> m ()
 {-# INLINEABLE unless #-}
 {-# SPECIALISE unless :: Bool -> IO () -> IO () #-}

libraries/base/Data/Data.hs

@@ -107,7 +107,7 @@ module Data.Data (
 
 ------------------------------------------------------------------------------
 
-import Control.Monad
+import Control.Monad ( MonadPlus(..) )
 import Data.Either
 import Data.Eq
 import Data.Maybe

libraries/base/Data/Functor.hs

@@ -23,7 +23,7 @@ module Data.Functor
       void,
     ) where
 
-import Control.Monad
+import Control.Monad ( void )
 import GHC.Base ( Functor(..), flip )
 
 infixl 4 <$>

libraries/base/Data/Traversable.hs

@@ -52,7 +52,6 @@ module Data.Traversable (
     ) where
 
 import Control.Applicative
-import Control.Monad ( Monad(..) )
 import qualified Control.Monad
 import Data.Either
 import Data.Foldable ( Foldable )
@@ -62,7 +61,7 @@ import Data.Monoid ( Monoid )
 import Data.Proxy
 
 import GHC.Arr
-import GHC.Base ( ($), (.), id, flip )
+import GHC.Base ( ($), (.), Monad(..), id, flip )
 import qualified GHC.List as List
 
 -- | Functors representing data structures that can be traversed from

libraries/base/Data/Version.hs

@@ -34,13 +34,12 @@ module Data.Version (
         showVersion, parseVersion,
   ) where
 
-import Control.Monad    ( Monad(..), liftM )
 import Data.Char        ( isDigit, isAlphaNum )
 import Data.Eq
 import Data.List
 import Data.Ord
 import Data.Typeable    ( Typeable )
-import GHC.Base         ( ($), (&&), String, Int )
+import GHC.Base         ( ($), (&&), Monad(..), String, Int, liftM )
 import GHC.Read
 import GHC.Show
 import Text.ParserCombinators.ReadP

libraries/base/Debug/Trace.hs

@@ -45,7 +45,6 @@ module Debug.Trace (
   ) where
 
 import System.IO.Unsafe
-import Control.Monad
 
 import Foreign.C.String
 import GHC.Base

libraries/base/Foreign/C/Error.hs

@@ -93,7 +93,7 @@ module Foreign.C.Error (
 import Foreign.Ptr
 import Foreign.C.Types
 import Foreign.C.String
-import Control.Monad            ( void )
+import Data.Functor            ( void )
 import Data.Maybe
 
 import GHC.IO

libraries/base/Foreign/C/String.hs

@@ -102,8 +102,6 @@ import Foreign.Storable
 
 import Data.Word
 
-import Control.Monad
-
 import GHC.Char
 import GHC.List
 import GHC.Real

libraries/base/Foreign/Marshal/Pool.hs

@@ -46,7 +46,7 @@ module Foreign.Marshal.Pool (
    pooledNewArray0
 ) where
 
-import GHC.Base              ( Int, Monad(..), (.), not )
+import GHC.Base              ( Int, Monad(..), (.), liftM, not )
 import GHC.Err               ( undefined )
 import GHC.Exception         ( throw )
 import GHC.IO                ( IO, mask, catchAny )
@@ -54,7 +54,6 @@ import GHC.IORef             ( IORef, newIORef, readIORef, writeIORef )
 import GHC.List              ( elem, length )
 import GHC.Num               ( Num(..) )
 
-import Control.Monad         ( liftM )
 import Data.List             ( delete )
 import Foreign.Marshal.Alloc ( mallocBytes, reallocBytes, free )
 import Foreign.Marshal.Array ( pokeArray, pokeArray0 )

libraries/base/GHC/Base.lhs

@@ -493,6 +493,18 @@ original default.
 (=<<)           :: Monad m => (a -> m b) -> m a -> m b
 f =<< x         = x >>= f
 
+-- | Conditional execution of monadic expressions. For example,
+--
+-- > when debug (putStrLn "Debugging")
+--
+-- will output the string @Debugging@ if the Boolean value @debug@
+-- is 'True', and otherwise do nothing.
+when    :: (Monad m) => Bool -> m () -> m ()
+{-# INLINEABLE when #-}
+{-# SPECIALISE when :: Bool -> IO () -> IO () #-}
+{-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-}
+when p s                = if p then s else return ()
+
 -- | Promote a function to a monad.
 liftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r
 liftM f m1              = do { x1 <- m1; return (f x1) }

libraries/base/GHC/Event/Array.hs

@@ -24,7 +24,6 @@ module GHC.Event.Array
     , useAsPtr
     ) where
 
-import Control.Monad hiding (forM_, empty)
 import Data.Bits ((.|.), shiftR)
 import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)
 import Data.Maybe

libraries/base/GHC/Event/Control.hs

@@ -28,7 +28,6 @@ module GHC.Event.Control
 
 #include "EventConfig.h"
 
-import Control.Monad (when)
 import Foreign.ForeignPtr (ForeignPtr)
 import GHC.Base
 import GHC.Conc.Signal (Signal)

libraries/base/GHC/Event/EPoll.hsc

@@ -38,7 +38,6 @@ available = False
 
 #include <sys/epoll.h>
 
-import Control.Monad (when)
 import Data.Bits (Bits, FiniteBits, (.|.), (.&.))
 import Data.Word (Word32)
 import Foreign.C.Error (eNOENT, getErrno, throwErrno,

libraries/base/GHC/Event/IntTable.hs

@@ -12,13 +12,12 @@ module GHC.Event.IntTable
     , updateWith
     ) where
 
-import Control.Monad ((=<<), liftM, unless, when)
 import Data.Bits ((.&.), shiftL, shiftR)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Maybe (Maybe(..), isJust)
+import Data.Maybe (Maybe(..), isJust, isNothing)
 import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr)
 import Foreign.Storable (peek, poke)
-import GHC.Base (Monad(..), ($), const, otherwise)
+import GHC.Base (Monad(..), (=<<), ($), const, liftM, otherwise, when)
 import GHC.Classes (Eq(..), Ord(..))
 import GHC.Event.Arr (Arr)
 import GHC.Num (Num(..))
@@ -134,7 +133,7 @@ updateWith f k (IntTable ref) = do
   (fbv, oldVal, newBucket) <- go False `liftM` Arr.read tabArr idx
   when (isJust oldVal) $ do
     Arr.write tabArr idx newBucket
-    unless (isJust fbv) $
+    when (isNothing fbv) $
       withForeignPtr tabSize $ \ptr -> do
         size <- peek ptr
         poke ptr (size - 1)

libraries/base/GHC/Event/Manager.hs

@@ -52,7 +52,7 @@ module GHC.Event.Manager
 import Control.Concurrent.MVar (MVar, newMVar, readMVar, putMVar,
                                 tryPutMVar, takeMVar, withMVar)
 import Control.Exception (onException)
-import Control.Monad (forM_, when, replicateM, void)
+import Control.Monad (forM_, replicateM, void)
 import Data.Bits ((.&.))
 import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,
                    writeIORef)

libraries/base/GHC/Event/Poll.hsc

@@ -26,7 +26,6 @@ available = False
 #include <poll.h>
 
 import Control.Concurrent.MVar (MVar, newMVar, swapMVar)
-import Control.Monad (unless)
 import Data.Bits (Bits, FiniteBits, (.|.), (.&.))
 import Data.Word
 import Foreign.C.Types (CInt(..), CShort(..))
@@ -93,7 +92,7 @@ poll p mtout f = do
         c_pollLoop ptr (fromIntegral len) (fromTimeout tout)
       Nothing   ->
         c_poll_unsafe ptr (fromIntegral len) 0
-  unless (n == 0) $ do
+  when (n /= 0) $ do
     A.loop a 0 $ \i e -> do
       let r = pfdRevents e
       if r /= 0

libraries/base/GHC/Event/Thread.hs

@@ -16,7 +16,7 @@ module GHC.Event.Thread
     ) where
 
 import Control.Exception (finally, SomeException, toException)
-import Control.Monad (forM, forM_, sequence_, zipWithM, when)
+import Control.Monad (forM, forM_, sequence_, zipWithM)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.List (zipWith3)
 import Data.Tuple (snd)

libraries/base/GHC/Event/TimerManager.hs

@@ -39,7 +39,7 @@ module GHC.Event.TimerManager
 -- Imports
 
 import Control.Exception (finally)
-import Control.Monad (sequence_, when)
+import Control.Monad (sequence_)
 import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,
                    writeIORef)
 import GHC.Base

libraries/base/GHC/Fingerprint.hs

@@ -30,7 +30,6 @@ import GHC.Show
 import Foreign
 import Foreign.C
 import System.IO
-import Control.Monad (when)
 
 import GHC.Fingerprint.Type
 

libraries/base/GHC/Foreign.hs

@@ -44,7 +44,6 @@ import Foreign.Storable
 import Data.Word
 
 -- Imports for the locale-encoding version of marshallers
-import Control.Monad
 
 import Data.Tuple (fst)
 import Data.Maybe

libraries/base/GHC/IO/FD.hs

@@ -35,7 +35,6 @@ import GHC.Num
 import GHC.Real
 import GHC.Show
 import GHC.Enum
-import Control.Monad
 import Data.Typeable
 
 import GHC.IO

libraries/base/GHC/IO/Handle.hs

@@ -68,7 +68,7 @@ import GHC.Num
 import GHC.Real
 import Data.Maybe
 import Data.Typeable
-import Control.Monad
+import Control.Monad ( mapM )
 
 -- ---------------------------------------------------------------------------
 -- Closing a handle

libraries/base/GHC/IO/Handle/Internals.hs

@@ -73,7 +73,6 @@ import GHC.Show
 import GHC.IORef
 import GHC.MVar
 import Data.Typeable
-import Control.Monad
 import Data.Maybe
 import Foreign.Safe
 import System.Posix.Internals hiding (FD)

libraries/base/GHC/IO/Handle/Text.hs

@@ -49,7 +49,6 @@ import qualified Control.Exception as Exception
 import Data.Typeable
 import System.IO.Error
 import Data.Maybe
-import Control.Monad
 
 import GHC.IORef
 import GHC.Base

libraries/base/System/Posix/Internals.hs

@@ -24,9 +24,6 @@ module System.Posix.Internals where
 
 #include "HsBaseConfig.h"
 
-#if ! (defined(mingw32_HOST_OS) || defined(__MINGW32__))
-import Control.Monad
-#endif
 import System.Posix.Types
 
 import Foreign
@@ -323,7 +320,7 @@ setNonBlockingFD fd set = do
                  (c_fcntl_read fd const_f_getfl)
   let flags' | set       = flags .|. o_NONBLOCK
              | otherwise = flags .&. complement o_NONBLOCK
-  unless (flags == flags') $ do
+  when (flags /= flags') $ do
     -- An error when setting O_NONBLOCK isn't fatal: on some systems
     -- there are certain file handles on which this will fail (eg. /dev/null
     -- on FreeBSD) so we throw away the return code from fcntl_write.