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 ...@@ -119,7 +119,6 @@ import GHC.Base
import System.Posix.Types ( Fd ) import System.Posix.Types ( Fd )
import Foreign.StablePtr import Foreign.StablePtr
import Foreign.C.Types import Foreign.C.Types
import Control.Monad
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
import Foreign.C import Foreign.C
......
...@@ -303,22 +303,7 @@ replicateM_ :: (Monad m) => Int -> m a -> m () ...@@ -303,22 +303,7 @@ replicateM_ :: (Monad m) => Int -> m a -> m ()
{-# SPECIALISE replicateM_ :: Int -> Maybe a -> Maybe () #-} {-# SPECIALISE replicateM_ :: Int -> Maybe a -> Maybe () #-}
replicateM_ n x = sequence_ (replicate n x) 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'. -- | The reverse of 'when'.
unless :: (Monad m) => Bool -> m () -> m () unless :: (Monad m) => Bool -> m () -> m ()
{-# INLINEABLE unless #-} {-# INLINEABLE unless #-}
{-# SPECIALISE unless :: Bool -> IO () -> IO () #-} {-# SPECIALISE unless :: Bool -> IO () -> IO () #-}
......
...@@ -107,7 +107,7 @@ module Data.Data ( ...@@ -107,7 +107,7 @@ module Data.Data (
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
import Control.Monad import Control.Monad ( MonadPlus(..) )
import Data.Either import Data.Either
import Data.Eq import Data.Eq
import Data.Maybe import Data.Maybe
......
...@@ -23,7 +23,7 @@ module Data.Functor ...@@ -23,7 +23,7 @@ module Data.Functor
void, void,
) where ) where
import Control.Monad import Control.Monad ( void )
import GHC.Base ( Functor(..), flip ) import GHC.Base ( Functor(..), flip )
infixl 4 <$> infixl 4 <$>
......
...@@ -52,7 +52,6 @@ module Data.Traversable ( ...@@ -52,7 +52,6 @@ module Data.Traversable (
) where ) where
import Control.Applicative import Control.Applicative
import Control.Monad ( Monad(..) )
import qualified Control.Monad import qualified Control.Monad
import Data.Either import Data.Either
import Data.Foldable ( Foldable ) import Data.Foldable ( Foldable )
...@@ -62,7 +61,7 @@ import Data.Monoid ( Monoid ) ...@@ -62,7 +61,7 @@ import Data.Monoid ( Monoid )
import Data.Proxy import Data.Proxy
import GHC.Arr import GHC.Arr
import GHC.Base ( ($), (.), id, flip ) import GHC.Base ( ($), (.), Monad(..), id, flip )
import qualified GHC.List as List import qualified GHC.List as List
-- | Functors representing data structures that can be traversed from -- | Functors representing data structures that can be traversed from
......
...@@ -34,13 +34,12 @@ module Data.Version ( ...@@ -34,13 +34,12 @@ module Data.Version (
showVersion, parseVersion, showVersion, parseVersion,
) where ) where
import Control.Monad ( Monad(..), liftM )
import Data.Char ( isDigit, isAlphaNum ) import Data.Char ( isDigit, isAlphaNum )
import Data.Eq import Data.Eq
import Data.List import Data.List
import Data.Ord import Data.Ord
import Data.Typeable ( Typeable ) import Data.Typeable ( Typeable )
import GHC.Base ( ($), (&&), String, Int ) import GHC.Base ( ($), (&&), Monad(..), String, Int, liftM )
import GHC.Read import GHC.Read
import GHC.Show import GHC.Show
import Text.ParserCombinators.ReadP import Text.ParserCombinators.ReadP
......
...@@ -45,7 +45,6 @@ module Debug.Trace ( ...@@ -45,7 +45,6 @@ module Debug.Trace (
) where ) where
import System.IO.Unsafe import System.IO.Unsafe
import Control.Monad
import Foreign.C.String import Foreign.C.String
import GHC.Base import GHC.Base
......
...@@ -93,7 +93,7 @@ module Foreign.C.Error ( ...@@ -93,7 +93,7 @@ module Foreign.C.Error (
import Foreign.Ptr import Foreign.Ptr
import Foreign.C.Types import Foreign.C.Types
import Foreign.C.String import Foreign.C.String
import Control.Monad ( void ) import Data.Functor ( void )
import Data.Maybe import Data.Maybe
import GHC.IO import GHC.IO
......
...@@ -102,8 +102,6 @@ import Foreign.Storable ...@@ -102,8 +102,6 @@ import Foreign.Storable
import Data.Word import Data.Word
import Control.Monad
import GHC.Char import GHC.Char
import GHC.List import GHC.List
import GHC.Real import GHC.Real
......
...@@ -46,7 +46,7 @@ module Foreign.Marshal.Pool ( ...@@ -46,7 +46,7 @@ module Foreign.Marshal.Pool (
pooledNewArray0 pooledNewArray0
) where ) where
import GHC.Base ( Int, Monad(..), (.), not ) import GHC.Base ( Int, Monad(..), (.), liftM, not )
import GHC.Err ( undefined ) import GHC.Err ( undefined )
import GHC.Exception ( throw ) import GHC.Exception ( throw )
import GHC.IO ( IO, mask, catchAny ) import GHC.IO ( IO, mask, catchAny )
...@@ -54,7 +54,6 @@ import GHC.IORef ( IORef, newIORef, readIORef, writeIORef ) ...@@ -54,7 +54,6 @@ import GHC.IORef ( IORef, newIORef, readIORef, writeIORef )
import GHC.List ( elem, length ) import GHC.List ( elem, length )
import GHC.Num ( Num(..) ) import GHC.Num ( Num(..) )
import Control.Monad ( liftM )
import Data.List ( delete ) import Data.List ( delete )
import Foreign.Marshal.Alloc ( mallocBytes, reallocBytes, free ) import Foreign.Marshal.Alloc ( mallocBytes, reallocBytes, free )
import Foreign.Marshal.Array ( pokeArray, pokeArray0 ) import Foreign.Marshal.Array ( pokeArray, pokeArray0 )
......
...@@ -493,6 +493,18 @@ original default. ...@@ -493,6 +493,18 @@ original default.
(=<<) :: Monad m => (a -> m b) -> m a -> m b (=<<) :: Monad m => (a -> m b) -> m a -> m b
f =<< x = x >>= f 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. -- | Promote a function to a monad.
liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r
liftM f m1 = do { x1 <- m1; return (f x1) } liftM f m1 = do { x1 <- m1; return (f x1) }
......
...@@ -24,7 +24,6 @@ module GHC.Event.Array ...@@ -24,7 +24,6 @@ module GHC.Event.Array
, useAsPtr , useAsPtr
) where ) where
import Control.Monad hiding (forM_, empty)
import Data.Bits ((.|.), shiftR) import Data.Bits ((.|.), shiftR)
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef) import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)
import Data.Maybe import Data.Maybe
......
...@@ -28,7 +28,6 @@ module GHC.Event.Control ...@@ -28,7 +28,6 @@ module GHC.Event.Control
#include "EventConfig.h" #include "EventConfig.h"
import Control.Monad (when)
import Foreign.ForeignPtr (ForeignPtr) import Foreign.ForeignPtr (ForeignPtr)
import GHC.Base import GHC.Base
import GHC.Conc.Signal (Signal) import GHC.Conc.Signal (Signal)
......
...@@ -38,7 +38,6 @@ available = False ...@@ -38,7 +38,6 @@ available = False
#include <sys/epoll.h> #include <sys/epoll.h>
import Control.Monad (when)
import Data.Bits (Bits, FiniteBits, (.|.), (.&.)) import Data.Bits (Bits, FiniteBits, (.|.), (.&.))
import Data.Word (Word32) import Data.Word (Word32)
import Foreign.C.Error (eNOENT, getErrno, throwErrno, import Foreign.C.Error (eNOENT, getErrno, throwErrno,
......
...@@ -12,13 +12,12 @@ module GHC.Event.IntTable ...@@ -12,13 +12,12 @@ module GHC.Event.IntTable
, updateWith , updateWith
) where ) where
import Control.Monad ((=<<), liftM, unless, when)
import Data.Bits ((.&.), shiftL, shiftR) import Data.Bits ((.&.), shiftL, shiftR)
import Data.IORef (IORef, newIORef, readIORef, writeIORef) 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.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr)
import Foreign.Storable (peek, poke) 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.Classes (Eq(..), Ord(..))
import GHC.Event.Arr (Arr) import GHC.Event.Arr (Arr)
import GHC.Num (Num(..)) import GHC.Num (Num(..))
...@@ -134,7 +133,7 @@ updateWith f k (IntTable ref) = do ...@@ -134,7 +133,7 @@ updateWith f k (IntTable ref) = do
(fbv, oldVal, newBucket) <- go False `liftM` Arr.read tabArr idx (fbv, oldVal, newBucket) <- go False `liftM` Arr.read tabArr idx
when (isJust oldVal) $ do when (isJust oldVal) $ do
Arr.write tabArr idx newBucket Arr.write tabArr idx newBucket
unless (isJust fbv) $ when (isNothing fbv) $
withForeignPtr tabSize $ \ptr -> do withForeignPtr tabSize $ \ptr -> do
size <- peek ptr size <- peek ptr
poke ptr (size - 1) poke ptr (size - 1)
......
...@@ -52,7 +52,7 @@ module GHC.Event.Manager ...@@ -52,7 +52,7 @@ module GHC.Event.Manager
import Control.Concurrent.MVar (MVar, newMVar, readMVar, putMVar, import Control.Concurrent.MVar (MVar, newMVar, readMVar, putMVar,
tryPutMVar, takeMVar, withMVar) tryPutMVar, takeMVar, withMVar)
import Control.Exception (onException) import Control.Exception (onException)
import Control.Monad (forM_, when, replicateM, void) import Control.Monad (forM_, replicateM, void)
import Data.Bits ((.&.)) import Data.Bits ((.&.))
import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,
writeIORef) writeIORef)
......
...@@ -26,7 +26,6 @@ available = False ...@@ -26,7 +26,6 @@ available = False
#include <poll.h> #include <poll.h>
import Control.Concurrent.MVar (MVar, newMVar, swapMVar) import Control.Concurrent.MVar (MVar, newMVar, swapMVar)
import Control.Monad (unless)
import Data.Bits (Bits, FiniteBits, (.|.), (.&.)) import Data.Bits (Bits, FiniteBits, (.|.), (.&.))
import Data.Word import Data.Word
import Foreign.C.Types (CInt(..), CShort(..)) import Foreign.C.Types (CInt(..), CShort(..))
...@@ -93,7 +92,7 @@ poll p mtout f = do ...@@ -93,7 +92,7 @@ poll p mtout f = do
c_pollLoop ptr (fromIntegral len) (fromTimeout tout) c_pollLoop ptr (fromIntegral len) (fromTimeout tout)
Nothing -> Nothing ->
c_poll_unsafe ptr (fromIntegral len) 0 c_poll_unsafe ptr (fromIntegral len) 0
unless (n == 0) $ do when (n /= 0) $ do
A.loop a 0 $ \i e -> do A.loop a 0 $ \i e -> do
let r = pfdRevents e let r = pfdRevents e
if r /= 0 if r /= 0
......
...@@ -16,7 +16,7 @@ module GHC.Event.Thread ...@@ -16,7 +16,7 @@ module GHC.Event.Thread
) where ) where
import Control.Exception (finally, SomeException, toException) 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.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.List (zipWith3) import Data.List (zipWith3)
import Data.Tuple (snd) import Data.Tuple (snd)
......
...@@ -39,7 +39,7 @@ module GHC.Event.TimerManager ...@@ -39,7 +39,7 @@ module GHC.Event.TimerManager
-- Imports -- Imports
import Control.Exception (finally) import Control.Exception (finally)
import Control.Monad (sequence_, when) import Control.Monad (sequence_)
import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef, import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,
writeIORef) writeIORef)
import GHC.Base import GHC.Base
......
...@@ -30,7 +30,6 @@ import GHC.Show ...@@ -30,7 +30,6 @@ import GHC.Show
import Foreign import Foreign
import Foreign.C import Foreign.C
import System.IO import System.IO
import Control.Monad (when)
import GHC.Fingerprint.Type import GHC.Fingerprint.Type
......
...@@ -44,7 +44,6 @@ import Foreign.Storable ...@@ -44,7 +44,6 @@ import Foreign.Storable
import Data.Word import Data.Word
-- Imports for the locale-encoding version of marshallers -- Imports for the locale-encoding version of marshallers
import Control.Monad
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Maybe import Data.Maybe
......
...@@ -35,7 +35,6 @@ import GHC.Num ...@@ -35,7 +35,6 @@ import GHC.Num
import GHC.Real import GHC.Real
import GHC.Show import GHC.Show
import GHC.Enum import GHC.Enum
import Control.Monad
import Data.Typeable import Data.Typeable
import GHC.IO import GHC.IO
......
...@@ -68,7 +68,7 @@ import GHC.Num ...@@ -68,7 +68,7 @@ import GHC.Num
import GHC.Real import GHC.Real
import Data.Maybe import Data.Maybe
import Data.Typeable import Data.Typeable
import Control.Monad import Control.Monad ( mapM )
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Closing a handle -- Closing a handle
......
...@@ -73,7 +73,6 @@ import GHC.Show ...@@ -73,7 +73,6 @@ import GHC.Show
import GHC.IORef import GHC.IORef
import GHC.MVar import GHC.MVar
import Data.Typeable import Data.Typeable
import Control.Monad
import Data.Maybe import Data.Maybe
import Foreign.Safe import Foreign.Safe
import System.Posix.Internals hiding (FD) import System.Posix.Internals hiding (FD)
......
...@@ -49,7 +49,6 @@ import qualified Control.Exception as Exception ...@@ -49,7 +49,6 @@ import qualified Control.Exception as Exception
import Data.Typeable import Data.Typeable
import System.IO.Error import System.IO.Error
import Data.Maybe import Data.Maybe
import Control.Monad
import GHC.IORef import GHC.IORef
import GHC.Base import GHC.Base
......
...@@ -24,9 +24,6 @@ module System.Posix.Internals where ...@@ -24,9 +24,6 @@ module System.Posix.Internals where
#include "HsBaseConfig.h" #include "HsBaseConfig.h"
#if ! (defined(mingw32_HOST_OS) || defined(__MINGW32__))
import Control.Monad
#endif
import System.Posix.Types import System.Posix.Types
import Foreign import Foreign
...@@ -323,7 +320,7 @@ setNonBlockingFD fd set = do ...@@ -323,7 +320,7 @@ setNonBlockingFD fd set = do
(c_fcntl_read fd const_f_getfl) (c_fcntl_read fd const_f_getfl)
let flags' | set = flags .|. o_NONBLOCK let flags' | set = flags .|. o_NONBLOCK
| otherwise = flags .&. complement 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 -- 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 -- 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. -- 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