diff options
45 files changed, 388 insertions, 388 deletions
diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs index afb715193b..c581d1a5c4 100644 --- a/libraries/base/Control/Exception/Base.hs +++ b/libraries/base/Control/Exception/Base.hs @@ -7,7 +7,7 @@ -- Module : Control.Exception.Base -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (extended exceptions) @@ -387,7 +387,7 @@ recSelError, recConError, irrefutPatError, runtimeError, :: Addr# -> a -- All take a UTF8-encoded C string recSelError s = throw (RecSelError ("No match in record selector " - ++ unpackCStringUtf8# s)) -- No location info unfortunately + ++ unpackCStringUtf8# s)) -- No location info unfortunately runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately absentError s = error ("Oops! Entered absent arg " ++ unpackCStringUtf8# s) diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs index 561d40d135..889f91a2dc 100644 --- a/libraries/base/Control/Monad.hs +++ b/libraries/base/Control/Monad.hs @@ -146,7 +146,7 @@ function' are not commutative. > foldM f a1 [x1, x2, ..., xm] -== +== > do > a2 <- f a1 x1 @@ -223,23 +223,23 @@ mfilter p ma = do {- $naming -The functions in this library use the following naming conventions: +The functions in this library use the following naming conventions: * A postfix \'@M@\' always stands for a function in the Kleisli category: The monad type constructor @m@ is added to function results - (modulo currying) and nowhere else. So, for example, + (modulo currying) and nowhere else. So, for example, > filter :: (a -> Bool) -> [a] -> [a] > filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a] * A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@. - Thus, for example: + Thus, for example: -> sequence :: Monad m => [m a] -> m [a] -> sequence_ :: Monad m => [m a] -> m () +> sequence :: Monad m => [m a] -> m [a] +> sequence_ :: Monad m => [m a] -> m () * A prefix \'@m@\' generalizes an existing function to a monadic form. - Thus, for example: + Thus, for example: > sum :: Num a => [a] -> a > msum :: MonadPlus m => [m a] -> m a diff --git a/libraries/base/Control/Monad/Fix.hs b/libraries/base/Control/Monad/Fix.hs index 98aaa2682b..76faeaf655 100644 --- a/libraries/base/Control/Monad/Fix.hs +++ b/libraries/base/Control/Monad/Fix.hs @@ -69,7 +69,7 @@ instance MonadFix [] where (x:_) -> x : mfix (tail . f) instance MonadFix IO where - mfix = fixIO + mfix = fixIO instance MonadFix ((->) r) where mfix f = \ r -> let a = f a r in a diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index c2ce58dd6a..4aa785b3b8 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -41,7 +41,7 @@ module Data.Data ( dataTypeOf, dataCast1, -- mediate types and unary type constructors dataCast2, -- mediate types and binary type constructors - -- Generic maps defined in terms of gfoldl + -- Generic maps defined in terms of gfoldl gmapT, gmapQ, gmapQl, @@ -351,10 +351,10 @@ class Typeable a => Data a where -- injection and projection using 'return' and '>>='. gmapM :: forall m. Monad m => (forall d. Data d => d -> m d) -> a -> m a - -- Use immediately the monad datatype constructor + -- Use immediately the monad datatype constructor -- to instantiate the type constructor c in the type of gfoldl, -- so injection and projection is done by return and >>=. - -- + -- gmapM f = gfoldl k return where k :: Data d => m (d -> b) -> d -> m b @@ -391,8 +391,8 @@ this end, we couple the monadic computation with a Boolean. {- -We use the same pairing trick as for gmapMp, -i.e., we use an extra Bool component to keep track of the +We use the same pairing trick as for gmapMp, +i.e., we use an extra Bool component to keep track of the fact whether an immediate subterm was processed successfully. However, we cut of mapping over subterms once a first subterm was transformed successfully. @@ -455,7 +455,7 @@ fromConstrB f = unID . gunfold k z where k :: forall b r. Data b => ID (b -> r) -> ID r k c = ID (unID c f) - + z :: forall r. r -> ID r z = ID @@ -625,7 +625,7 @@ dataTypeConstrs dt = case datarep dt of -- | Gets the field labels of a constructor. The list of labels --- is returned in the same order as they were given in the original +-- is returned in the same order as they were given in the original -- constructor declaration. constrFields :: Constr -> [String] constrFields = confields @@ -640,7 +640,7 @@ constrFixity = confixity ------------------------------------------------------------------------------ -- -- From strings to constr's and vice versa: all data types --- +-- ------------------------------------------------------------------------------ @@ -1319,7 +1319,7 @@ instance (Data a, Typeable a) => Data (ForeignPtr a) where dataCast1 x = gcast1 x ------------------------------------------------------------------------------ --- The Data instance for Array preserves data abstraction at the cost of +-- The Data instance for Array preserves data abstraction at the cost of -- inefficiency. We omit reflection services for the sake of data abstraction. instance (Typeable a, Data a, Data b, Ix a) => Data (Array a b) where diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs index 2bda8278c7..688fd06ec0 100644 --- a/libraries/base/Data/Foldable.hs +++ b/libraries/base/Data/Foldable.hs @@ -102,7 +102,7 @@ class Foldable t where foldr :: (a -> b -> b) -> b -> t a -> b foldr f z t = appEndo (foldMap (Endo . f) t) z - -- | Right-associative fold of a structure, + -- | Right-associative fold of a structure, -- but with strict application of the operator. foldr' :: (a -> b -> b) -> b -> t a -> b foldr' f z0 xs = foldl f' id xs z0 diff --git a/libraries/base/Data/Functor.hs b/libraries/base/Data/Functor.hs index 43ca8218f4..878445f6fa 100644 --- a/libraries/base/Data/Functor.hs +++ b/libraries/base/Data/Functor.hs @@ -6,7 +6,7 @@ -- Module : Data.Functor -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable diff --git a/libraries/base/Data/Maybe.hs b/libraries/base/Data/Maybe.hs index 5923ae1061..33721e7f0d 100644 --- a/libraries/base/Data/Maybe.hs +++ b/libraries/base/Data/Maybe.hs @@ -6,7 +6,7 @@ -- Module : Data.Maybe -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable @@ -80,7 +80,7 @@ listToMaybe [] = Nothing listToMaybe (a:_) = Just a -- | The 'catMaybes' function takes a list of 'Maybe's and returns --- a list of all the 'Just' values. +-- a list of all the 'Just' values. catMaybes :: [Maybe a] -> [a] catMaybes ls = [x | Just x <- ls] diff --git a/libraries/base/Data/OldTypeable/Internal.hs b/libraries/base/Data/OldTypeable/Internal.hs index 76869400b1..0c4db80145 100644 --- a/libraries/base/Data/OldTypeable/Internal.hs +++ b/libraries/base/Data/OldTypeable/Internal.hs @@ -5,7 +5,7 @@ -- Module : Data.Typeable.Internal -- Copyright : (c) The University of Glasgow, CWI 2001--2011 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- The representations of the types TyCon and TypeRep, and the -- function mkTyCon which is used by derived instances of Typeable to -- construct a TyCon. @@ -128,7 +128,7 @@ mkTyConApp tc@(TyCon tc_k _ _ _) args where arg_ks = [k | TypeRep k _ _ <- args] --- | A special case of 'mkTyConApp', which applies the function +-- | A special case of 'mkTyConApp', which applies the function -- type constructor to a pair of types. mkFunTy :: TypeRep -> TypeRep -> TypeRep mkFunTy f a = mkTyConApp funTc [f,a] @@ -152,7 +152,7 @@ mkAppTy :: TypeRep -> TypeRep -> TypeRep mkAppTy (TypeRep _ tc trs) arg_tr = mkTyConApp tc (trs ++ [arg_tr]) -- Notice that we call mkTyConApp to construct the fingerprint from tc and -- the arg fingerprints. Simply combining the current fingerprint with - -- the new one won't give the same answer, but of course we want to + -- the new one won't give the same answer, but of course we want to -- ensure that a TypeRep of the same shape has the same fingerprint! -- See Trac #5962 @@ -195,13 +195,13 @@ tyConString = tyConName ~~~~~~~~~~~~~~~~~~~~~~~~~~ IMPORTANT: we don't want to recalculate the type-rep once per call to the dummy argument. This is what went wrong in Trac #3245 -So we help GHC by manually keeping the 'rep' *outside* the value +So we help GHC by manually keeping the 'rep' *outside* the value lambda, thus - + typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep typeOfDefault = \_ -> rep where - rep = typeOf1 (undefined :: t a) `mkAppTy` + rep = typeOf1 (undefined :: t a) `mkAppTy` typeOf (undefined :: a) Notice the crucial use of scoped type variables here! @@ -224,7 +224,7 @@ class Typeable1 t where typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep typeOfDefault = \_ -> rep where - rep = typeOf1 (undefined :: t a) `mkAppTy` + rep = typeOf1 (undefined :: t a) `mkAppTy` typeOf (undefined :: a) -- Note [Memoising typeOf] @@ -234,9 +234,9 @@ class Typeable2 t where -- | For defining a 'Typeable1' instance from any 'Typeable2' instance. typeOf1Default :: forall t a b. (Typeable2 t, Typeable a) => t a b -> TypeRep -typeOf1Default = \_ -> rep +typeOf1Default = \_ -> rep where - rep = typeOf2 (undefined :: t a b) `mkAppTy` + rep = typeOf2 (undefined :: t a b) `mkAppTy` typeOf (undefined :: a) -- Note [Memoising typeOf] @@ -246,9 +246,9 @@ class Typeable3 t where -- | For defining a 'Typeable2' instance from any 'Typeable3' instance. typeOf2Default :: forall t a b c. (Typeable3 t, Typeable a) => t a b c -> TypeRep -typeOf2Default = \_ -> rep +typeOf2Default = \_ -> rep where - rep = typeOf3 (undefined :: t a b c) `mkAppTy` + rep = typeOf3 (undefined :: t a b c) `mkAppTy` typeOf (undefined :: a) -- Note [Memoising typeOf] @@ -260,19 +260,19 @@ class Typeable4 t where typeOf3Default :: forall t a b c d. (Typeable4 t, Typeable a) => t a b c d -> TypeRep typeOf3Default = \_ -> rep where - rep = typeOf4 (undefined :: t a b c d) `mkAppTy` + rep = typeOf4 (undefined :: t a b c d) `mkAppTy` typeOf (undefined :: a) -- Note [Memoising typeOf] - + -- | Variant for 5-ary type constructors class Typeable5 t where typeOf5 :: t a b c d e -> TypeRep -- | For defining a 'Typeable4' instance from any 'Typeable5' instance. typeOf4Default :: forall t a b c d e. (Typeable5 t, Typeable a) => t a b c d e -> TypeRep -typeOf4Default = \_ -> rep +typeOf4Default = \_ -> rep where - rep = typeOf5 (undefined :: t a b c d e) `mkAppTy` + rep = typeOf5 (undefined :: t a b c d e) `mkAppTy` typeOf (undefined :: a) -- Note [Memoising typeOf] @@ -284,7 +284,7 @@ class Typeable6 t where typeOf5Default :: forall t a b c d e f. (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep typeOf5Default = \_ -> rep where - rep = typeOf6 (undefined :: t a b c d e f) `mkAppTy` + rep = typeOf6 (undefined :: t a b c d e f) `mkAppTy` typeOf (undefined :: a) -- Note [Memoising typeOf] @@ -296,7 +296,7 @@ class Typeable7 t where typeOf6Default :: forall t a b c d e f g. (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep typeOf6Default = \_ -> rep where - rep = typeOf7 (undefined :: t a b c d e f g) `mkAppTy` + rep = typeOf7 (undefined :: t a b c d e f g) `mkAppTy` typeOf (undefined :: a) -- Note [Memoising typeOf] @@ -355,8 +355,8 @@ instance Show TypeRep where xs | isTupleTyCon tycon -> showTuple xs | otherwise -> showParen (p > 9) $ - showsPrec p tycon . - showChar ' ' . + showsPrec p tycon . + showChar ' ' . showArgs tys showsTypeRep :: TypeRep -> ShowS @@ -374,11 +374,11 @@ isTupleTyCon _ = False showArgs :: Show a => [a] -> ShowS showArgs [] = id showArgs [a] = showsPrec 10 a -showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as +showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as showTuple :: [TypeRep] -> ShowS showTuple args = showChar '(' - . (foldr (.) id $ intersperse (showChar ',') + . (foldr (.) id $ intersperse (showChar ',') $ map (showsPrec 10) args) . showChar ')' diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index 4e72bc4015..140b895509 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -6,7 +6,7 @@ -- Module : Data.Typeable.Internal -- Copyright : (c) The University of Glasgow, CWI 2001--2011 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- The representations of the types TyCon and TypeRep, and the -- function mkTyCon which is used by derived instances of Typeable to -- construct a TyCon. @@ -137,7 +137,7 @@ mkTyConApp tc@(TyCon tc_k _ _ _) args where arg_ks = [k | TypeRep k _ _ <- args] --- | A special case of 'mkTyConApp', which applies the function +-- | A special case of 'mkTyConApp', which applies the function -- type constructor to a pair of types. mkFunTy :: TypeRep -> TypeRep -> TypeRep mkFunTy f a = mkTyConApp funTc [f,a] @@ -161,7 +161,7 @@ mkAppTy :: TypeRep -> TypeRep -> TypeRep mkAppTy (TypeRep _ tc trs) arg_tr = mkTyConApp tc (trs ++ [arg_tr]) -- Notice that we call mkTyConApp to construct the fingerprint from tc and -- the arg fingerprints. Simply combining the current fingerprint with - -- the new one won't give the same answer, but of course we want to + -- the new one won't give the same answer, but of course we want to -- ensure that a TypeRep of the same shape has the same fingerprint! -- See Trac #5962 @@ -290,8 +290,8 @@ instance Show TypeRep where xs | isTupleTyCon tycon -> showTuple xs | otherwise -> showParen (p > 9) $ - showsPrec p tycon . - showChar ' ' . + showsPrec p tycon . + showChar ' ' . showArgs (showChar ' ') tys showsTypeRep :: TypeRep -> ShowS @@ -309,7 +309,7 @@ isTupleTyCon _ = False showArgs :: Show a => ShowS -> [a] -> ShowS showArgs _ [] = id showArgs _ [a] = showsPrec 10 a -showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as +showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as showTuple :: [TypeRep] -> ShowS showTuple args = showChar '(' diff --git a/libraries/base/Data/Version.hs b/libraries/base/Data/Version.hs index 60b85cdf29..fdf01d1af9 100644 --- a/libraries/base/Data/Version.hs +++ b/libraries/base/Data/Version.hs @@ -7,19 +7,19 @@ -- Module : Data.Version -- Copyright : (c) The University of Glasgow 2004 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (local universal quantification in ReadP) -- -- A general library for representation and manipulation of versions. --- +-- -- Versioning schemes are many and varied, so the version -- representation provided by this library is intended to be a -- compromise between complete generality, where almost no common -- functionality could reasonably be provided, and fixing a particular -- versioning scheme, which would probably be too restrictive. --- +-- -- So the approach taken here is to provide a representation which -- subsumes many of the versioning schemes commonly in use, and we -- provide implementations of 'Eq', 'Ord' and conversion to\/from 'String' @@ -46,7 +46,7 @@ import Text.ParserCombinators.ReadP import Text.Read ( read ) {- | -A 'Version' represents the version of a software entity. +A 'Version' represents the version of a software entity. An instance of 'Eq' is provided, which implements exact equality modulo reordering of the tags in the 'versionTags' field. @@ -68,7 +68,7 @@ possible concrete representation is provided (see 'showVersion' and 'parseVersion'), but depending on the application a different concrete representation may be more appropriate. -} -data Version = +data Version = Version { versionBranch :: [Int], -- ^ The numeric branch for this version. This reflects the -- fact that most software versions are tree-structured; there @@ -77,7 +77,7 @@ data Version = -- version 3 is 3.1, the second branch off the trunk after -- version 3 is 3.2, and so on. The tree can be branched -- arbitrarily, just by adding more digits. - -- + -- -- We represent the branch as a list of 'Int', so -- version 3.2.1 becomes [3,2,1]. Lexicographic ordering -- (i.e. the default instance of 'Ord' for @[Int]@) gives @@ -91,7 +91,7 @@ data Version = deriving (Read,Show,Typeable) instance Eq Version where - v1 == v2 = versionBranch v1 == versionBranch v2 + v1 == v2 = versionBranch v1 == versionBranch v2 && sort (versionTags v1) == sort (versionTags v2) -- tags may be in any order @@ -102,12 +102,12 @@ instance Ord Version where -- A concrete representation of 'Version' -- | Provides one possible concrete representation for 'Version'. For --- a version with 'versionBranch' @= [1,2,3]@ and 'versionTags' +-- a version with 'versionBranch' @= [1,2,3]@ and 'versionTags' -- @= [\"tag1\",\"tag2\"]@, the output will be @1.2.3-tag1-tag2@. -- showVersion :: Version -> String showVersion (Version branch tags) - = concat (intersperse "." (map show branch)) ++ + = concat (intersperse "." (map show branch)) ++ concatMap ('-':) tags -- | A parser for versions in the format produced by 'showVersion'. diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs index ddb19a077d..fb44a34c27 100644 --- a/libraries/base/Debug/Trace.hs +++ b/libraries/base/Debug/Trace.hs @@ -8,7 +8,7 @@ -- Module : Debug.Trace -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable @@ -37,7 +37,7 @@ module Debug.Trace ( -- $eventlog_tracing traceEvent, traceEventIO, - + -- * Execution phase markers -- $markers traceMarker, @@ -246,7 +246,7 @@ traceEventIO msg = -- -- Markers let us do this: we can annotate the program to emit a marker at -- an appropriate point during execution and then see that in a profile. --- +-- -- Currently this feature is only supported in GHC by the eventlog tracing -- system, but in future it may also be supported by the heap profiling or -- other profiling tools. These function exists for other Haskell diff --git a/libraries/base/Foreign/C/Error.hs b/libraries/base/Foreign/C/Error.hs index b4dddff782..347e58e759 100644 --- a/libraries/base/Foreign/C/Error.hs +++ b/libraries/base/Foreign/C/Error.hs @@ -6,7 +6,7 @@ -- Module : Foreign.C.Error -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable @@ -26,19 +26,19 @@ module Foreign.C.Error ( -- different values of @errno@. This module defines the common values, -- but due to the open definition of 'Errno' users may add definitions -- which are not predefined. - eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN, - eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED, - eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT, - eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ, - eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK, - eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH, - eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK, - eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS, + eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN, + eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED, + eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT, + eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ, + eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK, + eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH, + eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK, + eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS, eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTSUP, eNOTTY, eNXIO, - eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL, - ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE, - eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN, - eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, + eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL, + ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE, + eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN, + eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV, -- ** 'Errno' functions @@ -66,14 +66,14 @@ module Foreign.C.Error ( throwErrnoIfMinus1, throwErrnoIfMinus1_, throwErrnoIfMinus1Retry, - throwErrnoIfMinus1Retry_, + throwErrnoIfMinus1Retry_, throwErrnoIfNull, throwErrnoIfNullRetry, - throwErrnoIfRetryMayBlock, + throwErrnoIfRetryMayBlock, throwErrnoIfRetryMayBlock_, throwErrnoIfMinus1RetryMayBlock, - throwErrnoIfMinus1RetryMayBlock_, + throwErrnoIfMinus1RetryMayBlock_, throwErrnoIfNullRetryMayBlock, throwErrnoPath, @@ -112,29 +112,29 @@ import GHC.Base newtype Errno = Errno CInt instance Eq Errno where - errno1@(Errno no1) == errno2@(Errno no2) + errno1@(Errno no1) == errno2@(Errno no2) | isValidErrno errno1 && isValidErrno errno2 = no1 == no2 | otherwise = False -- common "errno" symbols -- -eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN, - eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED, - eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT, - eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ, - eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK, - eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH, - eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK, - eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS, +eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN, + eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED, + eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT, + eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ, + eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK, + eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH, + eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK, + eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS, eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTSUP, eNOTTY, eNXIO, - eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL, - ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE, - eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN, - eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, + eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL, + ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE, + eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN, + eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV :: Errno -- -- the cCONST_XXX identifiers are cpp symbols whose value is computed by --- configure +-- configure -- eOK = Errno 0 e2BIG = Errno (CONST_E2BIG) @@ -294,7 +294,7 @@ throwErrnoIf :: (a -> Bool) -- ^ predicate to apply to the result value -> String -- ^ textual description of the location -> IO a -- ^ the 'IO' operation to be executed -> IO a -throwErrnoIf pred loc f = +throwErrnoIf pred loc f = do res <- f if pred res then throwErrno loc else return res @@ -310,7 +310,7 @@ throwErrnoIf_ pred loc f = void $ throwErrnoIf pred loc f -- interrupted POSIX system calls. -- throwErrnoIfRetry :: (a -> Bool) -> String -> IO a -> IO a -throwErrnoIfRetry pred loc f = +throwErrnoIfRetry pred loc f = do res <- f if pred res @@ -321,7 +321,7 @@ throwErrnoIfRetry pred loc f = else throwErrno loc else return res --- | as 'throwErrnoIfRetry', but additionally if the operation +-- | as 'throwErrnoIfRetry', but additionally if the operation -- yields the error code 'eAGAIN' or 'eWOULDBLOCK', an alternative -- action is executed before retrying. -- @@ -333,7 +333,7 @@ throwErrnoIfRetryMayBlock -> IO b -- ^ action to execute before retrying if -- an immediate retry would block -> IO a -throwErrnoIfRetryMayBlock pred loc f on_block = +throwErrnoIfRetryMayBlock pred loc f on_block = do res <- f if pred res @@ -355,7 +355,7 @@ throwErrnoIfRetry_ pred loc f = void $ throwErrnoIfRetry pred loc f -- | as 'throwErrnoIfRetryMayBlock', but discards the result. -- throwErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO () -throwErrnoIfRetryMayBlock_ pred loc f on_block +throwErrnoIfRetryMayBlock_ pred loc f on_block = void $ throwErrnoIfRetryMayBlock pred loc f on_block -- | Throw an 'IOError' corresponding to the current value of 'getErrno' diff --git a/libraries/base/Foreign/C/String.hs b/libraries/base/Foreign/C/String.hs index e72b620af5..a162460b25 100644 --- a/libraries/base/Foreign/C/String.hs +++ b/libraries/base/Foreign/C/String.hs @@ -6,7 +6,7 @@ -- Module : Foreign.C.String -- Copyright : (c) The FFI task force 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable @@ -238,7 +238,7 @@ peekCAString cp = do -- | Marshal a C string with explicit length into a Haskell string. -- peekCAStringLen :: CStringLen -> IO String -peekCAStringLen (cp, len) +peekCAStringLen (cp, len) | len <= 0 = return "" -- being (too?) nice. | otherwise = loop [] (len-1) where diff --git a/libraries/base/Foreign/Marshal/Pool.hs b/libraries/base/Foreign/Marshal/Pool.hs index 78d069ad13..5d92f6fdd9 100644 --- a/libraries/base/Foreign/Marshal/Pool.hs +++ b/libraries/base/Foreign/Marshal/Pool.hs @@ -6,7 +6,7 @@ -- Module : Foreign.Marshal.Pool -- Copyright : (c) Sven Panne 2002-2004 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : sven.panne@aedion.de -- Stability : provisional -- Portability : portable diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs index d8eb3e690f..e6e35f3b92 100644 --- a/libraries/base/GHC/Base.lhs +++ b/libraries/base/GHC/Base.lhs @@ -144,7 +144,7 @@ Likewise we implicitly need Integer when deriving things like Eq instances. The danger is that if the build system doesn't know about the dependency -on Integer, it'll compile some base module before GHC.Integer.Type, +on Integer, it'll compile some base module before GHC.Integer.Type, resulting in: Failed to load interface for ‘GHC.Integer.Type’ There are files missing in the ‘integer-gmp’ package, @@ -563,11 +563,11 @@ liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; {-# SPECIALISE liftM5 :: (a1->a2->a3->a4->a5->r) -> Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe a4 -> Maybe a5 -> Maybe r #-} {- | In many situations, the 'liftM' operations can be replaced by uses of -'ap', which promotes function application. +'ap', which promotes function application. > return f `ap` x1 `ap` ... `ap` xn -is equivalent to +is equivalent to > liftMn f x1 x2 ... xn diff --git a/libraries/base/GHC/Event/EPoll.hsc b/libraries/base/GHC/Event/EPoll.hsc index 748a1cee4b..b8861c41f1 100644 --- a/libraries/base/GHC/Event/EPoll.hsc +++ b/libraries/base/GHC/Event/EPoll.hsc @@ -167,7 +167,7 @@ newtype EventType = EventType { , epollOut = EPOLLOUT , epollErr = EPOLLERR , epollHup = EPOLLHUP - , epollOneShot = EPOLLONESHOT + , epollOneShot = EPOLLONESHOT } -- | Create a new epoll context, returning a file descriptor associated with the context. diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index aa0fc93484..6754edc039 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -126,9 +126,9 @@ traceEvent = Debug.Trace.traceEventIO {- ********************************************************************** -* * +* * * SpecConstr annotation * -* * +* * ********************************************************************** -} -- Annotating a type with NoSpecConstr will make SpecConstr @@ -143,9 +143,9 @@ data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr {- ********************************************************************** -* * +* * * The IsList class * -* * +* * ********************************************************************** -} -- | The 'IsList' class and its methods are intended to be used in diff --git a/libraries/base/GHC/Foreign.hs b/libraries/base/GHC/Foreign.hs index c4bab8c3b3..e8553d8061 100644 --- a/libraries/base/GHC/Foreign.hs +++ b/libraries/base/GHC/Foreign.hs @@ -6,7 +6,7 @@ -- Module : GHC.Foreign -- Copyright : (c) The University of Glasgow, 2008-2011 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable @@ -17,22 +17,22 @@ module GHC.Foreign ( -- * C strings with a configurable encoding - + -- conversion of C strings into Haskell strings -- peekCString, peekCStringLen, - + -- conversion of Haskell strings into C strings -- newCString, newCStringLen, - + -- conversion of Haskell strings into C strings using temporary storage -- withCString, withCStringLen, - + charIsRepresentable, ) where diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index 7943ef44d6..448eaee76f 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -12,13 +12,13 @@ -- Module : GHC.ForeignPtr -- Copyright : (c) The University of Glasgow, 1992-2003 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- GHC's implementation of the 'ForeignPtr' data type. --- +-- ----------------------------------------------------------------------------- module GHC.ForeignPtr @@ -105,7 +105,7 @@ instance Show (ForeignPtr a) where -- |A finalizer is represented as a pointer to a foreign function that, at -- finalisation time, gets as an argument a plain pointer variant of the -- foreign pointer that the finalizer is associated with. --- +-- -- Note that the foreign function /must/ use the @ccall@ calling convention. -- type FinalizerPtr a = FunPtr (Ptr a -> IO ()) @@ -140,7 +140,7 @@ mallocForeignPtr :: Storable a => IO (ForeignPtr a) -- 'mallocForeignPtr' is equivalent to -- -- > do { p <- malloc; newForeignPtr finalizerFree p } --- +-- -- although it may be implemented differently internally: you may not -- assume that the memory returned by 'mallocForeignPtr' has been -- allocated with 'Foreign.Marshal.Alloc.malloc'. @@ -151,7 +151,7 @@ mallocForeignPtr :: Storable a => IO (ForeignPtr a) -- free the memory. Use of 'mallocForeignPtr' and associated -- functions is strongly recommended in preference to 'newForeignPtr' -- with a finalizer. --- +-- mallocForeignPtr = doMalloc undefined where doMalloc :: Storable b => b -> IO (ForeignPtr b) doMalloc a @@ -171,7 +171,7 @@ mallocForeignPtr = doMalloc undefined mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) mallocForeignPtrBytes size | size < 0 = error "mallocForeignPtrBytes: size must be >= 0" -mallocForeignPtrBytes (I# size) = do +mallocForeignPtrBytes (I# size) = do r <- newIORef NoFinalizers IO $ \s -> case newPinnedByteArray# size s of { (# s', mbarr# #) -> @@ -205,7 +205,7 @@ mallocForeignPtrAlignedBytes (I# size) (I# align) = do -- only inside Haskell (such as those created for packed strings). -- Attempts to add a finalizer to a ForeignPtr created this way, or to -- finalize such a pointer, will throw an exception. --- +-- mallocPlainForeignPtr :: Storable a => IO (ForeignPtr a) mallocPlainForeignPtr = doMalloc undefined where doMalloc :: Storable b => b -> IO (ForeignPtr b) @@ -284,7 +284,7 @@ addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO () -- are finalized objects, so a finalizer should not refer to a 'Handle' -- (including @stdout@, @stdin@ or @stderr@). -- -addForeignPtrConcFinalizer (ForeignPtr _ c) finalizer = +addForeignPtrConcFinalizer (ForeignPtr _ c) finalizer = addForeignPtrConcFinalizer_ c finalizer addForeignPtrConcFinalizer_ :: ForeignPtrContents -> IO () -> IO () @@ -299,7 +299,7 @@ addForeignPtrConcFinalizer_ (PlainForeignPtr r) finalizer = do addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do noFinalizers <- insertHaskellFinalizer r finalizer if noFinalizers - then IO $ \s -> + then IO $ \s -> case mkWeak# fo () (do foreignPtrFinalizer r; touch f) s of (# s1, _ #) -> (# s1, () #) else return () @@ -378,7 +378,7 @@ touchForeignPtr :: ForeignPtr a -> IO () -- actions. In particular 'Foreign.ForeignPtr.withForeignPtr' -- does a 'touchForeignPtr' after it -- executes the user action. --- +-- -- Note that this function should not be used to express dependencies -- between finalizers on 'ForeignPtr's. For example, if the finalizer -- for a 'ForeignPtr' @F1@ calls 'touchForeignPtr' on a second diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 594b631cfc..8835df45e8 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -13,15 +13,15 @@ -- Module : GHC.Generics -- Copyright : (c) Universiteit Utrecht 2010-2011, University of Oxford 2012-2013 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable -- -- /Since: 4.6.0.0/ --- +-- -- If you're using @GHC.Generics@, you should consider using the --- <http://hackage.haskell.org/package/generic-deriving> package, which +-- <http://hackage.haskell.org/package/generic-deriving> package, which -- contains many useful generic functions. module GHC.Generics ( @@ -263,7 +263,7 @@ module GHC.Generics ( -- data 'V1' p -- lifted version of Empty -- data 'U1' p = 'U1' -- lifted version of () -- data (':+:') f g p = 'L1' (f p) | 'R1' (g p) -- lifted version of 'Either' --- data (':*:') f g p = (f p) ':*:' (g p) -- lifted version of (,) +-- data (':*:') f g p = (f p) ':*:' (g p) -- lifted version of (,) -- newtype 'K1' i c p = 'K1' { 'unK1' :: c } -- a container for a c -- newtype 'M1' i t f p = 'M1' { 'unM1' :: f p } -- a wrapper -- @ diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs index 1d86b8d12a..66e4bfb303 100644 --- a/libraries/base/GHC/IO.hs +++ b/libraries/base/GHC/IO.hs @@ -13,7 +13,7 @@ -- Module : GHC.IO -- Copyright : (c) The University of Glasgow 1994-2002 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) @@ -34,7 +34,7 @@ module GHC.IO ( FilePath, catchException, catchAny, throwIO, - mask, mask_, uninterruptibleMask, uninterruptibleMask_, + mask, mask_, uninterruptibleMask, uninterruptibleMask_, MaskingState(..), getMaskingState, unsafeUnmask, onException, bracket, finally, evaluate @@ -61,7 +61,7 @@ system. The following list may or may not be exhaustive: Compiler - types of various primitives in PrimOp.lhs RTS - forceIO (StgMiscClosures.hc) - - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast + - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast (Exceptions.hc) - raiseAsync (Schedule.c) @@ -129,8 +129,8 @@ different precautions: two side effects that were meant to be separate. A good example is using multiple global variables (like @test@ in the example below). - * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the - call to 'unsafePerformIO' cannot float outside a lambda. For example, + * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the + call to 'unsafePerformIO' cannot float outside a lambda. For example, if you say: @ f x = unsafePerformIO (newIORef []) @@ -147,7 +147,7 @@ It is less well known that > test :: IORef [a] > test = unsafePerformIO $ newIORef [] -> +> > main = do > writeIORef test [42] > bang <- readIORef test @@ -163,7 +163,7 @@ help of 'unsafePerformIO'. So be careful! unsafePerformIO :: IO a -> a unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m) -{-| +{-| This version of 'unsafePerformIO' is more efficient because it omits the check that the IO is only being performed by a single thread. Hence, when you use 'unsafeDupablePerformIO', @@ -245,7 +245,7 @@ unsafeDupableInterleaveIO (IO m) in (# s, r #)) -{-| +{-| Ensures that the suspensions under evaluation by the current thread are unique; that is, the current thread is not evaluating anything that is also under evaluation by another thread that has also executed @@ -348,7 +348,7 @@ blockUninterruptible (IO io) = IO $ maskUninterruptible# io -- exception is received. data MaskingState = Unmasked -- ^ asynchronous exceptions are unmasked (the normal state) - | MaskedInterruptible + | MaskedInterruptible -- ^ the state during 'mask': asynchronous exceptions are masked, but blocking operations may still be interrupted | MaskedUninterruptible -- ^ the state during 'uninterruptibleMask': asynchronous exceptions are masked, and blocking operations may not be interrupted @@ -356,7 +356,7 @@ data MaskingState -- | Returns the 'MaskingState' for the current thread. getMaskingState :: IO MaskingState -getMaskingState = IO $ \s -> +getMaskingState = IO $ \s -> case getMaskingState# s of (# s', i #) -> (# s', case i of 0# -> Unmasked @@ -408,7 +408,7 @@ onException io what = io `catchException` \e -> do _ <- what -- to establish an exception handler in the forked thread before any -- asynchronous exceptions are received. To create a a new thread in -- an unmasked state use 'Control.Concurrent.forkIOUnmasked'. --- +-- mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b -- | Like 'mask', but does not pass a @restore@ action to the argument. diff --git a/libraries/base/GHC/IO/BufferedIO.hs b/libraries/base/GHC/IO/BufferedIO.hs index cc98be76d1..4c81d9a4ec 100644 --- a/libraries/base/GHC/IO/BufferedIO.hs +++ b/libraries/base/GHC/IO/BufferedIO.hs @@ -7,7 +7,7 @@ -- Module : GHC.IO.BufferedIO -- Copyright : (c) The University of Glasgow 2008 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) @@ -60,7 +60,7 @@ class BufferedIO dev where -- There is no corresponding operation for read buffers, because before -- reading the client will always call 'fillReadBuffer'. emptyWriteBuffer :: dev -> Buffer Word8 -> IO (Buffer Word8) - emptyWriteBuffer _dev buf + emptyWriteBuffer _dev buf = return buf{ bufL=0, bufR=0, bufState = WriteBuffer } -- | Flush all the data from the supplied write buffer out to the device. diff --git a/libraries/base/GHC/IO/Device.hs b/libraries/base/GHC/IO/Device.hs index b6c973b7e0..ddeb861eca 100644 --- a/libraries/base/GHC/IO/Device.hs +++ b/libraries/base/GHC/IO/Device.hs @@ -6,7 +6,7 @@ -- Module : GHC.IO.Device -- Copyright : (c) The University of Glasgow, 1994-2008 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable @@ -20,7 +20,7 @@ module GHC.IO.Device ( IODevice(..), IODeviceType(..), SeekMode(..) - ) where + ) where import GHC.Base import GHC.Word @@ -62,7 +62,7 @@ class IODevice a where -- to read (if @write@ is 'False') or space to write new data (if -- @write@ is 'True'). @msecs@ specifies how long to wait, in -- milliseconds. - -- + -- ready :: a -> Bool -> Int -> IO Bool -- | closes the device. Further operations on the device should @@ -90,7 +90,7 @@ class IODevice a where getSize _ = ioe_unsupportedOperation -- | change the size of the data. - setSize :: a -> Integer -> IO () + setSize :: a -> Integer -> IO () setSize _ _ = ioe_unsupportedOperation -- | for terminal devices, changes whether characters are echoed on diff --git a/libraries/base/GHC/IO/Encoding.hs b/libraries/base/GHC/IO/Encoding.hs index e8bbdfae21..68bc0cfa4e 100644 --- a/libraries/base/GHC/IO/Encoding.hs +++ b/libraries/base/GHC/IO/Encoding.hs @@ -7,7 +7,7 @@ -- Module : GHC.IO.Encoding -- Copyright : (c) The University of Glasgow, 2008-2009 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable @@ -21,7 +21,7 @@ module GHC.IO.Encoding ( latin1, latin1_encode, latin1_decode, utf8, utf8_bom, utf16, utf16le, utf16be, - utf32, utf32le, utf32be, + utf32, utf32le, utf32be, initLocaleEncoding, getLocaleEncoding, getFileSystemEncoding, getForeignEncoding, setLocaleEncoding, setFileSystemEncoding, setForeignEncoding, @@ -173,7 +173,7 @@ initForeignEncoding = CodePage.mkLocaleEncoding IgnoreCodingFailure char8 :: TextEncoding char8 = Latin1.latin1 --- | Look up the named Unicode encoding. May fail with +-- | Look up the named Unicode encoding. May fail with -- -- * 'isDoesNotExistError' if the encoding is unknown -- @@ -188,7 +188,7 @@ char8 = Latin1.latin1 -- There is additional notation (borrowed from GNU iconv) for specifying -- how illegal characters are handled: -- --- * a suffix of @\/\/IGNORE@, e.g. @UTF-8\/\/IGNORE@, will cause +-- * a suffix of @\/\/IGNORE@, e.g. @UTF-8\/\/IGNORE@, will cause -- all illegal sequences on input to be ignored, and on output -- will drop all code points that have no representation in the -- target encoding. @@ -258,6 +258,6 @@ latin1_decode :: Buffer Word8 -> CharBuffer -> IO (Buffer Word8, CharBuffer) latin1_decode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_decode input output --latin1_decode = unsafePerformIO $ do mkTextDecoder Iconv.latin1 >>= return.encode -unknownEncodingErr :: String -> IO a +unknownEncodingErr :: String -> IO a unknownEncodingErr e = ioException (IOError Nothing NoSuchThing "mkTextEncoding" ("unknown encoding:" ++ e) Nothing Nothing) diff --git a/libraries/base/GHC/IO/Encoding/CodePage/API.hs b/libraries/base/GHC/IO/Encoding/CodePage/API.hs index 8b6472b3ec..fc915ecf56 100644 --- a/libraries/base/GHC/IO/Encoding/CodePage/API.hs +++ b/libraries/base/GHC/IO/Encoding/CodePage/API.hs @@ -70,13 +70,13 @@ instance Storable CPINFO where ptr <- return $ castPtr $ advancePtr ptr 1 b <- peekArray mAX_DEFAULTCHAR ptr c <- peekArray mAX_LEADBYTES (advancePtr ptr mAX_DEFAULTCHAR) - return $ CPINFO a b c + return $ CPINFO a b c poke ptr val = do ptr <- return $ castPtr ptr poke ptr (maxCharSize val) ptr <- return $ castPtr $ advancePtr ptr 1 pokeArray' "CPINFO.defaultChar" mAX_DEFAULTCHAR ptr (defaultChar val) - pokeArray' "CPINFO.leadByte" mAX_LEADBYTES (advancePtr ptr mAX_DEFAULTCHAR) (leadByte val) + pokeArray' "CPINFO.leadByte" mAX_LEADBYTES (advancePtr ptr mAX_DEFAULTCHAR) (leadByte val) pokeArray' :: Storable a => String -> Int -> Ptr a -> [a] -> IO () pokeArray' msg sz ptr xs | length xs == sz = pokeArray ptr xs @@ -118,10 +118,10 @@ foreign import WINDOWS_CCONV unsafe "windows.h IsDBCSLeadByteEx" -- -- This is useful for supporting DBCS text encoding on the console without having to statically link -- in huge code tables into all of our executables, or just as a fallback mechanism if a new code page --- is introduced that we don't know how to deal with ourselves yet. +-- is introduced that we don't know how to deal with ourselves yet. mkCodePageEncoding :: CodingFailureMode -> Word32 -> TextEncoding mkCodePageEncoding cfm cp - = TextEncoding { + = TextEncoding { textEncodingName = "CP" ++ show cp, mkTextDecoder = newCP (recoverDecode cfm) cpDecode cp, mkTextEncoder = newCP (recoverEncode cfm) cpEncode cp @@ -134,7 +134,7 @@ newCP :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to)) newCP rec fn cp = do -- Fail early if the code page doesn't exist, to match the behaviour of the IConv TextEncoding max_char_size <- alloca $ \cpinfo_ptr -> do - success <- c_GetCPInfo cp cpinfo_ptr + success <- c_GetCPInfo cp cpinfo_ptr when (not success) $ throwGetLastError ("GetCPInfo " ++ show cp) fmap (fromIntegral . maxCharSize) $ peek cpinfo_ptr @@ -268,7 +268,7 @@ cpEncode cp _max_char_size = \ibuf obuf -> do let sz = (bufferElems ibuf * 2) -- UTF-32 always uses 4 bytes. UTF-16 uses at most 4 bytes. `min` (bufferAvailable obuf * 2) -- In the best case, each pair of UTF-16 points fits into only 1 byte mbuf <- newBuffer (2 * sz) sz WriteBuffer - + -- Convert as much UTF-32 as possible to UTF-16. NB: this can't fail due to output underflow -- since we sized the output buffer correctly. However, it could fail due to an illegal character -- in the input if it encounters a lone surrogate. In this case, our recovery will be applied as normal. @@ -295,7 +295,7 @@ cpEncode cp _max_char_size = \ibuf obuf -> do -- UTF-32 characters required to get the consumed count of UTF-16 characters: -- -- When dealing with data from the BMP (the common case), consuming N UTF-16 characters will be the same as consuming N - -- UTF-32 characters. We start our search there so that most binary searches will terminate in a single iteration. + -- UTF-32 characters. We start our search there so that most binary searches will terminate in a single iteration. -- Furthermore, the absolute minimum number of UTF-32 characters this can correspond to is 1/2 the UTF-16 byte count -- (this will be realised when the input data is entirely not in the BMP). utf32_count <- bSearch "cpEncode" utf16_native_encode ibuf mbuf target_utf16_count (target_utf16_count `div` 2) target_utf16_count target_utf16_count @@ -346,7 +346,7 @@ bSearch msg code ibuf mbuf target_to_elems = go -- have just been unlucky enough to set md so that ibuf straddles a byte boundary. -- In this case we have to be really careful, because we don't want to report that -- "md" elements is the right number when in actual fact we could have had md-1 input - -- elements and still produced the same number of bufferElems in mbuf. + -- elements and still produced the same number of bufferElems in mbuf. -- -- In fact, we have to worry about this possibility even if we get InputUnderflow -- since that will report InputUnderflow rather than InvalidSequence if the buffer @@ -358,7 +358,7 @@ bSearch msg code ibuf mbuf target_to_elems = go -- Luckily if we have InvalidSequence/OutputUnderflow and we do not appear to have reached -- the target, what we should do is the same as normal because the fraction of ibuf that our -- first "code" coded succesfully must be invalid-sequence-free, and ibuf will always - -- have been decoded as far as the first invalid sequence in it. + -- have been decoded as far as the first invalid sequence in it. case bufferElems mbuf `compare` target_to_elems of -- Coding n "from" chars from the input yields exactly as many "to" chars -- as were consumed by the recode. All is peachy: diff --git a/libraries/base/GHC/IO/Encoding/Failure.hs b/libraries/base/GHC/IO/Encoding/Failure.hs index 6e06213ae2..df5a99235a 100644 --- a/libraries/base/GHC/IO/Encoding/Failure.hs +++ b/libraries/base/GHC/IO/Encoding/Failure.hs @@ -6,7 +6,7 @@ -- Module : GHC.IO.Encoding.Failure -- Copyright : (c) The University of Glasgow, 2008-2011 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable @@ -180,7 +180,7 @@ recoverEncode cfm input@Buffer{ bufRaw=iraw, bufL=ir, bufR=_ } -- reperesenting all ASCII characters. _ir' <- writeCharBuf iraw ir '?' return (input, output) - + -- This implementation does not work because e.g. UTF-16 -- requires 2 bytes to encode a simple ASCII value --writeWord8Buf oraw ow unrepresentableByte diff --git a/libraries/base/GHC/IO/Encoding/UTF16.hs b/libraries/base/GHC/IO/Encoding/UTF16.hs index c6dc7c0a76..4dd393b418 100644 --- a/libraries/base/GHC/IO/Encoding/UTF16.hs +++ b/libraries/base/GHC/IO/Encoding/UTF16.hs @@ -11,7 +11,7 @@ -- Module : GHC.IO.Encoding.UTF16 -- Copyright : (c) The University of Glasgow, 2009 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable @@ -198,10 +198,10 @@ utf16le_EF cfm = utf16be_decode :: DecodeBuffer -utf16be_decode +utf16be_decode input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } - = let + = let loop !ir !ow | ow >= os = done OutputUnderflow ir ow | ir >= iw = done InputUnderflow ir ow @@ -232,10 +232,10 @@ utf16be_decode loop ir0 ow0 utf16le_decode :: DecodeBuffer -utf16le_decode +utf16le_decode input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } - = let + = let loop !ir !ow | ow >= os = done OutputUnderflow ir ow | ir >= iw = done InputUnderflow ir ow @@ -269,7 +269,7 @@ utf16be_encode :: EncodeBuffer utf16be_encode input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } - = let + = let done why !ir !ow = return (why, if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir }, @@ -286,7 +286,7 @@ utf16be_encode loop ir' (ow+2) | otherwise -> do if os - ow < 4 then done OutputUnderflow ir ow else do - let + let n1 = x - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) c2 = fromIntegral (n1 `shiftR` 10) @@ -323,7 +323,7 @@ utf16le_encode loop ir' (ow+2) | otherwise -> if os - ow < 4 then done OutputUnderflow ir ow else do - let + let n1 = x - 0x10000 c1 = fromIntegral (n1 `shiftR` 18 + 0xD8) c2 = fromIntegral (n1 `shiftR` 10) diff --git a/libraries/base/GHC/IO/Encoding/UTF32.hs b/libraries/base/GHC/IO/Encoding/UTF32.hs index 8d996b14b9..c874224682 100644 --- a/libraries/base/GHC/IO/Encoding/UTF32.hs +++ b/libraries/base/GHC/IO/Encoding/UTF32.hs @@ -11,7 +11,7 @@ -- Module : GHC.IO.Encoding.UTF32 -- Copyright : (c) The University of Glasgow, 2009 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable @@ -202,10 +202,10 @@ utf32le_EF cfm = utf32be_decode :: DecodeBuffer -utf32be_decode +utf32be_decode input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } - = let + = let loop !ir !ow | ow >= os = done OutputUnderflow ir ow | iw - ir < 4 = done InputUnderflow ir ow @@ -230,10 +230,10 @@ utf32be_decode loop ir0 ow0 utf32le_decode :: DecodeBuffer -utf32le_decode +utf32le_decode input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } - = let + = let loop !ir !ow | ow >= os = done OutputUnderflow ir ow | iw - ir < 4 = done InputUnderflow ir ow @@ -261,7 +261,7 @@ utf32be_encode :: EncodeBuffer utf32be_encode input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ } output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os } - = let + = let done why !ir !ow = return (why, if ir == iw then input{ bufL=0, bufR=0 } else input{ bufL=ir }, @@ -320,8 +320,8 @@ chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) = {-# INLINE chr4 #-} ord4 :: Char -> (Word8,Word8,Word8,Word8) -ord4 c = (fromIntegral (x `shiftR` 24), - fromIntegral (x `shiftR` 16), +ord4 c = (fromIntegral (x `shiftR` 24), + fromIntegral (x `shiftR` 16), fromIntegral (x `shiftR` 8), fromIntegral x) where diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index fcc314e402..610c9ea949 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -159,7 +159,7 @@ openFile openFile filepath iomode non_blocking = withFilePath filepath $ \ f -> - let + let oflags1 = case iomode of ReadMode -> read_flags WriteMode -> write_flags @@ -188,7 +188,7 @@ openFile filepath iomode non_blocking = else c_safe_open f oflags 0o666) (fD,fd_type) <- mkFD fd iomode Nothing{-no stat-} - False{-not a socket-} + False{-not a socket-} non_blocking `catchAny` \e -> do _ <- c_close fd throwIO e @@ -205,7 +205,7 @@ std_flags, output_flags, read_flags, write_flags, rw_flags, append_flags, nonblock_flags :: CInt std_flags = o_NOCTTY output_flags = std_flags .|. o_CREAT -read_flags = std_flags .|. o_RDONLY +read_flags = std_flags .|. o_RDONLY write_flags = output_flags .|. o_WRONLY rw_flags = output_flags .|. o_RDWR append_flags = write_flags .|. o_APPEND @@ -232,7 +232,7 @@ mkFD fd iomode mb_stat is_socket is_nonblock = do let _ = (is_socket, is_nonblock) -- warning suppression - (fd_type,dev,ino) <- + (fd_type,dev,ino) <- case mb_stat of Nothing -> fdStat fd Just stat -> return stat @@ -242,7 +242,7 @@ mkFD fd iomode mb_stat is_socket is_nonblock = do _ -> True case fd_type of - Directory -> + Directory -> ioException (IOError Nothing InappropriateType "openFile" "is a directory" Nothing Nothing) @@ -362,7 +362,7 @@ tell fd = getSize :: FD -> IO Integer getSize fd = fdFileSize (fdFD fd) -setSize :: FD -> Integer -> IO () +setSize :: FD -> Integer -> IO () setSize fd size = do throwErrnoIf_ (/=0) "GHC.IO.FD.setSize" $ c_ftruncate (fdFD fd) (fromIntegral size) @@ -383,7 +383,7 @@ dup2 fd fdto = do return fd{ fdFD = fdFD fdto } -- original FD, with the new fdFD setNonBlockingMode :: FD -> Bool -> IO FD -setNonBlockingMode fd set = do +setNonBlockingMode fd set = do setNonBlockingFD (fdFD fd) set #if defined(mingw32_HOST_OS) return fd @@ -418,7 +418,7 @@ isTerminal fd = c_isatty (fdFD fd) >>= return.toBool #endif -setEcho :: FD -> Bool -> IO () +setEcho :: FD -> Bool -> IO () setEcho fd on = System.Posix.Internals.setEcho (fdFD fd) on getEcho :: FD -> IO Bool @@ -437,7 +437,7 @@ fdRead fd ptr bytes fdReadNonBlocking :: FD -> Ptr Word8 -> Int -> IO (Maybe Int) fdReadNonBlocking fd ptr bytes = do - r <- readRawBufferPtrNoBlock "GHC.IO.FD.fdReadNonBlocking" fd ptr + r <- readRawBufferPtrNoBlock "GHC.IO.FD.fdReadNonBlocking" fd ptr 0 (fromIntegral bytes) case fromIntegral r of (-1) -> return (Nothing) @@ -448,7 +448,7 @@ fdWrite :: FD -> Ptr Word8 -> Int -> IO () fdWrite fd ptr bytes = do res <- writeRawBufferPtr "GHC.IO.FD.fdWrite" fd ptr 0 (fromIntegral bytes) let res' = fromIntegral res - if res' < bytes + if res' < bytes then fdWrite fd (ptr `plusPtr` res') (bytes - res') else return () @@ -481,7 +481,7 @@ completely simulate a non-blocking read without O_NONBLOCK: several cases are wrong here. The cases that are wrong: * reading/writing to a blocking FD in non-threaded mode. - In threaded mode, we just make a safe call to read(). + In threaded mode, we just make a safe call to read(). In non-threaded mode we call select() before attempting to read, but that leaves a small race window where the data can be read from the file descriptor before we issue our blocking read(). @@ -501,9 +501,9 @@ indicates that there's no data, we call threadWaitRead. readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int readRawBufferPtr loc !fd buf off len | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block - | otherwise = do r <- throwErrnoIfMinus1 loc + | otherwise = do r <- throwErrnoIfMinus1 loc (unsafe_fdReady (fdFD fd) 0 0 0) - if r /= 0 + if r /= 0 then read else do threadWaitRead (fromIntegral (fdFD fd)); read where @@ -535,7 +535,7 @@ writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt writeRawBufferPtr loc !fd buf off len | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block | otherwise = do r <- unsafe_fdReady (fdFD fd) 1 0 0 - if r /= 0 + if r /= 0 then write else do threadWaitWrite (fromIntegral (fdFD fd)); write where @@ -589,10 +589,10 @@ writeRawBufferPtrNoBlock = writeRawBufferPtr asyncReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt asyncReadRawBufferPtr loc !fd buf off len = do - (l, rc) <- asyncRead (fromIntegral (fdFD fd)) (fdIsSocket_ fd) + (l, rc) <- asyncRead (fromIntegral (fdFD fd)) (fdIsSocket_ fd) (fromIntegral len) (buf `plusPtr` off) if l == (-1) - then + then ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) @@ -601,7 +601,7 @@ asyncWriteRawBufferPtr loc !fd buf off len = do (l, rc) <- asyncWrite (fromIntegral (fdFD fd)) (fdIsSocket_ fd) (fromIntegral len) (buf `plusPtr` off) if l == (-1) - then + then ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) @@ -615,7 +615,7 @@ blockingReadRawBufferPtr loc fd buf off len else c_safe_read (fdFD fd) (buf `plusPtr` off) len blockingWriteRawBufferPtr :: String -> FD -> Ptr Word8-> Int -> CSize -> IO CInt -blockingWriteRawBufferPtr loc fd buf off len +blockingWriteRawBufferPtr loc fd buf off len = fmap fromIntegral $ throwErrnoIfMinus1Retry loc $ if fdIsSocket fd then c_safe_send (fdFD fd) (buf `plusPtr` off) len 0 @@ -648,7 +648,7 @@ foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool #ifndef mingw32_HOST_OS throwErrnoIfMinus1RetryOnBlock :: String -> IO CSsize -> IO CSsize -> IO CSsize -throwErrnoIfMinus1RetryOnBlock loc f on_block = +throwErrnoIfMinus1RetryOnBlock loc f on_block = do res <- f if (res :: CSsize) == -1 diff --git a/libraries/base/GHC/IO/Handle.hs b/libraries/base/GHC/IO/Handle.hs index 5a8d570642..23272cedd8 100644 --- a/libraries/base/GHC/IO/Handle.hs +++ b/libraries/base/GHC/IO/Handle.hs @@ -11,7 +11,7 @@ -- Module : GHC.IO.Handle -- Copyright : (c) The University of Glasgow, 1994-2009 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable @@ -23,21 +23,21 @@ module GHC.IO.Handle ( Handle, BufferMode(..), - + mkFileHandle, mkDuplexHandle, - + hFileSize, hSetFileSize, hIsEOF, hLookAhead, hSetBuffering, hSetBinaryMode, hSetEncoding, hGetEncoding, hFlush, hFlushAll, hDuplicate, hDuplicateTo, - + hClose, hClose_help, - + HandlePosition, HandlePosn(..), hGetPosn, hSetPosn, SeekMode(..), hSeek, hTell, - + hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable, hSetEcho, hGetEcho, hIsTerminalDevice, - + hSetNewlineMode, Newline(..), NewlineMode(..), nativeNewline, noNewlineTranslation, universalNewlineMode, nativeNewlineMode, @@ -75,14 +75,14 @@ import Data.Typeable -- | Computation 'hClose' @hdl@ makes handle @hdl@ closed. Before the -- computation finishes, if @hdl@ is writable its buffer is flushed as -- for 'hFlush'. --- Performing 'hClose' on a handle that has already been closed has no effect; +-- Performing 'hClose' on a handle that has already been closed has no effect; -- doing so is not an error. All other operations on a closed handle will fail. -- If 'hClose' fails for any reason, any further operations (apart from -- 'hClose') on the handle will still fail as if @hdl@ had been successfully -- closed. hClose :: Handle -> IO () -hClose h@(FileHandle _ m) = do +hClose h@(FileHandle _ m) = do mb_exc <- hClose' h m hClose_maybethrow mb_exc h hClose h@(DuplexHandle _ r w) = do @@ -94,7 +94,7 @@ hClose_maybethrow Nothing h = return () hClose_maybethrow (Just e) h = hClose_rethrow e h hClose_rethrow :: SomeException -> Handle -> IO () -hClose_rethrow e h = +hClose_rethrow e h = case fromException e of Just ioe -> ioError (augmentIOError ioe "hClose" h) Nothing -> throwIO e @@ -111,7 +111,7 @@ hClose' h m = withHandle' "hClose" h m $ hClose_help hFileSize :: Handle -> IO Integer hFileSize handle = withHandle_ "hFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do - case haType handle_ of + case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle _ -> do flushWriteBuffer handle_ @@ -127,7 +127,7 @@ hFileSize handle = hSetFileSize :: Handle -> Integer -> IO () hSetFileSize handle size = withHandle_ "hSetFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do - case haType handle_ of + case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle _ -> do flushWriteBuffer handle_ @@ -256,8 +256,8 @@ hSetEncoding hdl encoding = do openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do bbuf <- readIORef haByteBuffer ref <- newIORef (error "last_decode") - return (Handle__{ haLastDecode = ref, - haDecoder = mb_decoder, + return (Handle__{ haLastDecode = ref, + haDecoder = mb_decoder, haEncoder = mb_encoder, haCodec = Just encoding, .. }) @@ -288,7 +288,7 @@ hGetEncoding hdl = -- It is unspecified whether the characters in the buffer are discarded -- or retained under these circumstances. -hFlush :: Handle -> IO () +hFlush :: Handle -> IO () hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer -- | The action 'hFlushAll' @hdl@ flushes all buffered data in @hdl@, @@ -308,7 +308,7 @@ hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer -- * 'isIllegalOperation' if @hdl@ has buffered read data, and is not -- seekable. -hFlushAll :: Handle -> IO () +hFlushAll :: Handle -> IO () hFlushAll handle = withHandle_ "hFlushAll" handle flushBuffer -- ----------------------------------------------------------------------------- @@ -320,7 +320,7 @@ instance Eq HandlePosn where (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2 instance Show HandlePosn where - showsPrec p (HandlePosn h pos) = + showsPrec p (HandlePosn h pos) = showsPrec p h . showString " at position " . shows pos -- HandlePosition is the Haskell equivalent of POSIX' off_t. @@ -345,13 +345,13 @@ hGetPosn handle = do -- -- * 'isPermissionError' if a system resource limit would be exceeded. -hSetPosn :: HandlePosn -> IO () +hSetPosn :: HandlePosn -> IO () hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i -- --------------------------------------------------------------------------- -- hSeek -{- Note: +{- Note: - when seeking using `SeekFromEnd', positive offsets (>=0) means seeking at or past EOF. @@ -381,7 +381,7 @@ hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i -- -- * 'isPermissionError' if a system resource limit would be exceeded. -hSeek :: Handle -> SeekMode -> Integer -> IO () +hSeek :: Handle -> SeekMode -> Integer -> IO () hSeek handle mode offset = wantSeekableHandle "hSeek" handle $ \ handle_@Handle__{..} -> do debugIO ("hSeek " ++ show (mode,offset)) @@ -393,10 +393,10 @@ hSeek handle mode offset = else do let r = bufL buf; w = bufR buf - if mode == RelativeSeek && isNothing haDecoder && + if mode == RelativeSeek && isNothing haDecoder && offset >= 0 && offset < fromIntegral (w - r) then writeIORef haCharBuffer buf{ bufL = r + fromIntegral offset } - else do + else do flushCharReadBuffer handle_ flushByteReadBuffer handle_ @@ -407,13 +407,13 @@ hSeek handle mode offset = -- handle @hdl@, as the number of bytes from the beginning of -- the file. The value returned may be subsequently passed to -- 'hSeek' to reposition the handle to the current position. --- +-- -- This operation may fail with: -- -- * 'isIllegalOperationError' if the Handle is not seekable. -- hTell :: Handle -> IO Integer -hTell handle = +hTell handle = wantSeekableHandle "hGetPosn" handle $ \ handle_@Handle__{..} -> do posn <- IODevice.tell haDevice @@ -445,7 +445,7 @@ hTell handle = hIsOpen :: Handle -> IO Bool hIsOpen handle = withHandle_ "hIsOpen" handle $ \ handle_ -> do - case haType handle_ of + case haType handle_ of ClosedHandle -> return False SemiClosedHandle -> return False _ -> return True @@ -453,7 +453,7 @@ hIsOpen handle = hIsClosed :: Handle -> IO Bool hIsClosed handle = withHandle_ "hIsClosed" handle $ \ handle_ -> do - case haType handle_ of + case haType handle_ of ClosedHandle -> return True _ -> return False @@ -471,7 +471,7 @@ hIsReadable :: Handle -> IO Bool hIsReadable (DuplexHandle _ _ _) = return True hIsReadable handle = withHandle_ "hIsReadable" handle $ \ handle_ -> do - case haType handle_ of + case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle htype -> return (isReadableHandleType htype) @@ -480,7 +480,7 @@ hIsWritable :: Handle -> IO Bool hIsWritable (DuplexHandle _ _ _) = return True hIsWritable handle = withHandle_ "hIsWritable" handle $ \ handle_ -> do - case haType handle_ of + case haType handle_ of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle htype -> return (isWritableHandleType htype) @@ -489,11 +489,11 @@ hIsWritable handle = -- for @hdl@. hGetBuffering :: Handle -> IO BufferMode -hGetBuffering handle = +hGetBuffering handle = withHandle_ "hGetBuffering" handle $ \ handle_ -> do - case haType handle_ of + case haType handle_ of ClosedHandle -> ioe_closedHandle - _ -> + _ -> -- We're being non-standard here, and allow the buffering -- of a semi-closed handle to be queried. -- sof 6/98 return (haBufferMode handle_) -- could be stricter.. @@ -501,7 +501,7 @@ hGetBuffering handle = hIsSeekable :: Handle -> IO Bool hIsSeekable handle = withHandle_ "hIsSeekable" handle $ \ handle_@Handle__{..} -> do - case haType of + case haType of ClosedHandle -> ioe_closedHandle SemiClosedHandle -> ioe_closedHandle AppendHandle -> return False @@ -519,7 +519,7 @@ hSetEcho handle on = do then return () else withHandle_ "hSetEcho" handle $ \ Handle__{..} -> do - case haType of + case haType of ClosedHandle -> ioe_closedHandle _ -> IODevice.setEcho haDevice on @@ -532,7 +532,7 @@ hGetEcho handle = do then return False else withHandle_ "hGetEcho" handle $ \ Handle__{..} -> do - case haType of + case haType of ClosedHandle -> ioe_closedHandle _ -> IODevice.getEcho haDevice @@ -541,7 +541,7 @@ hGetEcho handle = do hIsTerminalDevice :: Handle -> IO Bool hIsTerminalDevice handle = do withHandle_ "hIsTerminalDevice" handle $ \ Handle__{..} -> do - case haType of + case haType of ClosedHandle -> ioe_closedHandle _ -> IODevice.isTerminal haDevice @@ -557,7 +557,7 @@ hIsTerminalDevice handle = do hSetBinaryMode :: Handle -> Bool -> IO () hSetBinaryMode handle bin = withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} -> - do + do flushCharBuffer h_ closeTextCodecs h_ @@ -574,12 +574,12 @@ hSetBinaryMode handle bin = ref <- newIORef (error "codec_state", bbuf) return Handle__{ haLastDecode = ref, - haEncoder = mb_encoder, + haEncoder = mb_encoder, haDecoder = mb_decoder, haCodec = mb_te, haInputNL = inputNL nl, haOutputNL = outputNL nl, .. } - + -- ----------------------------------------------------------------------------- -- hSetNewlineMode @@ -605,10 +605,10 @@ hDuplicate h@(FileHandle path m) = do withHandle_' "hDuplicate" h m $ \h_ -> dupHandle path h Nothing h_ (Just handleFinalizer) hDuplicate h@(DuplexHandle path r w) = do - write_side@(FileHandle _ write_m) <- + write_side@(FileHandle _ write_m) <- withHandle_' "hDuplicate" h w $ \h_ -> dupHandle path h Nothing h_ (Just handleFinalizer) - read_side@(FileHandle _ read_m) <- + read_side@(FileHandle _ read_m) <- withHandle_' "hDuplicate" h r $ \h_ -> dupHandle path h (Just write_m) h_ Nothing return (DuplexHandle path read_m write_m) @@ -626,7 +626,7 @@ dupHandle filepath h other_side h_@Handle__{..} mb_finalizer = do Nothing -> do new_dev <- IODevice.dup haDevice dupHandle_ new_dev filepath other_side h_ mb_finalizer - Just r -> + Just r -> withHandle_' "dupHandle" h r $ \Handle__{haDevice=dev} -> do dupHandle_ dev filepath other_side h_ mb_finalizer @@ -647,7 +647,7 @@ dupHandle_ new_dev filepath other_side h_@Handle__{..} mb_finalizer = do -- Replacing a Handle {- | -Makes the second handle a duplicate of the first handle. The second +Makes the second handle a duplicate of the first handle. The second handle will be closed first, if it is not already. This can be used to retarget the standard Handles, for example: @@ -671,29 +671,29 @@ hDuplicateTo h1@(DuplexHandle path r1 w1) h2@(DuplexHandle _ r2 w2) = do _ <- hClose_help r2_ withHandle_' "hDuplicateTo" h1 r1 $ \r1_ -> do dupHandleTo path h1 (Just w1) r2_ r1_ Nothing -hDuplicateTo h1 _ = +hDuplicateTo h1 _ = ioe_dupHandlesNotCompatible h1 ioe_dupHandlesNotCompatible :: Handle -> IO a ioe_dupHandlesNotCompatible h = - ioException (IOError (Just h) IllegalOperation "hDuplicateTo" + ioException (IOError (Just h) IllegalOperation "hDuplicateTo" "handles are incompatible" Nothing Nothing) -dupHandleTo :: FilePath +dupHandleTo :: FilePath -> Handle -> Maybe (MVar Handle__) -> Handle__ -> Handle__ -> Maybe HandleFinalizer -> IO Handle__ -dupHandleTo filepath h other_side +dupHandleTo filepath h other_side hto_@Handle__{haDevice=devTo,..} h_@Handle__{haDevice=dev} mb_finalizer = do flushBuffer h_ case cast devTo of Nothing -> ioe_dupHandlesNotCompatible h - Just dev' -> do + Just dev' -> do _ <- IODevice.dup2 dev dev' FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer takeMVar m @@ -709,15 +709,15 @@ hShow h@(FileHandle path _) = showHandle' path False h hShow h@(DuplexHandle path _ _) = showHandle' path True h showHandle' :: String -> Bool -> Handle -> IO String -showHandle' filepath is_duplex h = +showHandle' filepath is_duplex h = withHandle_ "showHandle" h $ \hdl_ -> let showType | is_duplex = showString "duplex (read-write)" | otherwise = shows (haType hdl_) in - return - (( showChar '{' . - showHdl (haType hdl_) + return + (( showChar '{' . + showHdl (haType hdl_) (showString "loc=" . showString filepath . showChar ',' . showString "type=" . showType . showChar ',' . showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haCharBuffer hdl_))) (haBufferMode hdl_) . showString "}" ) @@ -725,7 +725,7 @@ showHandle' filepath is_duplex h = where showHdl :: HandleType -> ShowS -> ShowS - showHdl ht cont = + showHdl ht cont = case ht of ClosedHandle -> shows ht . showString "}" _ -> cont @@ -738,6 +738,6 @@ showHandle' filepath is_duplex h = BlockBuffering (Just n) -> showString "block " . showParen True (shows n) BlockBuffering Nothing -> showString "block " . showParen True (shows def) where - def :: Int + def :: Int def = bufSize buf diff --git a/libraries/base/GHC/IO/Handle/Internals.hs b/libraries/base/GHC/IO/Handle/Internals.hs index 118b71e469..2865136a66 100644 --- a/libraries/base/GHC/IO/Handle/Internals.hs +++ b/libraries/base/GHC/IO/Handle/Internals.hs @@ -14,7 +14,7 @@ -- Module : GHC.IO.Handle.Internals -- Copyright : (c) The University of Glasgow, 1994-2001 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable @@ -28,7 +28,7 @@ module GHC.IO.Handle.Internals ( withHandle, withHandle', withHandle_, withHandle__', withHandle_', withAllHandles__, - wantWritableHandle, wantReadableHandle, wantReadableHandle_, + wantWritableHandle, wantReadableHandle, wantReadableHandle_, wantSeekableHandle, mkHandle, mkFileHandle, mkDuplexHandle, @@ -439,8 +439,8 @@ getCharBuffer dev state = do ioref <- newIORef buffer is_tty <- IODevice.isTerminal dev - let buffer_mode - | is_tty = LineBuffering + let buffer_mode + | is_tty = LineBuffering | otherwise = BlockBuffering Nothing return (ioref, buffer_mode) @@ -570,10 +570,10 @@ flushCharReadBuffer Handle__{..} = do -- restore the codec state setState decoder codec_state - + (bbuf1,cbuf1) <- (streamEncode decoder) bbuf0 cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 } - + debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++ " cbuf=" ++ summaryBuffer cbuf1) @@ -622,7 +622,7 @@ mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do bbufref <- newIORef bbuf last_decode <- newIORef (error "codec_state", bbuf) - (cbufref,bmode) <- + (cbufref,bmode) <- if buffered then getCharBuffer dev buf_state else mkUnBuffer buf_state @@ -645,7 +645,7 @@ mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do -- | makes a new 'Handle' mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev) - => dev -- ^ the underlying IO device, which must support + => dev -- ^ the underlying IO device, which must support -- 'IODevice', 'BufferedIO' and 'Typeable' -> FilePath -- ^ a string describing the 'Handle', e.g. the file @@ -669,13 +669,13 @@ mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle mkDuplexHandle dev filepath mb_codec tr_newlines = do - write_side@(FileHandle _ write_m) <- + write_side@(FileHandle _ write_m) <- mkHandle dev filepath WriteHandle True mb_codec tr_newlines (Just handleFinalizer) Nothing -- no othersie - read_side@(FileHandle _ read_m) <- + read_side@(FileHandle _ read_m) <- mkHandle dev filepath ReadHandle True mb_codec tr_newlines Nothing -- no finalizer @@ -709,7 +709,7 @@ openTextEncoding (Just TextEncoding{..}) ha_type cont = do mb_encoder <- if isWritableHandleType ha_type then do encoder <- mkTextEncoder return (Just encoder) - else + else return Nothing cont mb_encoder mb_decoder @@ -729,7 +729,7 @@ closeTextCodecs Handle__{..} = do -- use. hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException) hClose_help handle_ = - case haType handle_ of + case haType handle_ of ClosedHandle -> return (handle_,Nothing) _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible -- it is important that hClose doesn't fail and @@ -748,10 +748,10 @@ hClose_handle_ h_@Handle__{..} = do -- close the file descriptor, but not when this is the read -- side of a duplex handle. -- If an exception is raised by the close(), we want to continue - -- to close the handle and release the lock if it has one, then + -- to close the handle and release the lock if it has one, then -- we return the exception to the caller of hClose_help which can -- raise it if necessary. - maybe_exception <- + maybe_exception <- case haOtherSide of Nothing -> trymaybe $ IODevice.close haDevice Just _ -> return Nothing @@ -760,7 +760,7 @@ hClose_handle_ h_@Handle__{..} = do writeIORef haBuffers BufferListNil writeIORef haCharBuffer noCharBuffer writeIORef haByteBuffer noByteBuffer - + -- release our encoder/decoder closeTextCodecs h_ @@ -784,13 +784,13 @@ noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer hLookAhead_ :: Handle__ -> IO Char hLookAhead_ handle_@Handle__{..} = do buf <- readIORef haCharBuffer - + -- fill up the read buffer if necessary new_buf <- if isEmptyBuffer buf then readTextDevice handle_ buf else return buf writeIORef haCharBuffer new_buf - + peekCharBuf (bufRaw buf) (bufL buf) -- --------------------------------------------------------------------------- @@ -808,7 +808,7 @@ debugIO s -- Text input/output -- Read characters into the provided buffer. Return when any --- characters are available; raise an exception if the end of +-- characters are available; raise an exception if the end of -- file is reached. -- -- In uses of readTextDevice within base, the input buffer is either: @@ -825,7 +825,7 @@ readTextDevice h_@Handle__{..} cbuf = do -- bbuf0 <- readIORef haByteBuffer - debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++ + debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++ " bbuf=" ++ summaryBuffer bbuf0) bbuf1 <- if not (isEmptyBuffer bbuf0) @@ -837,7 +837,7 @@ readTextDevice h_@Handle__{..} cbuf = do debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1) - (bbuf2,cbuf') <- + (bbuf2,cbuf') <- case haDecoder of Nothing -> do writeIORef haLastDecode (error "codec_state", bbuf1) @@ -847,7 +847,7 @@ readTextDevice h_@Handle__{..} cbuf = do writeIORef haLastDecode (state, bbuf1) (streamEncode decoder) bbuf1 cbuf - debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++ + debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++ " bbuf=" ++ summaryBuffer bbuf2) -- We can't return from readTextDevice without reading at least a single extra character, @@ -871,7 +871,7 @@ readTextDevice' h_@Handle__{..} bbuf0 cbuf0 = do -- readTextDevice only calls us if we got some bytes but not some characters. -- This can't occur if haDecoder is Nothing because latin1_decode accepts all bytes. let Just decoder = haDecoder - + (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1 if r == 0 then do @@ -893,15 +893,15 @@ readTextDevice' h_@Handle__{..} bbuf0 cbuf0 = do else return cbuf1 else do debugIO ("readTextDevice' after reading: bbuf=" ++ summaryBuffer bbuf2) - + (bbuf3,cbuf1) <- do state <- getState decoder writeIORef haLastDecode (state, bbuf2) (streamEncode decoder) bbuf2 cbuf0 - - debugIO ("readTextDevice' after decoding: cbuf=" ++ summaryBuffer cbuf1 ++ + + debugIO ("readTextDevice' after decoding: cbuf=" ++ summaryBuffer cbuf1 ++ " bbuf=" ++ summaryBuffer bbuf3) - + writeIORef haByteBuffer bbuf3 if bufR cbuf0 == bufR cbuf1 then readTextDevice' h_ bbuf3 cbuf1 diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs index 4191356959..de48bf44ae 100644 --- a/libraries/base/GHC/IO/Handle/Text.hs +++ b/libraries/base/GHC/IO/Handle/Text.hs @@ -15,7 +15,7 @@ -- Module : GHC.IO.Text -- Copyright : (c) The University of Glasgow, 1992-2008 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable @@ -24,7 +24,7 @@ -- ----------------------------------------------------------------------------- -module GHC.IO.Handle.Text ( +module GHC.IO.Handle.Text ( hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr, commitBuffer', -- hack, see below hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking, @@ -95,7 +95,7 @@ hWaitForInput h msecs = do if not (isEmptyBuffer cbuf) then return True else do - if msecs < 0 + if msecs < 0 then do cbuf' <- readTextDevice handle_ cbuf writeIORef haCharBuffer cbuf' return True @@ -234,7 +234,7 @@ hGetLineBufferedLoop handle_@Handle__{..} -- we reached EOF. There might be a lone \r left -- in the buffer, so check for that and -- append it to the line if necessary. - -- + -- let pre = if not (isEmptyBuffer buf1) then "\r" else "" writeIORef haCharBuffer buf1{ bufL=0, bufR=0 } let str = concat (reverse (pre:xs:xss)) @@ -262,8 +262,8 @@ maybeFillReadBuffer handle_ buf unpack :: RawCharBuffer -> Int -> Int -> [Char] -> IO [Char] unpack !buf !r !w acc0 | r == w = return acc0 - | otherwise = - withRawBuffer buf $ \pbuf -> + | otherwise = + withRawBuffer buf $ \pbuf -> let unpackRB acc !i | i < r = return acc @@ -310,7 +310,7 @@ unpack_nl !buf !r !w acc0 in do c <- peekElemOff pbuf (w-1) if (c == '\r') - then do + then do -- If the last char is a '\r', we need to know whether or -- not it is followed by a '\n', so leave it in the buffer -- for now and just unpack the rest. @@ -375,7 +375,7 @@ unpack_nl !buf !r !w acc0 -- * 'isEOFError' if the end of file has been reached. hGetContents :: Handle -> IO String -hGetContents handle = +hGetContents handle = wantReadableHandle "hGetContents" handle $ \handle_ -> do xs <- lazyRead handle return (handle_{ haType=SemiClosedHandle}, xs ) @@ -385,13 +385,13 @@ hGetContents handle = -- they have to check whether the handle has indeed been closed. lazyRead :: Handle -> IO String -lazyRead handle = +lazyRead handle = unsafeInterleaveIO $ withHandle "hGetContents" handle $ \ handle_ -> do case haType handle_ of ClosedHandle -> return (handle_, "") SemiClosedHandle -> lazyReadBuffered handle handle_ - _ -> ioException + _ -> ioException (IOError (Just handle) IllegalOperation "hGetContents" "illegal handle type" Nothing Nothing) @@ -556,7 +556,7 @@ hPutChars _ [] = return () hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer) -getSpareBuffer Handle__{haCharBuffer=ref, +getSpareBuffer Handle__{haCharBuffer=ref, haBuffers=spare_ref, haBufferMode=mode} = do @@ -591,7 +591,7 @@ writeBlocks hdl line_buffered add_nl nl shoveString 0 (c:cs) rest | c == '\n' = do n' <- if nl == CRLF - then do + then do n1 <- writeCharBuf raw n '\r' writeCharBuf raw n1 '\n' else do @@ -611,7 +611,7 @@ writeBlocks hdl line_buffered add_nl nl -- ----------------------------------------------------------------------------- -- commitBuffer handle buf sz count flush release --- +-- -- Write the contents of the buffer 'buf' ('sz' bytes long, containing -- 'count' bytes of data) to handle (handle must be block or line buffered). @@ -623,7 +623,7 @@ commitBuffer -> Bool -- release the buffer? -> IO () -commitBuffer hdl !raw !sz !count flush release = +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) @@ -712,8 +712,8 @@ hPutBuf':: Handle -- handle to write to hPutBuf' handle ptr count can_block | count == 0 = return 0 | count < 0 = illegalBufferSize handle "hPutBuf" count - | otherwise = - wantWritableHandle "hPutBuf" handle $ + | otherwise = + wantWritableHandle "hPutBuf" handle $ \ h_@Handle__{..} -> do debugIO ("hPutBuf count=" ++ show count) @@ -747,7 +747,7 @@ bufWrite h_@Handle__{..} ptr count can_block = old_buf' <- Buffered.flushWriteBuffer haDevice old_buf -- TODO: we should do a non-blocking flush here writeIORef haByteBuffer old_buf' - -- if we can fit in the buffer, then just loop + -- if we can fit in the buffer, then just loop if count < size then bufWrite h_ ptr count can_block else if can_block @@ -761,7 +761,7 @@ writeChunk h_@Handle__{..} ptr bytes | otherwise = error "Todo: hPutBuf" writeChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int -writeChunkNonBlocking h_@Handle__{..} ptr bytes +writeChunkNonBlocking h_@Handle__{..} ptr bytes | Just fd <- cast haDevice = RawIO.writeNonBlocking (fd::FD) ptr bytes | otherwise = error "Todo: hPutBuf" @@ -787,7 +787,7 @@ hGetBuf :: Handle -> Ptr a -> Int -> IO Int hGetBuf h ptr count | count == 0 = return 0 | count < 0 = illegalBufferSize h "hGetBuf" count - | otherwise = + | otherwise = wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do flushCharReadBuffer h_ buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } @@ -803,16 +803,16 @@ hGetBuf h ptr count bufReadNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int bufReadNonEmpty h_@Handle__{..} buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } - ptr !so_far !count + ptr !so_far !count = do let avail = w - r if (count < avail) - then do + then do copyFromRawBuffer ptr raw r count writeIORef haByteBuffer buf{ bufL = r + count } return (so_far + count) else do - + copyFromRawBuffer ptr raw r avail let buf' = buf{ bufR=0, bufL=0 } writeIORef haByteBuffer buf' @@ -820,7 +820,7 @@ bufReadNonEmpty h_@Handle__{..} so_far' = so_far + avail ptr' = ptr `plusPtr` avail - if remaining == 0 + if remaining == 0 then return so_far' else bufReadEmpty h_ buf' ptr' so_far' remaining @@ -832,7 +832,7 @@ bufReadEmpty h_@Handle__{..} | count > sz, Just fd <- cast haDevice = loop fd 0 count | otherwise = do (r,buf') <- Buffered.fillReadBuffer haDevice buf - if r == 0 + if r == 0 then return so_far else do writeIORef haByteBuffer buf' bufReadNonEmpty h_ buf' ptr so_far count @@ -914,7 +914,7 @@ hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int hGetBufNonBlocking h ptr count | count == 0 = return 0 | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count - | otherwise = + | otherwise = wantReadableHandle_ "hGetBufNonBlocking" h $ \ h_@Handle__{..} -> do flushCharReadBuffer h_ buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } @@ -956,7 +956,7 @@ bufReadNBNonEmpty h_@Handle__{..} = do let avail = w - r if (count < avail) - then do + then do copyFromRawBuffer ptr raw r count writeIORef haByteBuffer buf{ bufL = r + count } return (so_far + count) diff --git a/libraries/base/GHC/IO/Handle/Types.hs b/libraries/base/GHC/IO/Handle/Types.hs index fbedeecdbd..4187499317 100644 --- a/libraries/base/GHC/IO/Handle/Types.hs +++ b/libraries/base/GHC/IO/Handle/Types.hs @@ -12,7 +12,7 @@ -- Module : GHC.IO.Handle.Types -- Copyright : (c) The University of Glasgow, 1994-2009 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable @@ -54,13 +54,13 @@ import Control.Monad -- --------------------------------------------------------------------------- -- Handle type --- A Handle is represented by (a reference to) a record +-- A Handle is represented by (a reference to) a record -- containing the state of the I/O port/device. We record -- the following pieces of info: -- * type (read,write,closed etc.) -- * the underlying file descriptor --- * buffering mode +-- * buffering mode -- * buffer, and spare buffers -- * user-friendly name (usually the -- FilePath used when IO.openFile was called) @@ -72,7 +72,7 @@ import Control.Monad -- represented by values of type @Handle@. Each value of this type is a -- /handle/: a record used by the Haskell run-time system to /manage/ I\/O -- with file system objects. A handle has at least the following properties: --- +-- -- * whether it manages input or output or both; -- -- * whether it is /open/, /closed/ or /semi-closed/; @@ -96,7 +96,7 @@ import Control.Monad -- equal according to '==' only to itself; no attempt -- is made to compare the internal state of different handles for equality. -data Handle +data Handle = FileHandle -- A normal handle to a file FilePath -- the file (used for error messages -- only) @@ -118,7 +118,7 @@ data Handle instance Eq Handle where (FileHandle _ h1) == (FileHandle _ h2) = h1 == h2 (DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2 - _ == _ = False + _ == _ = False data Handle__ = forall dev enc_state dec_state . (IODevice dev, BufferedIO dev, Typeable dev) => @@ -135,7 +135,7 @@ data Handle__ haCodec :: Maybe TextEncoding, haInputNL :: Newline, haOutputNL :: Newline, - haOtherSide :: Maybe (MVar Handle__) -- ptr to the write side of a + haOtherSide :: Maybe (MVar Handle__) -- ptr to the write side of a -- duplex handle. } deriving Typeable @@ -144,7 +144,7 @@ data Handle__ -- a new one for each hPutStr. These buffers are *guaranteed* to be the -- same size as the main buffer. data BufferList e - = BufferListNil + = BufferListNil | BufferListCons (RawBuffer e) (BufferList e) -- Internally, we classify handles as being one @@ -202,13 +202,13 @@ checkHandleInvariants _ = return () -- --------------------------------------------------------------------------- -- Buffering modes --- | Three kinds of buffering are supported: line-buffering, +-- | Three kinds of buffering are supported: line-buffering, -- block-buffering or no-buffering. These modes have the following -- effects. For output, items are written out, or /flushed/, -- from the internal buffer according to the buffer mode: -- -- * /line-buffering/: the entire output buffer is flushed --- whenever a newline is output, the buffer overflows, +-- whenever a newline is output, the buffer overflows, -- a 'System.IO.hFlush' is issued, or the handle is closed. -- -- * /block-buffering/: the entire buffer is written out whenever it @@ -239,10 +239,10 @@ checkHandleInvariants _ = return () -- The default buffering mode when a handle is opened is -- implementation-dependent and may depend on the file system object -- which is attached to that handle. --- For most implementations, physical files will normally be block-buffered +-- For most implementations, physical files will normally be block-buffered -- and terminals will normally be line-buffered. -data BufferMode +data BufferMode = NoBuffering -- ^ buffering is disabled if possible. | LineBuffering -- ^ line-buffering should be enabled if possible. @@ -256,7 +256,7 @@ data BufferMode [note Buffering Implementation] Each Handle has two buffers: a byte buffer (haByteBuffer) and a Char -buffer (haCharBuffer). +buffer (haCharBuffer). [note Buffered Reading] @@ -359,7 +359,7 @@ data Newline = LF -- ^ '\n' -- are assumed to represent newlines with the '\n' character; the -- newline mode specifies how to translate '\n' on output, and what to -- translate into '\n' on input. -data NewlineMode +data NewlineMode = NewlineMode { inputNL :: Newline, -- ^ the representation of newlines on input outputNL :: Newline @@ -380,25 +380,25 @@ nativeNewline = LF -- represetnation on output. This mode can be used on any platform, and -- works with text files using any newline convention. The downside is -- that @readFile >>= writeFile@ might yield a different file. --- --- > universalNewlineMode = NewlineMode { inputNL = CRLF, +-- +-- > universalNewlineMode = NewlineMode { inputNL = CRLF, -- > outputNL = nativeNewline } -- universalNewlineMode :: NewlineMode -universalNewlineMode = NewlineMode { inputNL = CRLF, +universalNewlineMode = NewlineMode { inputNL = CRLF, outputNL = nativeNewline } -- | Use the native newline representation on both input and output --- +-- -- > nativeNewlineMode = NewlineMode { inputNL = nativeNewline -- > outputNL = nativeNewline } -- nativeNewlineMode :: NewlineMode -nativeNewlineMode = NewlineMode { inputNL = nativeNewline, +nativeNewlineMode = NewlineMode { inputNL = nativeNewline, outputNL = nativeNewline } -- | Do no newline translation at all. --- +-- -- > noNewlineTranslation = NewlineMode { inputNL = LF, outputNL = LF } -- noNewlineTranslation :: NewlineMode @@ -421,7 +421,7 @@ instance Show HandleType where AppendHandle -> showString "writable (append)" ReadWriteHandle -> showString "read-writable" -instance Show Handle where +instance Show Handle where showsPrec _ (FileHandle file _) = showHandle file showsPrec _ (DuplexHandle file _ _) = showHandle file diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs index 2dffecc26c..ffcc8ab56f 100644 --- a/libraries/base/GHC/List.lhs +++ b/libraries/base/GHC/List.lhs @@ -646,9 +646,9 @@ xs !! (I# n0) | isTrue# (n0 <# 0#) = error "Prelude.(!!): negative index\n" foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c foldr2 k z = go where - go [] _ys = z - go _xs [] = z - go (x:xs) (y:ys) = k x y (go xs ys) + go [] _ys = z + go _xs [] = z + go (x:xs) (y:ys) = k x y (go xs ys) {-# INLINE [0] foldr2 #-} foldr2_left :: (a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d diff --git a/libraries/base/GHC/Stack.hsc b/libraries/base/GHC/Stack.hsc index 91fddfb558..edd0f4f1bc 100644 --- a/libraries/base/GHC/Stack.hsc +++ b/libraries/base/GHC/Stack.hsc @@ -3,7 +3,7 @@ -- Module : GHC.Stack -- Copyright : (c) The University of Glasgow 2011 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) diff --git a/libraries/base/GHC/Weak.lhs b/libraries/base/GHC/Weak.lhs index 5405a302ed..d341f5717d 100644 --- a/libraries/base/GHC/Weak.lhs +++ b/libraries/base/GHC/Weak.lhs @@ -14,7 +14,7 @@ -- Module : GHC.Weak -- Copyright : (c) The University of Glasgow, 1998-2002 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) @@ -46,7 +46,7 @@ A weak pointer may also have a finalizer of type @IO ()@; if it does, then the finalizer will be run at most once, at a time after the key has become unreachable by the program (\"dead\"). The storage manager attempts to run the finalizer(s) for an object soon after the object -dies, but promptness is not guaranteed. +dies, but promptness is not guaranteed. It is not guaranteed that a finalizer will eventually run, and no attempt is made to run outstanding finalizers when the program exits. @@ -137,7 +137,7 @@ Instance Eq (Weak v) where -} --- run a batch of finalizers from the garbage collector. We're given +-- run a batch of finalizers from the garbage collector. We're given -- an array of finalizers and the length of the array, and we just -- call each one in turn. -- @@ -145,13 +145,13 @@ Instance Eq (Weak v) where -- code (sigh) --SDM. runFinalizerBatch :: Int -> Array# (IO ()) -> IO () -runFinalizerBatch (I# n) arr = +runFinalizerBatch (I# n) arr = let go m = IO $ \s -> - case m of + case m of 0# -> (# s, () #) _ -> let !m' = m -# 1# in - case indexArray# arr m' of { (# io #) -> - case unIO io s of { (# s', _ #) -> + case indexArray# arr m' of { (# io #) -> + case unIO io s of { (# s', _ #) -> unIO (go m') s' }} in diff --git a/libraries/base/GHC/Windows.hs b/libraries/base/GHC/Windows.hs index 71ebcf7550..0a57fc3368 100644 --- a/libraries/base/GHC/Windows.hs +++ b/libraries/base/GHC/Windows.hs @@ -6,7 +6,7 @@ -- Module : GHC.Windows -- Copyright : (c) The University of Glasgow, 2009 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable diff --git a/libraries/base/System/Exit.hs b/libraries/base/System/Exit.hs index 33cc4e8b9a..f2fc433777 100644 --- a/libraries/base/System/Exit.hs +++ b/libraries/base/System/Exit.hs @@ -5,7 +5,7 @@ -- Module : System.Exit -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs index cb67a2a1c8..52931fd189 100644 --- a/libraries/base/System/IO.hs +++ b/libraries/base/System/IO.hs @@ -6,7 +6,7 @@ -- Module : System.IO -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable @@ -181,21 +181,21 @@ module System.IO ( -- 'readFile'), where a decoding error merely results in -- termination of the character stream, as with other I/O errors. - hSetEncoding, + hSetEncoding, hGetEncoding, -- ** Unicode encodings - TextEncoding, + TextEncoding, latin1, utf8, utf8_bom, utf16, utf16le, utf16be, - utf32, utf32le, utf32be, + utf32, utf32le, utf32be, localeEncoding, char8, mkTextEncoding, -- * Newline conversion - + -- | In Haskell, a newline is always represented by the character -- '\n'. However, in files and external character streams, a -- newline may be represented by another character sequence, such @@ -213,9 +213,9 @@ module System.IO ( -- -- Binary-mode 'Handle's do no newline translation at all. -- - hSetNewlineMode, - Newline(..), nativeNewline, - NewlineMode(..), + hSetNewlineMode, + Newline(..), nativeNewline, + NewlineMode(..), noNewlineTranslation, universalNewlineMode, nativeNewlineMode, ) where @@ -358,7 +358,7 @@ localeEncoding = initLocaleEncoding -- | Computation 'hReady' @hdl@ indicates whether at least one item is -- available for input from handle @hdl@. --- +-- -- This operation may fail with: -- -- * 'System.IO.Error.isEOFError' if the end of file has been reached. diff --git a/libraries/base/System/IO/Error.hs b/libraries/base/System/IO/Error.hs index 63997b8491..b281fd59eb 100644 --- a/libraries/base/System/IO/Error.hs +++ b/libraries/base/System/IO/Error.hs @@ -6,7 +6,7 @@ -- Module : System.IO.Error -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable @@ -30,9 +30,9 @@ module System.IO.Error ( isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError, - isFullError, + isFullError, isEOFError, - isIllegalOperation, + isIllegalOperation, isPermissionError, isUserError, @@ -57,7 +57,7 @@ module System.IO.Error ( alreadyInUseErrorType, fullErrorType, eofErrorType, - illegalOperationErrorType, + illegalOperationErrorType, permissionErrorType, userErrorType, @@ -65,11 +65,11 @@ module System.IO.Error ( isAlreadyExistsErrorType, isDoesNotExistErrorType, isAlreadyInUseErrorType, - isFullErrorType, + isFullErrorType, isEOFErrorType, - isIllegalOperationErrorType, + isIllegalOperationErrorType, isPermissionErrorType, - isUserErrorType, + isUserErrorType, -- * Throwing and catching I\/O errors @@ -113,11 +113,11 @@ tryIOError f = catch (do r <- f -- error if applicable. mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError mkIOError t location maybe_hdl maybe_filename = - IOError{ ioe_type = t, + IOError{ ioe_type = t, ioe_location = location, ioe_description = "", ioe_errno = Nothing, - ioe_handle = maybe_hdl, + ioe_handle = maybe_hdl, ioe_filename = maybe_filename } @@ -302,12 +302,12 @@ modifyIOError f io = catch io (\e -> ioError (f e)) -- | Adds a location description and maybe a file path and file handle -- to an 'IOError'. If any of the file handle or file path is not given -- the corresponding value in the 'IOError' remains unaltered. -annotateIOError :: IOError - -> String - -> Maybe Handle - -> Maybe FilePath - -> IOError -annotateIOError ioe loc hdl path = +annotateIOError :: IOError + -> String + -> Maybe Handle + -> Maybe FilePath + -> IOError +annotateIOError ioe loc hdl path = ioe{ ioe_handle = hdl `mplus` ioe_handle ioe, ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe } diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs index fccd3499bd..30bf19c5a4 100644 --- a/libraries/base/System/Posix/Internals.hs +++ b/libraries/base/System/Posix/Internals.hs @@ -7,7 +7,7 @@ -- Module : System.Posix.Internals -- Copyright : (c) The University of Glasgow, 1992-2002 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (requires POSIX) @@ -81,11 +81,11 @@ type FD = CInt -- stat()-related stuff fdFileSize :: FD -> IO Integer -fdFileSize fd = +fdFileSize fd = allocaBytes sizeof_stat $ \ p_stat -> do throwErrnoIfMinus1Retry_ "fileSize" $ c_fstat fd p_stat - c_mode <- st_mode p_stat :: IO CMode + c_mode <- st_mode p_stat :: IO CMode if not (s_isreg c_mode) then return (-1) else do @@ -103,7 +103,7 @@ fileType file = -- NOTE: On Win32 platforms, this will only work with file descriptors -- referring to file handles. i.e., it'll fail for socket FDs. fdStat :: FD -> IO (IODeviceType, CDev, CIno) -fdStat fd = +fdStat fd = allocaBytes sizeof_stat $ \ p_stat -> do throwErrnoIfMinus1Retry_ "fdType" $ c_fstat fd p_stat @@ -111,7 +111,7 @@ fdStat fd = dev <- st_dev p_stat ino <- st_ino p_stat return (ty,dev,ino) - + fdType :: FD -> IO IODeviceType fdType fd = do (ty,_,_) <- fdStat fd; return ty @@ -126,7 +126,7 @@ statGetType p_stat = do -- Q: map char devices to RawDevice too? | s_isblk c_mode -> return RawDevice | otherwise -> ioError ioe_unknownfiletype - + ioe_unknownfiletype :: IOException ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType" "unknown file type" @@ -141,7 +141,7 @@ fdGetMode _ = do let flags = o_RDWR #else fdGetMode fd = do - flags <- throwErrnoIfMinus1Retry "fdGetMode" + flags <- throwErrnoIfMinus1Retry "fdGetMode" (c_fcntl_read fd const_f_getfl) #endif let @@ -154,7 +154,7 @@ fdGetMode fd = do | wH = WriteMode | rwH = ReadWriteMode | otherwise = ReadMode - + return mode #ifdef mingw32_HOST_OS @@ -201,7 +201,7 @@ getEcho fd = do return ((lflag .&. fromIntegral const_echo) /= 0) setCooked :: FD -> Bool -> IO () -setCooked fd cooked = +setCooked fd cooked = tcSetAttr fd $ \ p_tios -> do -- turn on/off ICANON @@ -277,7 +277,7 @@ setCooked fd cooked = do else return () ioe_unk_error :: String -> String -> IOException -ioe_unk_error loc msg +ioe_unk_error loc msg = ioeSetErrorString (mkIOError OtherError loc Nothing Nothing) msg -- Note: echoing goes hand in hand with enabling 'line input' / raw-ness @@ -438,7 +438,7 @@ foreign import capi unsafe "HsBase.h fcntl" c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt foreign import ccall unsafe "HsBase.h fork" - c_fork :: IO CPid + c_fork :: IO CPid foreign import ccall unsafe "HsBase.h link" c_link :: CString -> CString -> IO CInt diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs index 48cbe57e5d..4de0908b23 100644 --- a/libraries/base/Text/ParserCombinators/ReadP.hs +++ b/libraries/base/Text/ParserCombinators/ReadP.hs @@ -9,13 +9,13 @@ -- Module : Text.ParserCombinators.ReadP -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (local universal quantification) -- -- This is a library of parser combinators, originally written by Koen Claessen. --- It parses all alternatives in parallel, so it never keeps hold of +-- It parses all alternatives in parallel, so it never keeps hold of -- the beginning of the input string, a common source of space leaks with -- other parsers. The '(+++)' choice combinator is genuinely commutative; -- it makes no difference which branch is \"shorter\". @@ -23,17 +23,17 @@ ----------------------------------------------------------------------------- module Text.ParserCombinators.ReadP - ( + ( -- * The 'ReadP' type ReadP, - + -- * Primitive operations get, look, (+++), (<++), gather, - + -- * Other operations pfail, eof, @@ -234,9 +234,9 @@ gather :: ReadP a -> ReadP (String, a) -- ^ Transforms a parser into one that does the same, but -- in addition returns the exact characters read. -- IMPORTANT NOTE: 'gather' gives a runtime error if its first argument --- is built using any occurrences of readS_to_P. +-- is built using any occurrences of readS_to_P. gather (R m) - = R (\k -> gath id (m (\a -> return (\s -> k (s,a))))) + = R (\k -> gath id (m (\a -> return (\s -> k (s,a))))) where gath :: (String -> String) -> P (String -> P b) -> P b gath l (Get f) = Get (\c -> gath (l.(c:)) (f c)) @@ -259,8 +259,8 @@ char c = satisfy (c ==) eof :: ReadP () -- ^ Succeeds iff we are at the end of input -eof = do { s <- look - ; if null s then return () +eof = do { s <- look + ; if null s then return () else pfail } string :: String -> ReadP String @@ -477,12 +477,12 @@ Here follow the properties: > xs +<+ _ = xs > > prop_Gather s = -> forAll readPWithoutReadS $ \p -> +> forAll readPWithoutReadS $ \p -> > readP_to_S (gather p) s =~ -> [ ((pre,x::Int),s') -> | (x,s') <- readP_to_S p s -> , let pre = take (length s - length s') s -> ] +> [ ((pre,x::Int),s') +> | (x,s') <- readP_to_S p s +> , let pre = take (length s - length s') s +> ] > > prop_String_Yes this s = > readP_to_S (string this) (this ++ s) =~ diff --git a/libraries/base/Text/ParserCombinators/ReadPrec.hs b/libraries/base/Text/ParserCombinators/ReadPrec.hs index 52f4eafca9..027648d9e8 100644 --- a/libraries/base/Text/ParserCombinators/ReadPrec.hs +++ b/libraries/base/Text/ParserCombinators/ReadPrec.hs @@ -6,7 +6,7 @@ -- Module : Text.ParserCombinators.ReadPrec -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (uses Text.ParserCombinators.ReadP) @@ -113,7 +113,7 @@ reset :: ReadPrec a -> ReadPrec a reset (P f) = P (\_ -> f minPrec) prec :: Prec -> ReadPrec a -> ReadPrec a --- ^ @(prec n p)@ checks whether the precedence context is +-- ^ @(prec n p)@ checks whether the precedence context is -- less than or equal to @n@, and -- -- * if not, fails diff --git a/libraries/base/Text/Read.hs b/libraries/base/Text/Read.hs index 18c485fea1..1d08343e2c 100644 --- a/libraries/base/Text/Read.hs +++ b/libraries/base/Text/Read.hs @@ -6,7 +6,7 @@ -- Module : Text.Read -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : non-portable (uses Text.ParserCombinators.ReadP) @@ -15,7 +15,7 @@ -- -- The "Text.Read" library is the canonical library to import for -- 'Read'-class facilities. For GHC only, it offers an extended and much --- improved 'Read' class, which constitutes a proposed alternative to the +-- improved 'Read' class, which constitutes a proposed alternative to the -- Haskell 2010 'Read'. In particular, writing parsers is easier, and -- the parsers are much more efficient. -- diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs index 39ca46a33f..cdbcf4ad1d 100644 --- a/libraries/base/Text/Read/Lex.hs +++ b/libraries/base/Text/Read/Lex.hs @@ -164,7 +164,7 @@ lex = skipSpaces >> lexToken -- | /Since: 4.7.0.0/ expect :: Lexeme -> ReadP () -expect lexeme = do { skipSpaces +expect lexeme = do { skipSpaces ; thing <- lexToken ; if thing == lexeme then return () else pfail } |