Commit eae19112 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

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
parent 8b908365
......@@ -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
......
......@@ -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 () #-}
......
......@@ -107,7 +107,7 @@ module Data.Data (
------------------------------------------------------------------------------
import Control.Monad
import Control.Monad ( MonadPlus(..) )
import Data.Either
import Data.Eq
import Data.Maybe
......
......@@ -23,7 +23,7 @@ module Data.Functor
void,
) where
import Control.Monad
import Control.Monad ( void )
import GHC.Base ( Functor(..), flip )
infixl 4 <$>
......
......@@ -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
......
......@@ -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
......
......@@ -45,7 +45,6 @@ module Debug.Trace (
) where
import System.IO.Unsafe
import Control.Monad
import Foreign.C.String
import GHC.Base
......
......@@ -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
......
......@@ -102,8 +102,6 @@ import Foreign.Storable
import Data.Word
import Control.Monad
import GHC.Char
import GHC.List
import GHC.Real
......
......@@ -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 )
......
......@@ -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) }
......
......@@ -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
......
......@@ -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)
......
......@@ -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,
......
......@@ -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)
......
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -30,7 +30,6 @@ import GHC.Show
import Foreign
import Foreign.C
import System.IO
import Control.Monad (when)
import GHC.Fingerprint.Type
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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.
......
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