summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHécate <hecate+gitlab@glitchbra.in>2020-09-18 20:07:49 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-09-23 20:44:24 -0400
commit31fea307499009977fdf3dadedc98cfef986077a (patch)
treecac7edf234b82d16c3edd53fc38539fcc2766cb5
parenta997fa01d907fc1992dc8c3ebc73f98e7a1486f7 (diff)
downloadhaskell-31fea307499009977fdf3dadedc98cfef986077a.tar.gz
Remove redundant "do", "return" and language extensions from base
-rw-r--r--libraries/base/.hlint.yaml22
-rw-r--r--libraries/base/Control/Concurrent/Chan.hs2
-rw-r--r--libraries/base/Control/Concurrent/QSem.hs2
-rw-r--r--libraries/base/Control/Concurrent/QSemN.hs2
-rw-r--r--libraries/base/Control/Monad/ST/Lazy/Imp.hs2
-rw-r--r--libraries/base/Data/String.hs1
-rw-r--r--libraries/base/Debug/Trace.hs2
-rw-r--r--libraries/base/Foreign/Marshal/Array.hs4
-rw-r--r--libraries/base/Foreign/Marshal/Utils.hs4
-rw-r--r--libraries/base/GHC/Conc/POSIX.hs4
-rw-r--r--libraries/base/GHC/Environment.hs4
-rw-r--r--libraries/base/GHC/Event/Array.hs6
-rw-r--r--libraries/base/GHC/Event/Control.hs3
-rw-r--r--libraries/base/GHC/Event/Manager.hs4
-rw-r--r--libraries/base/GHC/Event/Thread.hs11
-rw-r--r--libraries/base/GHC/Event/TimerManager.hs2
-rw-r--r--libraries/base/GHC/Fingerprint.hs6
-rw-r--r--libraries/base/GHC/IO/Buffer.hs2
-rw-r--r--libraries/base/GHC/IO/Encoding/Failure.hs2
-rw-r--r--libraries/base/GHC/IO/Encoding/Iconv.hs2
-rw-r--r--libraries/base/GHC/IO/FD.hs6
-rw-r--r--libraries/base/GHC/IO/Handle.hs16
-rw-r--r--libraries/base/GHC/IO/Handle/Internals.hs10
-rw-r--r--libraries/base/GHC/IO/Handle/Text.hs149
-rw-r--r--libraries/base/GHC/TypeLits.hs3
-rw-r--r--libraries/base/System/IO.hs6
-rw-r--r--libraries/base/System/Posix/Internals.hs12
-rw-r--r--libraries/base/Text/ParserCombinators/ReadP.hs8
-rw-r--r--libraries/base/Text/Printf.hs2
-rw-r--r--libraries/base/Text/Read/Lex.hs27
-rw-r--r--libraries/base/Unsafe/Coerce.hs1
-rw-r--r--libraries/base/tests/Concurrent/MVar001.hs2
-rw-r--r--libraries/base/tests/IO/encoding001.hs2
-rw-r--r--libraries/base/tests/IO/encoding004.hs4
-rw-r--r--libraries/base/tests/IO/hClose002.hs2
-rw-r--r--libraries/base/tests/IO/hClose003.hs2
-rw-r--r--libraries/base/tests/IO/hDuplicateTo001.hs2
-rw-r--r--libraries/base/tests/IO/hReady002.hs4
-rw-r--r--libraries/base/tests/IO/newline001.hs2
-rw-r--r--libraries/base/tests/IO/readwrite002.hs1
-rw-r--r--libraries/base/tests/T13167.hs2
-rw-r--r--libraries/base/tests/T13896.hs12
-rw-r--r--libraries/base/tests/T9532.hs4
-rw-r--r--libraries/base/tests/foldableArray.hs1
-rw-r--r--libraries/base/tests/qsem001.hs6
-rw-r--r--libraries/base/tests/qsemn001.hs6
46 files changed, 191 insertions, 188 deletions
diff --git a/libraries/base/.hlint.yaml b/libraries/base/.hlint.yaml
index 6ebe02e94c..670eb5f6fb 100644
--- a/libraries/base/.hlint.yaml
+++ b/libraries/base/.hlint.yaml
@@ -5,3 +5,25 @@
- ignore: {}
- warn: {name: Unused LANGUAGE pragma}
- warn: {name: Use fewer LANGUAGE pragmas}
+- warn: {name: Redundant return}
+- warn: {name: Redundant True guards}
+- warn: {name: Redundant do}
+- warn: {name: Redundant variable capture}
+- warn: {name: Redundant void}
+- warn: {name: Redundant as}
+- warn: {name: Use fewer imports}
+- warn: {name: Redundant as-pattern}
+- warn: {name: Redundant where}
+- warn: {name: Used otherwise as a pattern}
+
+
+## Exceptions
+# Sometimes, the hlint parser flags some functions and modules as incorrectly
+# using a language extension. Some other times, we need to make exceptions to
+# lints that we otherwise want applied elsewhere. Such exceptions are listed
+# below.
+
+- ignore: {name: Unused LANGUAGE pragma, within: [GHC.IO.Encoding.CodePage]}
+- ignore: {name: Redundant do, within: [GHC.IO.Handle.Text.commitBuffer]}
+- ignore: {name: Use fewer imports, within: [GHC.Windows]}
+- ignore: {name: Use fewer imports, within: [GHC.Event.Control]}
diff --git a/libraries/base/Control/Concurrent/Chan.hs b/libraries/base/Control/Concurrent/Chan.hs
index 874e48a1a1..1599ae3048 100644
--- a/libraries/base/Control/Concurrent/Chan.hs
+++ b/libraries/base/Control/Concurrent/Chan.hs
@@ -105,7 +105,7 @@ writeChan (Chan _ writeVar) val = do
-- Throws 'Control.Exception.BlockedIndefinitelyOnMVar' when the channel is
-- empty and no other thread holds a reference to the channel.
readChan :: Chan a -> IO a
-readChan (Chan readVar _) = do
+readChan (Chan readVar _) =
modifyMVar readVar $ \read_end -> do
(ChItem val new_read_end) <- readMVar read_end
-- Use readMVar here, not takeMVar,
diff --git a/libraries/base/Control/Concurrent/QSem.hs b/libraries/base/Control/Concurrent/QSem.hs
index 133d6e2ab8..9f53eef826 100644
--- a/libraries/base/Control/Concurrent/QSem.hs
+++ b/libraries/base/Control/Concurrent/QSem.hs
@@ -82,7 +82,7 @@ waitQSem (QSem m) =
putMVar m (z, b1, b2)
return ()
where
- wait b = takeMVar b `onException` do
+ wait b = takeMVar b `onException`
(uninterruptibleMask_ $ do -- Note [signal uninterruptible]
(i,b1,b2) <- takeMVar m
r <- tryTakeMVar b
diff --git a/libraries/base/Control/Concurrent/QSemN.hs b/libraries/base/Control/Concurrent/QSemN.hs
index ea3236b0a4..1262198796 100644
--- a/libraries/base/Control/Concurrent/QSemN.hs
+++ b/libraries/base/Control/Concurrent/QSemN.hs
@@ -93,7 +93,7 @@ waitQSemN qs@(QSemN m) sz = mask_ $ do
JustMV b -> wait b
where
wait :: MVar () -> IO ()
- wait b = do
+ wait b =
takeMVar b `onException` do
already_filled <- not <$> tryPutMVar b ()
when already_filled $ signalQSemN qs sz
diff --git a/libraries/base/Control/Monad/ST/Lazy/Imp.hs b/libraries/base/Control/Monad/ST/Lazy/Imp.hs
index db900d9579..de8310c76d 100644
--- a/libraries/base/Control/Monad/ST/Lazy/Imp.hs
+++ b/libraries/base/Control/Monad/ST/Lazy/Imp.hs
@@ -42,7 +42,7 @@ import Control.Monad.Fix
import qualified Control.Monad.ST as ST
import qualified Control.Monad.ST.Unsafe as ST
-import qualified GHC.ST as GHC.ST
+import qualified GHC.ST
import GHC.Base
-- | The lazy @'ST'@ monad.
diff --git a/libraries/base/Data/String.hs b/libraries/base/Data/String.hs
index e091dab86f..79a32ce322 100644
--- a/libraries/base/Data/String.hs
+++ b/libraries/base/Data/String.hs
@@ -1,6 +1,5 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs
index 1b977bae6e..453b5141b4 100644
--- a/libraries/base/Debug/Trace.hs
+++ b/libraries/base/Debug/Trace.hs
@@ -78,7 +78,7 @@ import Data.List (null, partition)
--
-- @since 4.5.0.0
traceIO :: String -> IO ()
-traceIO msg = do
+traceIO msg =
withCString "%s\n" $ \cfmt -> do
-- NB: debugBelch can't deal with null bytes, so filter them
-- out so we don't accidentally truncate the message. See #9395
diff --git a/libraries/base/Foreign/Marshal/Array.hs b/libraries/base/Foreign/Marshal/Array.hs
index c0a9164b51..e494cdaca6 100644
--- a/libraries/base/Foreign/Marshal/Array.hs
+++ b/libraries/base/Foreign/Marshal/Array.hs
@@ -214,12 +214,10 @@ withArrayLen0 :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen0 marker vals f =
allocaArray0 len $ \ptr -> do
pokeArray0 marker ptr vals
- res <- f len ptr
- return res
+ f len ptr
where
len = length vals
-
-- copying (argument order: destination, source)
-- -------
diff --git a/libraries/base/Foreign/Marshal/Utils.hs b/libraries/base/Foreign/Marshal/Utils.hs
index f6bec7aacb..d134788e62 100644
--- a/libraries/base/Foreign/Marshal/Utils.hs
+++ b/libraries/base/Foreign/Marshal/Utils.hs
@@ -89,9 +89,7 @@ with :: Storable a => a -> (Ptr a -> IO b) -> IO b
with val f =
alloca $ \ptr -> do
poke ptr val
- res <- f ptr
- return res
-
+ f ptr
-- marshalling of Boolean values (non-zero corresponds to 'True')
-- -----------------------------
diff --git a/libraries/base/GHC/Conc/POSIX.hs b/libraries/base/GHC/Conc/POSIX.hs
index 84dc68fc30..3a6ddf2287 100644
--- a/libraries/base/GHC/Conc/POSIX.hs
+++ b/libraries/base/GHC/Conc/POSIX.hs
@@ -179,7 +179,7 @@ interruptIOManager :: IO ()
interruptIOManager = return ()
startIOManagerThread :: IO ()
-startIOManagerThread = do
+startIOManagerThread =
modifyMVar_ ioManagerThread $ \old -> do
let create = do t <- forkIO ioManager;
labelThread t "IOManagerThread";
@@ -251,7 +251,7 @@ service_loop wakeup old_delays = do
r <- c_WaitForSingleObject wakeup timeout
case r of
- 0xffffffff -> do throwGetLastError "service_loop"
+ 0xffffffff -> throwGetLastError "service_loop"
0 -> do
r2 <- c_readIOManagerEvent
exit <-
diff --git a/libraries/base/GHC/Environment.hs b/libraries/base/GHC/Environment.hs
index 4db0837664..eb30434f40 100644
--- a/libraries/base/GHC/Environment.hs
+++ b/libraries/base/GHC/Environment.hs
@@ -26,8 +26,8 @@ import qualified GHC.Foreign as GHC
-- returns a list of the program's command line arguments, starting with the
-- program name, and including those normally eaten by the RTS (+RTS ... -RTS).
getFullArgs :: IO [String]
-getFullArgs = do
- alloca $ \ p_argc -> do
+getFullArgs =
+ alloca $ \ p_argc ->
alloca $ \ p_argv -> do
getFullProgArgv p_argc p_argv
p <- fromIntegral `liftM` peek p_argc
diff --git a/libraries/base/GHC/Event/Array.hs b/libraries/base/GHC/Event/Array.hs
index 9558ece576..a24f5f34c1 100644
--- a/libraries/base/GHC/Event/Array.hs
+++ b/libraries/base/GHC/Event/Array.hs
@@ -128,7 +128,7 @@ unsafeWrite (Array ref) ix a = do
unsafeWrite' ac ix a
unsafeWrite' :: Storable a => AC a -> Int -> a -> IO ()
-unsafeWrite' (AC es _ cap) ix a = do
+unsafeWrite' (AC es _ cap) ix a =
CHECK_BOUNDS("unsafeWrite'",cap,ix)
withForeignPtr es $ \p ->
pokeElemOff p ix a
@@ -158,7 +158,7 @@ ensureCapacity (Array ref) c = do
writeIORef ref ac'
ensureCapacity' :: Storable a => AC a -> Int -> IO (AC a)
-ensureCapacity' ac@(AC es len cap) c = do
+ensureCapacity' ac@(AC es len cap) c =
if c > cap
then do
es' <- reallocArray es cap' cap
@@ -182,7 +182,7 @@ snoc (Array ref) e = do
writeIORef ref (AC es len' cap)
clear :: Array a -> IO ()
-clear (Array ref) = do
+clear (Array ref) =
atomicModifyIORef' ref $ \(AC es _ cap) ->
(AC es 0 cap, ())
diff --git a/libraries/base/GHC/Event/Control.hs b/libraries/base/GHC/Event/Control.hs
index 779d60d5d7..a9f23e07d2 100644
--- a/libraries/base/GHC/Event/Control.hs
+++ b/libraries/base/GHC/Event/Control.hs
@@ -28,7 +28,6 @@ module GHC.Event.Control
#include "EventConfig.h"
-import Foreign.ForeignPtr (ForeignPtr)
import GHC.Base
import GHC.IORef
import GHC.Conc.Signal (Signal)
@@ -37,7 +36,7 @@ import GHC.Show (Show)
import GHC.Word (Word8)
import Foreign.C.Error (throwErrnoIfMinus1_, throwErrno, getErrno)
import Foreign.C.Types (CInt(..), CSize(..))
-import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr)
+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrBytes, withForeignPtr)
import Foreign.Marshal (alloca, allocaBytes)
import Foreign.Marshal.Array (allocaArray)
import Foreign.Ptr (castPtr)
diff --git a/libraries/base/GHC/Event/Manager.hs b/libraries/base/GHC/Event/Manager.hs
index b680a54e77..dd133798d7 100644
--- a/libraries/base/GHC/Event/Manager.hs
+++ b/libraries/base/GHC/Event/Manager.hs
@@ -492,8 +492,8 @@ onFdEvent mgr fd evs
-- if there are no saved events and we registered with one-shot
-- semantics then there is no need to re-arm
unless (OneShot == I.elLifetime allEls
- && mempty == I.elEvent savedEls) $ do
- void $ I.modifyFdOnce (emBackend mgr) fd (I.elEvent savedEls)
+ && mempty == I.elEvent savedEls) $
+ void $ I.modifyFdOnce (emBackend mgr) fd (I.elEvent savedEls)
_ ->
-- we need to re-arm with multi-shot semantics
void $ I.modifyFd (emBackend mgr) fd
diff --git a/libraries/base/GHC/Event/Thread.hs b/libraries/base/GHC/Event/Thread.hs
index fb40cde4d0..367791354f 100644
--- a/libraries/base/GHC/Event/Thread.hs
+++ b/libraries/base/GHC/Event/Thread.hs
@@ -197,8 +197,7 @@ eventManager = unsafePerformIO $ do
{-# NOINLINE eventManager #-}
numEnabledEventManagers :: IORef Int
-numEnabledEventManagers = unsafePerformIO $ do
- newIORef 0
+numEnabledEventManagers = unsafePerformIO $ newIORef 0
{-# NOINLINE numEnabledEventManagers #-}
foreign import ccall unsafe "getOrSetSystemEventThreadIOManagerThreadStore"
@@ -213,10 +212,10 @@ ioManagerLock = unsafePerformIO $ do
sharedCAF m getOrSetSystemEventThreadIOManagerThreadStore
getSystemTimerManager :: IO TM.TimerManager
-getSystemTimerManager = do
+getSystemTimerManager =
fromMaybe err `fmap` readIORef timerManager
- where
- err = error "GHC.Event.Thread.getSystemTimerManager: the TimerManager requires linking against the threaded runtime"
+ where
+ err = error "GHC.Event.Thread.getSystemTimerManager: the TimerManager requires linking against the threaded runtime"
foreign import ccall unsafe "getOrSetSystemTimerThreadEventManagerStore"
getOrSetSystemTimerThreadEventManagerStore :: Ptr a -> IO (Ptr a)
@@ -325,7 +324,7 @@ startTimerManagerThread = modifyMVar_ timerManagerThreadVar $ \old -> do
foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
ioManagerCapabilitiesChanged :: IO ()
-ioManagerCapabilitiesChanged = do
+ioManagerCapabilitiesChanged =
withMVar ioManagerLock $ \_ -> do
new_n_caps <- getNumCapabilities
numEnabled <- readIORef numEnabledEventManagers
diff --git a/libraries/base/GHC/Event/TimerManager.hs b/libraries/base/GHC/Event/TimerManager.hs
index 4cac18d9a0..533558a8cc 100644
--- a/libraries/base/GHC/Event/TimerManager.hs
+++ b/libraries/base/GHC/Event/TimerManager.hs
@@ -226,7 +226,7 @@ registerTimeout mgr us cb = do
-- | Unregister an active timeout.
unregisterTimeout :: TimerManager -> TimeoutKey -> IO ()
-unregisterTimeout mgr (TK key) = do
+unregisterTimeout mgr (TK key) =
editTimeouts mgr (Q.delete key)
-- | Update an active timeout to fire in the given number of
diff --git a/libraries/base/GHC/Fingerprint.hs b/libraries/base/GHC/Fingerprint.hs
index 18bf0f9b36..06c4e856e0 100644
--- a/libraries/base/GHC/Fingerprint.hs
+++ b/libraries/base/GHC/Fingerprint.hs
@@ -42,11 +42,11 @@ fingerprint0 = Fingerprint 0 0
fingerprintFingerprints :: [Fingerprint] -> Fingerprint
fingerprintFingerprints fs = unsafeDupablePerformIO $
- withArrayLen fs $ \len p -> do
+ withArrayLen fs $ \len p ->
fingerprintData (castPtr p) (len * sizeOf (head fs))
fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
-fingerprintData buf len = do
+fingerprintData buf len =
allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
c_MD5Init pctxt
c_MD5Update pctxt buf (fromIntegral len)
@@ -71,7 +71,7 @@ fingerprintString str = unsafeDupablePerformIO $
--
-- @since 4.7.0.0
getFileHash :: FilePath -> IO Fingerprint
-getFileHash path = withBinaryFile path ReadMode $ \h -> do
+getFileHash path = withBinaryFile path ReadMode $ \h ->
allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
c_MD5Init pctxt
diff --git a/libraries/base/GHC/IO/Buffer.hs b/libraries/base/GHC/IO/Buffer.hs
index 167bc2a346..e062cbfc0b 100644
--- a/libraries/base/GHC/IO/Buffer.hs
+++ b/libraries/base/GHC/IO/Buffer.hs
@@ -319,7 +319,7 @@ summaryBuffer !buf -- Strict => slightly better code
-- operation, a read buffer always has at least one character of space.
checkBuffer :: Buffer a -> IO ()
-checkBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } = do
+checkBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } =
check buf (
size > 0
&& r <= w
diff --git a/libraries/base/GHC/IO/Encoding/Failure.hs b/libraries/base/GHC/IO/Encoding/Failure.hs
index c8d29f4d50..271d66b35f 100644
--- a/libraries/base/GHC/IO/Encoding/Failure.hs
+++ b/libraries/base/GHC/IO/Encoding/Failure.hs
@@ -146,7 +146,7 @@ unescapeRoundtripCharacterSurrogate c
recoverDecode :: CodingFailureMode -> Buffer Word8 -> Buffer Char
-> IO (Buffer Word8, Buffer Char)
recoverDecode cfm input@Buffer{ bufRaw=iraw, bufL=ir, bufR=_ }
- output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow } = do
+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow } =
--puts $ "recoverDecode " ++ show ir
case cfm of
ErrorOnCodingFailure -> ioe_decodingError
diff --git a/libraries/base/GHC/IO/Encoding/Iconv.hs b/libraries/base/GHC/IO/Encoding/Iconv.hs
index d1db6cd718..6c120cae58 100644
--- a/libraries/base/GHC/IO/Encoding/Iconv.hs
+++ b/libraries/base/GHC/IO/Encoding/Iconv.hs
@@ -177,7 +177,7 @@ iconvRecode iconv_t
iconv_trace ("iconvRecode after, input=" ++ show (summaryBuffer new_input))
iconv_trace ("iconvRecode after, output=" ++ show (summaryBuffer new_output))
if (res /= -1)
- then do -- all input translated
+ then -- all input translated
return (InputUnderflow, new_input, new_output)
else do
errno <- getErrno
diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs
index 4245bf0b26..277a7b41c2 100644
--- a/libraries/base/GHC/IO/FD.hs
+++ b/libraries/base/GHC/IO/FD.hs
@@ -379,8 +379,8 @@ getSize :: FD -> IO Integer
getSize fd = fdFileSize (fdFD fd)
setSize :: FD -> Integer -> IO ()
-setSize fd size = do
- throwErrnoIf_ (/=0) "GHC.IO.FD.setSize" $
+setSize fd size =
+ throwErrnoIf_ (/=0) "GHC.IO.FD.setSize" $
c_ftruncate (fdFD fd) (fromIntegral size)
devType :: FD -> IO IODeviceType
@@ -689,7 +689,7 @@ throwErrnoIfMinus1RetryOnBlock loc f on_block =
if err == eINTR
then throwErrnoIfMinus1RetryOnBlock loc f on_block
else if err == eWOULDBLOCK || err == eAGAIN
- then do on_block
+ then on_block
else throwErrno loc
else return res
#endif
diff --git a/libraries/base/GHC/IO/Handle.hs b/libraries/base/GHC/IO/Handle.hs
index f62acc1510..2ad608b0df 100644
--- a/libraries/base/GHC/IO/Handle.hs
+++ b/libraries/base/GHC/IO/Handle.hs
@@ -266,7 +266,7 @@ hSetBuffering handle mode =
-- the encoding.
--
hSetEncoding :: Handle -> TextEncoding -> IO ()
-hSetEncoding hdl encoding = do
+hSetEncoding hdl encoding =
withAllHandles__ "hSetEncoding" hdl $ \h_@Handle__{..} -> do
flushCharBuffer h_
closeTextCodecs h_
@@ -579,7 +579,7 @@ hGetEcho handle = do
-- | Is the handle connected to a terminal?
hIsTerminalDevice :: Handle -> IO Bool
-hIsTerminalDevice handle = do
+hIsTerminalDevice handle =
withHandle_ "hIsTerminalDevice" handle $ \ Handle__{..} -> do
case haType of
ClosedHandle -> ioe_closedHandle
@@ -641,7 +641,7 @@ hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } =
-- before the handle is duplicated.
hDuplicate :: Handle -> IO Handle
-hDuplicate h@(FileHandle path m) = do
+hDuplicate h@(FileHandle path m) =
withHandle_' "hDuplicate" h m $ \h_ ->
dupHandle path h Nothing h_ (Just handleFinalizer)
hDuplicate h@(DuplexHandle path r w) = do
@@ -667,7 +667,7 @@ dupHandle filepath h other_side h_@Handle__{..} mb_finalizer = do
new_dev <- IODevice.dup haDevice
dupHandle_ new_dev filepath other_side h_ mb_finalizer
Just r ->
- withHandle_' "dupHandle" h r $ \Handle__{haDevice=dev} -> do
+ withHandle_' "dupHandle" h r $ \Handle__{haDevice=dev} ->
dupHandle_ dev filepath other_side h_ mb_finalizer
dupHandle_ :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
@@ -697,19 +697,19 @@ This can be used to retarget the standard Handles, for example:
-}
hDuplicateTo :: Handle -> Handle -> IO ()
-hDuplicateTo h1@(FileHandle path m1) h2@(FileHandle _ m2) = do
+hDuplicateTo h1@(FileHandle path m1) h2@(FileHandle _ m2) =
withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
try $ flushWriteBuffer h2_
- withHandle_' "hDuplicateTo" h1 m1 $ \h1_ -> do
+ withHandle_' "hDuplicateTo" h1 m1 $ \h1_ ->
dupHandleTo path h1 Nothing h2_ h1_ (Just handleFinalizer)
hDuplicateTo h1@(DuplexHandle path r1 w1) h2@(DuplexHandle _ r2 w2) = do
withHandle__' "hDuplicateTo" h2 w2 $ \w2_ -> do
try $ flushWriteBuffer w2_
- withHandle_' "hDuplicateTo" h1 w1 $ \w1_ -> do
+ withHandle_' "hDuplicateTo" h1 w1 $ \w1_ ->
dupHandleTo path h1 Nothing w2_ w1_ (Just handleFinalizer)
withHandle__' "hDuplicateTo" h2 r2 $ \r2_ -> do
try $ flushWriteBuffer r2_
- withHandle_' "hDuplicateTo" h1 r1 $ \r1_ -> do
+ withHandle_' "hDuplicateTo" h1 r1 $ \r1_ ->
dupHandleTo path h1 (Just w1) r2_ r1_ Nothing
hDuplicateTo h1 _ =
ioe_dupHandlesNotCompatible h1
diff --git a/libraries/base/GHC/IO/Handle/Internals.hs b/libraries/base/GHC/IO/Handle/Internals.hs
index 120ae0ea66..d5f53b7dd5 100644
--- a/libraries/base/GHC/IO/Handle/Internals.hs
+++ b/libraries/base/GHC/IO/Handle/Internals.hs
@@ -477,10 +477,10 @@ flushBuffer :: Handle__ -> IO ()
flushBuffer h_@Handle__{..} = do
buf <- readIORef haCharBuffer
case bufState buf of
- ReadBuffer -> do
+ ReadBuffer -> do
flushCharReadBuffer h_
flushByteReadBuffer h_
- WriteBuffer -> do
+ WriteBuffer ->
flushByteWriteBuffer h_
-- | flushes the Char buffer only. Works on all Handles.
@@ -488,7 +488,7 @@ flushCharBuffer :: Handle__ -> IO ()
flushCharBuffer h_@Handle__{..} = do
cbuf <- readIORef haCharBuffer
case bufState cbuf of
- ReadBuffer -> do
+ ReadBuffer ->
flushCharReadBuffer h_
WriteBuffer ->
-- Nothing to do here. Char buffer on a write Handle is always empty
@@ -581,7 +581,7 @@ flushCharReadBuffer Handle__{..} = do
else do
case haDecoder of
- Nothing -> do
+ Nothing ->
writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
-- no decoder: the number of bytes to decode is the same as the
-- number of chars we have used up.
@@ -713,7 +713,7 @@ mkFileHandle :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev)
-> NewlineMode
-- Translate newlines?
-> IO Handle
-mkFileHandle dev filepath iomode mb_codec tr_newlines = do
+mkFileHandle dev filepath iomode mb_codec tr_newlines =
mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec
tr_newlines
(Just handleFinalizer) Nothing{-other_side-}
diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs
index 6d63bb0d54..fa5428cb35 100644
--- a/libraries/base/GHC/IO/Handle/Text.hs
+++ b/libraries/base/GHC/IO/Handle/Text.hs
@@ -87,7 +87,7 @@ import GHC.List
--
hWaitForInput :: Handle -> Int -> IO Bool
-hWaitForInput h msecs = do
+hWaitForInput h msecs =
wantReadableHandle_ "hWaitForInput" h $ \ handle_@Handle__{..} -> do
cbuf <- readIORef haCharBuffer
@@ -185,8 +185,8 @@ hGetChar handle =
hGetLine :: Handle -> IO String
hGetLine h =
- wantReadableHandle_ "hGetLine" h $ \ handle_ -> do
- hGetLineBuffered handle_
+ wantReadableHandle_ "hGetLine" h $ \ handle_ ->
+ hGetLineBuffered handle_
hGetLineBuffered :: Handle__ -> IO String
hGetLineBuffered handle_@Handle__{..} = do
@@ -299,12 +299,12 @@ unpack_nl !buf !r !w acc0
c <- peekElemOff pbuf i
if (c == '\n' && i > r)
then do
- c1 <- peekElemOff pbuf (i-1)
- if (c1 == '\r')
- then unpackRB ('\n':acc) (i-2)
- else unpackRB ('\n':acc) (i-1)
- else do
- unpackRB (c : acc) (i-1)
+ c1 <- peekElemOff pbuf (i-1)
+ if (c1 == '\r')
+ then unpackRB ('\n':acc) (i-2)
+ else unpackRB ('\n':acc) (i-1)
+ else
+ unpackRB (c : acc) (i-1)
in do
c <- peekElemOff pbuf (w-1)
if (c == '\r')
@@ -437,15 +437,16 @@ getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =
1 | haInputNL == CRLF -> do
(c,_) <- readCharBuf bufRaw bufL
if c == '\r'
- then do -- shuffle the '\r' to the beginning. This is only safe
- -- if we're about to call readTextDevice, otherwise it
- -- would mess up flushCharBuffer.
- -- See [note Buffer Flushing], GHC.IO.Handle.Types
- _ <- writeCharBuf bufRaw 0 '\r'
- let buf' = buf{ bufL=0, bufR=1 }
- readTextDevice handle_ buf'
- else do
- return buf
+ then do
+ -- shuffle the '\r' to the beginning. This is only safe
+ -- if we're about to call readTextDevice, otherwise it
+ -- would mess up flushCharBuffer.
+ -- See [note Buffer Flushing], GHC.IO.Handle.Types
+ _ <- writeCharBuf bufRaw 0 '\r'
+ let buf' = buf{ bufL=0, bufR=1 }
+ readTextDevice handle_ buf'
+ else
+ return buf
-- buffer has some chars in it already: just return it
_otherwise ->
@@ -551,27 +552,27 @@ lazyBuffersToString CRLF = loop '\0' where
hPutChar :: Handle -> Char -> IO ()
hPutChar handle c = do
c `seq` return ()
- wantWritableHandle "hPutChar" handle $ \ handle_ -> do
- hPutcBuffered handle_ c
+ wantWritableHandle "hPutChar" handle $ \ handle_ ->
+ hPutcBuffered handle_ c
hPutcBuffered :: Handle__ -> Char -> IO ()
hPutcBuffered handle_@Handle__{..} c = do
buf <- readIORef haCharBuffer
if c == '\n'
then do buf1 <- if haOutputNL == CRLF
- then do
- buf1 <- putc buf '\r'
- putc buf1 '\n'
- else do
- putc buf '\n'
+ then do
+ buf1 <- putc buf '\r'
+ putc buf1 '\n'
+ else
+ putc buf '\n'
writeCharBuffer handle_ buf1
- when is_line $ flushByteWriteBuffer handle_
+ when isLine $ flushByteWriteBuffer handle_
else do
buf1 <- putc buf c
writeCharBuffer handle_ buf1
return ()
where
- is_line = case haBufferMode of
+ isLine = case haBufferMode of
LineBuffering -> True
_ -> False
@@ -632,9 +633,9 @@ hPutStr' handle str add_nl =
(NoBuffering, _) -> do
hPutChars handle str -- v. slow, but we don't care
when add_nl $ hPutChar handle '\n'
- (LineBuffering, buf) -> do
+ (LineBuffering, buf) ->
writeBlocks handle True add_nl nl buf str
- (BlockBuffering _, buf) -> do
+ (BlockBuffering _, buf) ->
writeBlocks handle False add_nl nl buf str
hPutChars :: Handle -> [Char] -> IO ()
@@ -643,10 +644,7 @@ hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
-- Buffer offset is always zero.
getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
-getSpareBuffer Handle__{haCharBuffer=ref,
- haBuffers=spare_ref,
- haBufferMode=mode}
- = do
+getSpareBuffer Handle__{haCharBuffer=ref, haBuffers=spare_ref, haBufferMode=mode} =
case mode of
NoBuffering -> return (mode, errorWithoutStackTrace "no buffer!")
_ -> do
@@ -667,9 +665,9 @@ writeBlocks hdl line_buffered add_nl nl
buf@Buffer{ bufRaw=raw, bufSize=len } s =
let
shoveString :: Int -> [Char] -> [Char] -> IO ()
- shoveString !n [] [] = do
+ shoveString !n [] [] =
commitBuffer hdl raw len n False{-no flush-} True{-release-}
- shoveString !n [] rest = do
+ shoveString !n [] rest =
shoveString n rest []
shoveString !n (c:cs) rest
-- n+1 so we have enough room to write '\r\n' if necessary
@@ -678,18 +676,18 @@ writeBlocks hdl line_buffered add_nl nl
shoveString 0 (c:cs) rest
| c == '\n' = do
n' <- if nl == CRLF
- then do
- n1 <- writeCharBuf raw n '\r'
- writeCharBuf raw n1 '\n'
- else do
- writeCharBuf raw n c
+ then do
+ n1 <- writeCharBuf raw n '\r'
+ writeCharBuf raw n1 '\n'
+ else
+ writeCharBuf raw n c
if line_buffered
- then do
- -- end of line, so write and flush
- commitBuffer hdl raw len n' True{-flush-} False
- shoveString 0 cs rest
- else do
- shoveString n' cs rest
+ then do
+ -- end of line, so write and flush
+ commitBuffer hdl raw len n' True{-flush-} False
+ shoveString 0 cs rest
+ else
+ shoveString n' cs rest
| otherwise = do
n' <- writeCharBuf raw n c
shoveString n' cs rest
@@ -701,36 +699,31 @@ writeBlocks hdl line_buffered add_nl nl
--
-- Write the contents of the buffer 'buf' ('sz' bytes long, containing
-- 'count' bytes of data) to handle (handle must be block or line buffered).
-commitBuffer
- :: Handle -- handle to commit to
- -> RawCharBuffer -> Int -- address and size (in bytes) of buffer
- -> Int -- number of bytes of data in buffer
- -> Bool -- True <=> flush the handle afterward
- -> Bool -- release the buffer?
- -> IO ()
-
+commitBuffer :: Handle -- handle to commit to
+ -> RawCharBuffer -> Int -- address and size (in bytes) of buffer
+ -> Int -- number of bytes of data in buffer
+ -> Bool -- True <=> flush the handle afterward
+ -> Bool -- release the buffer?
+ -> IO ()
commitBuffer hdl !raw !sz !count flush release =
wantWritableHandle "commitBuffer" hdl $ \h_@Handle__{..} -> do
- debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
- ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++ ", handle=" ++ show hdl)
-
+ let debugMsg = ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
+ ++ ", flush=" ++ show flush ++ ", release=" ++ show release
+ ++ ", handle=" ++ show hdl)
+ debugIO debugMsg
-- Offset taken from handle
- writeCharBuffer h_ Buffer{ bufRaw=raw, bufState=WriteBuffer, bufOffset=0,
- bufL=0, bufR=count, bufSize=sz }
-
- when flush $ flushByteWriteBuffer h_
-
- -- release the buffer if necessary
- when release $ do
- -- find size of current buffer
- old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer
- when (sz == size) $ do
- spare_bufs <- readIORef haBuffers
- writeIORef haBuffers (BufferListCons raw spare_bufs)
-
- -- bb <- readIORef haByteBuffer
- -- debugIO ("commitBuffer: buffer=" ++ summaryBuffer bb ++ ", handle=" ++ show hdl)
- return ()
+ writeCharBuffer h_ Buffer{ bufRaw=raw, bufState=WriteBuffer, bufOffset=0,
+ bufL=0, bufR=count, bufSize=sz }
+ when flush $ flushByteWriteBuffer h_
+ -- release the buffer if necessary
+ when release $ do
+ -- find size of current buffer
+ old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer
+ when (sz == size) $ do
+ spare_bufs <- readIORef haBuffers
+ writeIORef haBuffers (BufferListCons raw spare_bufs)
+ -- bb <- readIORef haByteBuffer
+ -- debugIO ("commitBuffer: buffer=" ++ summaryBuffer bb ++ ", handle=" ++ show hdl)
-- backwards compatibility; the text package uses this
commitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__
@@ -812,8 +805,8 @@ hPutBuf' handle ptr count can_block
-- it is set to LineBuffering, be conservative and flush
-- anyway (we didn't check for newlines in the data).
case haBufferMode of
- BlockBuffering _ -> do return ()
- _line_or_no_buffering -> do flushWriteBuffer h_
+ BlockBuffering _ -> return ()
+ _line_or_no_buffering -> flushWriteBuffer h_
return r
-- TODO: Possible optimisation:
@@ -842,7 +835,7 @@ bufWrite h_@Handle__{..} ptr !count can_block = do
else do
let offset = bufOffset flushed_buf
!bytes <- if can_block
- then do writeChunk h_ (castPtr ptr) offset count
+ then writeChunk h_ (castPtr ptr) offset count
else writeChunkNonBlocking h_ (castPtr ptr) offset count
-- Update buffer with actual bytes written.
writeIORef haByteBuffer $! bufferAddOffset bytes flushed_buf
@@ -852,7 +845,7 @@ bufWrite h_@Handle__{..} ptr !count can_block = do
-- Flush the given buffer via the handle, return the flushed buffer
flushByteWriteBufferGiven :: Handle__ -> Buffer Word8 -> IO (Buffer Word8)
-flushByteWriteBufferGiven h_@Handle__{..} bbuf = do
+flushByteWriteBufferGiven h_@Handle__{..} bbuf =
if (not (isEmptyBuffer bbuf))
then do
bbuf' <- Buffered.flushWriteBuffer haDevice bbuf
@@ -878,7 +871,7 @@ bufferChunk h_@Handle__{..} old_buf@Buffer{ bufRaw=raw, bufR=w, bufSize=size } p
debugIO "hPutBuf: flushing full buffer after writing"
_ <- flushByteWriteBufferGiven h_ copied_buf
return ()
- else do
+ else
writeIORef haByteBuffer copied_buf
return count
diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs
index 146d24f05b..0cf892f0a0 100644
--- a/libraries/base/GHC/TypeLits.hs
+++ b/libraries/base/GHC/TypeLits.hs
@@ -53,10 +53,9 @@ module GHC.TypeLits
) where
-import GHC.Base(Eq(..), Ord(..), Ordering(..), otherwise)
+import GHC.Base(Eq(..), Ord(..), Ordering(..), String, otherwise)
import GHC.Types( Nat, Symbol )
import GHC.Num(Integer, fromInteger)
-import GHC.Base(String)
import GHC.Show(Show(..))
import GHC.Read(Read(..))
import GHC.Real(toInteger)
diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs
index 03e0e06319..c5dfe057ba 100644
--- a/libraries/base/System/IO.hs
+++ b/libraries/base/System/IO.hs
@@ -368,10 +368,8 @@ appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
-- | The 'readLn' function combines 'getLine' and 'readIO'.
-readLn :: Read a => IO a
-readLn = do l <- getLine
- r <- readIO l
- return r
+readLn :: Read a => IO a
+readLn = getLine >>= readIO
-- | The 'readIO' function is similar to 'read' except that it signals
-- parse failure to the 'IO' monad instead of terminating the program.
diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs
index ea8ddf2173..4bdeabe1bd 100644
--- a/libraries/base/System/Posix/Internals.hs
+++ b/libraries/base/System/Posix/Internals.hs
@@ -95,7 +95,7 @@ fdFileSize fd =
fileType :: FilePath -> IO IODeviceType
fileType file =
- allocaBytes sizeof_stat $ \ p_stat -> do
+ allocaBytes sizeof_stat $ \ p_stat ->
withFilePath file $ \p_file -> do
throwErrnoIfMinus1Retry_ "fileType" $
c_stat p_file p_stat
@@ -187,7 +187,7 @@ peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp
#if defined(HTYPE_TCFLAG_T)
setEcho :: FD -> Bool -> IO ()
-setEcho fd on = do
+setEcho fd on =
tcSetAttr fd $ \ p_tios -> do
lflag <- c_lflag p_tios :: IO CTcflag
let new_lflag
@@ -196,7 +196,7 @@ setEcho fd on = do
poke_c_lflag p_tios (new_lflag :: CTcflag)
getEcho :: FD -> IO Bool
-getEcho fd = do
+getEcho fd =
tcSetAttr fd $ \ p_tios -> do
lflag <- c_lflag p_tios :: IO CTcflag
return ((lflag .&. fromIntegral const_echo) /= 0)
@@ -220,7 +220,7 @@ setCooked fd cooked =
poke vtime 0
tcSetAttr :: FD -> (Ptr CTermios -> IO a) -> IO a
-tcSetAttr fd fun = do
+tcSetAttr fd fun =
allocaBytes sizeof_termios $ \p_tios -> do
throwErrnoIfMinus1Retry_ "tcSetAttr"
(c_tcgetattr fd p_tios)
@@ -239,7 +239,7 @@ tcSetAttr fd fun = do
-- in its terminal flags (try it...). This function provides a
-- wrapper which temporarily blocks SIGTTOU around the call, making it
-- transparent.
- allocaBytes sizeof_sigset_t $ \ p_sigset -> do
+ allocaBytes sizeof_sigset_t $ \ p_sigset ->
allocaBytes sizeof_sigset_t $ \ p_old_sigset -> do
throwErrnoIfMinus1_ "sigemptyset" $
c_sigemptyset p_sigset
@@ -339,7 +339,7 @@ setNonBlockingFD _ _ = return ()
#if !defined(mingw32_HOST_OS)
setCloseOnExec :: FD -> IO ()
-setCloseOnExec fd = do
+setCloseOnExec fd =
throwErrnoIfMinus1_ "setCloseOnExec" $
c_fcntl_write fd const_f_setfd const_fd_cloexec
#endif
diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs
index e6dcab55e0..d01dd931c8 100644
--- a/libraries/base/Text/ParserCombinators/ReadP.hs
+++ b/libraries/base/Text/ParserCombinators/ReadP.hs
@@ -278,9 +278,9 @@ string :: String -> ReadP String
-- ^ Parses and returns the specified string.
string this = do s <- look; scan this s
where
- scan [] _ = do return this
+ scan [] _ = return this
scan (x:xs) (y:ys) | x == y = do _ <- get; scan xs ys
- scan _ _ = do pfail
+ scan _ _ = pfail
munch :: (Char -> Bool) -> ReadP String
-- ^ Parses the first zero or more characters satisfying the predicate.
@@ -291,7 +291,7 @@ munch p =
scan s
where
scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s)
- scan _ = do return ""
+ scan _ = return ""
munch1 :: (Char -> Bool) -> ReadP String
-- ^ Parses the first one or more characters satisfying the predicate.
@@ -315,7 +315,7 @@ skipSpaces =
skip s
where
skip (c:s) | isSpace c = do _ <- get; skip s
- skip _ = do return ()
+ skip _ = return ()
count :: Int -> ReadP a -> ReadP [a]
-- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of
diff --git a/libraries/base/Text/Printf.hs b/libraries/base/Text/Printf.hs
index 3aeb0be789..216c29d9e3 100644
--- a/libraries/base/Text/Printf.hs
+++ b/libraries/base/Text/Printf.hs
@@ -292,7 +292,7 @@ instance (a ~ ()) => PrintfType (IO a) where
-- | @since 4.7.0.0
instance (a ~ ()) => HPrintfType (IO a) where
- hspr hdl fmts args = do
+ hspr hdl fmts args =
hPutStr hdl (uprintf fmts (reverse args))
-- | @since 2.01
diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs
index 7568f9afaf..7da09164fb 100644
--- a/libraries/base/Text/Read/Lex.hs
+++ b/libraries/base/Text/Read/Lex.hs
@@ -273,7 +273,7 @@ lexCharE =
do c1 <- get
if c1 == '\\'
then do c2 <- lexEsc; return (c2, True)
- else do return (c1, False)
+ else return (c1, False)
where
lexEsc =
lexEscChar
@@ -341,7 +341,7 @@ lexCharE =
_ -> pfail
lexAscii =
- do choice
+ choice
[ (string "SOH" >> return '\SOH') <++
(string "SO" >> return '\SO')
-- \SO and \SOH need maximal-munch treatment
@@ -404,9 +404,9 @@ lexString =
do _ <- char '\\'
c <- get
case c of
- '&' -> do return ()
+ '&' -> return ()
_ | isSpace c -> do skipSpaces; _ <- char '\\'; return ()
- _ -> do pfail
+ _ -> pfail
-- ---------------------------------------------------------------------------
-- Lexing numbers
@@ -429,13 +429,14 @@ lexHexOct
lexBaseChar :: ReadP Int
-- Lex a single character indicating the base; fail if not there
-lexBaseChar = do { c <- get;
- case c of
- 'o' -> return 8
- 'O' -> return 8
- 'x' -> return 16
- 'X' -> return 16
- _ -> pfail }
+lexBaseChar = do
+ c <- get
+ case c of
+ 'o' -> return 8
+ 'O' -> return 8
+ 'x' -> return 16
+ 'X' -> return 16
+ _ -> pfail
lexDecNumber :: ReadP Lexeme
lexDecNumber =
@@ -471,8 +472,8 @@ lexDigits base =
where
scan (c:cs) f = case valDig base c of
Just n -> do _ <- get; scan cs (f.(n:))
- Nothing -> do return (f [])
- scan [] f = do return (f [])
+ Nothing -> return (f [])
+ scan [] f = return (f [])
lexInteger :: Base -> ReadP Integer
lexInteger base =
diff --git a/libraries/base/Unsafe/Coerce.hs b/libraries/base/Unsafe/Coerce.hs
index 0e899ef37a..ea60259ffc 100644
--- a/libraries/base/Unsafe/Coerce.hs
+++ b/libraries/base/Unsafe/Coerce.hs
@@ -9,7 +9,6 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE Unsafe #-}
diff --git a/libraries/base/tests/Concurrent/MVar001.hs b/libraries/base/tests/Concurrent/MVar001.hs
index 6062cbfa46..0d96a7eb27 100644
--- a/libraries/base/tests/Concurrent/MVar001.hs
+++ b/libraries/base/tests/Concurrent/MVar001.hs
@@ -78,7 +78,7 @@ perform' mv (a:as) =
actions :: Gen [Action]
-actions = do
+actions =
oneof [liftM (NewEmptyMVar:) (actions' True),
liftM2 (:) (liftM NewMVar arbitrary) (actions' False)]
diff --git a/libraries/base/tests/IO/encoding001.hs b/libraries/base/tests/IO/encoding001.hs
index c92f8a3ef5..df3c5f914c 100644
--- a/libraries/base/tests/IO/encoding001.hs
+++ b/libraries/base/tests/IO/encoding001.hs
@@ -33,7 +33,7 @@ main = do
hClose h
-- convert the UTF-32BE file into each other encoding
- forM_ encodings $ \(enc,name) -> do
+ forM_ encodings $ \(enc,name) ->
when (name /= "utf32be") $ do
hin <- openFile (file <.> "utf32be") ReadMode
hSetEncoding hin utf32be
diff --git a/libraries/base/tests/IO/encoding004.hs b/libraries/base/tests/IO/encoding004.hs
index 62ef5d6a93..ffd76191f3 100644
--- a/libraries/base/tests/IO/encoding004.hs
+++ b/libraries/base/tests/IO/encoding004.hs
@@ -58,8 +58,8 @@ main = forM_ [ ("CP936", 2, "CP936", Just "CP936-UTF8") -- Representative
utf8_bs <- BS.readFile ("encoded-data" </> utf8_file <.> "txt")
Right expected <- decode utf8 utf8_bs
Right actual <- decode enc bs
- unless (expected == actual) $ do
- putStrLn (bsDiff 0 actual expected)
+ unless (expected == actual) $
+ putStrLn (bsDiff 0 actual expected)
forTruncations :: BS.ByteString -> (BS.ByteString -> IO a) -> IO [a]
forTruncations bs f = forSplits bs $ \before _ -> f before
diff --git a/libraries/base/tests/IO/hClose002.hs b/libraries/base/tests/IO/hClose002.hs
index ebf26b4663..20eb0f888a 100644
--- a/libraries/base/tests/IO/hClose002.hs
+++ b/libraries/base/tests/IO/hClose002.hs
@@ -27,6 +27,6 @@ showPossibleException f = do e <- try f
print (e :: Either SomeException ())
naughtyClose h =
- withHandle_ "naughtyClose" h $ \ Handle__{haDevice=dev} -> do
+ withHandle_ "naughtyClose" h $ \ Handle__{haDevice=dev} ->
IODevice.close dev
diff --git a/libraries/base/tests/IO/hClose003.hs b/libraries/base/tests/IO/hClose003.hs
index cbaf49d6db..6d962fd94e 100644
--- a/libraries/base/tests/IO/hClose003.hs
+++ b/libraries/base/tests/IO/hClose003.hs
@@ -38,5 +38,5 @@ showPossibleException f = do
sanitise' (x:xs) = if isDigit x then (sanitise' xs) else (x:(sanitise xs))
naughtyClose h =
- withHandle_ "naughtyClose" h $ \ Handle__{haDevice=dev} -> do
+ withHandle_ "naughtyClose" h $ \ Handle__{haDevice=dev} ->
IODevice.close dev
diff --git a/libraries/base/tests/IO/hDuplicateTo001.hs b/libraries/base/tests/IO/hDuplicateTo001.hs
index 99f956a0df..e286235e14 100644
--- a/libraries/base/tests/IO/hDuplicateTo001.hs
+++ b/libraries/base/tests/IO/hDuplicateTo001.hs
@@ -18,7 +18,7 @@ main = do
putStrLn "bla"
-getfd h@(FileHandle _ mvar) = do
+getfd h@(FileHandle _ mvar) =
withMVar mvar $ \h__@Handle__{haDevice=dev} ->
case cast dev of
Just fd -> return (FD.fdFD fd)
diff --git a/libraries/base/tests/IO/hReady002.hs b/libraries/base/tests/IO/hReady002.hs
index b8b648065b..b13ef8911e 100644
--- a/libraries/base/tests/IO/hReady002.hs
+++ b/libraries/base/tests/IO/hReady002.hs
@@ -5,6 +5,6 @@ import System.Exit
main = do
m <- newEmptyMVar
- forkIO $ do threadDelay 500000; putMVar m Nothing
- forkIO $ do hReady stdin >>= putMVar m . Just
+ forkIO $ threadDelay 500000 >> putMVar m Nothing
+ forkIO $ hReady stdin >>= putMVar m . Just
takeMVar m >>= print
diff --git a/libraries/base/tests/IO/newline001.hs b/libraries/base/tests/IO/newline001.hs
index 3da867509f..1c894422a9 100644
--- a/libraries/base/tests/IO/newline001.hs
+++ b/libraries/base/tests/IO/newline001.hs
@@ -101,7 +101,7 @@ testoutput b = do
check "out2" b (toCRLF content) str
hClose h
-check s b str1 str2 = do
+check s b str1 str2 =
when (str1 /= str2) $ error ("failed: " ++ s ++ ", " ++ show b ++ '\n':show str1 ++ '\n':show str2)
read_chars :: Handle -> IO String
diff --git a/libraries/base/tests/IO/readwrite002.hs b/libraries/base/tests/IO/readwrite002.hs
index 37c7da39cb..5795525b2c 100644
--- a/libraries/base/tests/IO/readwrite002.hs
+++ b/libraries/base/tests/IO/readwrite002.hs
@@ -29,7 +29,6 @@ main = do
hSeek cd AbsoluteSeek 0
hSetBuffering cd LineBuffering
speak cd `catchIOError` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
- return ()
hSeek cd AbsoluteSeek 0
hSetBuffering cd (BlockBuffering Nothing)
speak cd `catchIOError` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
diff --git a/libraries/base/tests/T13167.hs b/libraries/base/tests/T13167.hs
index e41104cde9..d8808667b1 100644
--- a/libraries/base/tests/T13167.hs
+++ b/libraries/base/tests/T13167.hs
@@ -25,5 +25,5 @@ run = do
quit :: MVar () -> IO ()
quit m = do
ref <- newIORef ()
- void $ mkWeakIORef ref $ do
+ void $ mkWeakIORef ref $
putMVar m ()
diff --git a/libraries/base/tests/T13896.hs b/libraries/base/tests/T13896.hs
index 9e269a4a7c..8b4c47f44a 100644
--- a/libraries/base/tests/T13896.hs
+++ b/libraries/base/tests/T13896.hs
@@ -65,11 +65,11 @@ main = do
-- without escaping everything inside
(filter (not . null) $
- unescapeArgs "this\\ is\\ 'not escape\\d \"inside\"'\\ yo\n")
- `assertEqual`
- ["this is not escaped \"inside\" yo"]
+ unescapeArgs "this\\ is\\ 'not escape\\d \"inside\"'\\ yo\n")
+ `assertEqual`
+ ["this is not escaped \"inside\" yo"]
(filter (not . null) $
- unescapeArgs "this\\ is\\ \"not escape\\d 'inside'\"\\ yo\n")
- `assertEqual`
- ["this is not escaped 'inside' yo"]
+ unescapeArgs "this\\ is\\ \"not escape\\d 'inside'\"\\ yo\n")
+ `assertEqual`
+ ["this is not escaped 'inside' yo"]
diff --git a/libraries/base/tests/T9532.hs b/libraries/base/tests/T9532.hs
index e99a42b572..b9f280fcf8 100644
--- a/libraries/base/tests/T9532.hs
+++ b/libraries/base/tests/T9532.hs
@@ -68,7 +68,7 @@ main = do
-- Compare impl-under-test with reference-impl
checkCLZ :: (Typeable a, Show a, Integral a, FiniteBits a) => a -> IO ()
- checkCLZ v = unless (vri == viut) $ do
+ checkCLZ v = unless (vri == viut) $
putStrLn $ concat [ "FAILED: clz (0x", showHex v " :: ", tyName
, ") ==> (RI=", show vri, " vs. IUT=", show viut, ")"
]
@@ -79,7 +79,7 @@ main = do
-- Compare impl-under-test with reference-impl
checkCTZ :: (Typeable a, Show a, Integral a, FiniteBits a) => a -> IO ()
- checkCTZ v = unless (vri == viut) $ do
+ checkCTZ v = unless (vri == viut) $
putStrLn $ concat [ "FAILED: ctz (0x", showHex v " :: ", tyName
, ") ==> (RI=", show vri, " vs. IUT=", show viut, ")"
]
diff --git a/libraries/base/tests/foldableArray.hs b/libraries/base/tests/foldableArray.hs
index 92217d73d2..5caf4eeb76 100644
--- a/libraries/base/tests/foldableArray.hs
+++ b/libraries/base/tests/foldableArray.hs
@@ -6,7 +6,6 @@ module Main where
import Prelude hiding (foldr, foldl, foldl', foldr1, foldl1, length, null, sum,
product, all, any, and, or)
-import Data.Foldable
import Control.Exception
import Data.Array
import Data.Foldable
diff --git a/libraries/base/tests/qsem001.hs b/libraries/base/tests/qsem001.hs
index 0088c6e989..4254c2b9fc 100644
--- a/libraries/base/tests/qsem001.hs
+++ b/libraries/base/tests/qsem001.hs
@@ -68,7 +68,7 @@ sem_fifo = do
sem_kill :: Assertion
sem_kill = do
q <- new 0
- t <- forkIO $ do wait q
+ t <- forkIO $ wait q
threadDelay 100000
killThread t
m <- newEmptyMVar
@@ -80,8 +80,8 @@ sem_kill = do
sem_bracket :: Assertion
sem_bracket = do
q <- new 1
- ts <- forM [1..100000] $ \n -> do
- forkIO $ do bracket_ (wait q) (signal q) (return ())
+ ts <- forM [1..100000] $ \n ->
+ forkIO $ bracket_ (wait q) (signal q) (return ())
mapM_ killThread ts
wait q
diff --git a/libraries/base/tests/qsemn001.hs b/libraries/base/tests/qsemn001.hs
index c61d2896c2..3f76f376aa 100644
--- a/libraries/base/tests/qsemn001.hs
+++ b/libraries/base/tests/qsemn001.hs
@@ -92,7 +92,7 @@ semn3 = do
semn_kill :: Assertion
semn_kill = do
q <- new 0
- t <- forkIO $ do wait q 1
+ t <- forkIO $ wait q 1
threadDelay 10000
killThread t
m <- newEmptyMVar
@@ -103,7 +103,7 @@ semn_kill = do
sem_bracket :: Assertion
sem_bracket = do
q <- new 1
- ts <- forM [1..100000] $ \n -> do
- forkIO $ do bracket_ (wait q 1) (signal q 1) (return ())
+ ts <- forM [1..100000] $ \n ->
+ forkIO $ bracket_ (wait q 1) (signal q 1) (return ())
mapM_ killThread ts
wait q 1