diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,63 @@ +# 1.6.0.3 + +_Andreas Abel, 2026-01-07_ + +- Allow `time < 2` +- Tested with GHC 8.0 - 9.14.1 + +# 1.6.0.2 + +_Andreas Abel, 2025-03-02_ + +- Drop support for GHC 7.10 +- Allow `containers < 1` +- Tested with GHC 8.0 - 9.12.1 + +# 1.6.0.1 + +_Andreas Abel, 2023-09-11_ + +- Repair build on Windows with GHC 9.6 (`directory-1.3.8.*`): + Revoke `Safe` status of these modules: + * `System.IO.WindowsCompat` + * `System.IO.PlafCompat` +- Tested with GHC 7.10 - 9.8 alpha1. + +# 1.6.0.0 + +_Andreas Abel, 2023-01-14_ + +- Allow `directory-1.3.8.0` which is no longer `Safe` Haskell. + Thus, we need to revoke `Safe` status of the following modules: + * `Data.MIME.Types` + * `Network.Email.Sendmail` + * `System.IO.HVFS` + * `System.IO.HVFS.Combinators` + * `System.IO.HVFS.InstanceHelpers` + * `System.Path` + * `System.Path.Glob` + * `System.Path.NameManip` +- Allow `unix-2.8.0.0` (enables `directory-1.3.8.0`). +- Tested with GHC 7.10 - 9.6 alpha1. + +### 1.5.0.1 + +_Andreas Abel, 2022-03-14_ + +- Repair build on Windows (regression in 1.5.0.0, [#59](https://github.com/haskell-hvr/missingh/issues/59)). +- Tested with GHC 7.10 - 9.2. + +# 1.5.0.0 + +_Andreas Abel, 2022-02-12_ + +- Dropped support for GHC ≤ 7.8. +- Support `mtl-2.3`: removed `Error` instance for `BinPackerError` and `GZipError`. +- Use `sortOn` in `packLargeFirst` ([#41](https://github.com/haskell-hvr/missingh/issues/41)). +- Fix warnings for `-Wall` and `-Wcompat`. +- Hardened code by making all imports explicit. +- Tested with GHC 7.10 - 9.2. + ### 1.4.3.1 _Andreas Abel, 2022-02-12_ @@ -6,7 +66,7 @@ - Bump upper bounds on `base` and `time`. - Tested with GHC 7.0 - 9.2. -### 1.4.3.0 +## 1.4.3.0 _Herbert Valerio Riedel, 2020-04-09_ diff --git a/MissingH.cabal b/MissingH.cabal --- a/MissingH.cabal +++ b/MissingH.cabal @@ -1,16 +1,22 @@ -cabal-version: 1.12 +cabal-version: 1.24 name: MissingH -version: 1.4.3.1 +version: 1.6.0.3 build-type: Simple license: BSD3 author: John Goerzen copyright: Copyright (c) 2004-2018 John Goerzen -maintainer: Herbert Valerio Riedel +maintainer: Andreas Abel license-file: LICENSE tested-with: - GHC == 9.2.1 + GHC == 9.14.1 + GHC == 9.12.2 + GHC == 9.10.3 + GHC == 9.8.4 + GHC == 9.6.7 + GHC == 9.4.8 + GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 @@ -18,10 +24,6 @@ GHC == 8.4.4 GHC == 8.2.2 GHC == 8.0.2 - GHC == 7.10.3 - GHC == 7.8.4 - GHC == 7.6.3 - GHC == 7.4.2 synopsis: Large utility library description: @@ -29,22 +31,24 @@ programmers. It is written in pure Haskell and thus should be extremely portable and easy to use. category: Unclassified -bug-reports: https://github.com/hvr/missingh/issues +bug-reports: https://github.com/haskell-hvr/missingh/issues -extra-source-files: +extra-doc-files: CHANGES.md LICENSE announcements/0.10.0.txt announcements/0.8.0.txt announcements/0.9.0.txt + 3rd-party-licenses/BSD + 3rd-party-licenses/LGPL-2.1 + +extra-source-files: testsrc/gzfiles/empty.gz testsrc/gzfiles/t1.gz testsrc/gzfiles/t1bad.gz testsrc/gzfiles/t2.gz testsrc/gzfiles/zeros.gz testsrc/mime.types.test - 3rd-party-licenses/BSD - 3rd-party-licenses/LGPL-2.1 examples/simplegrep.hs examples/test2.hs examples/test3.hs @@ -56,7 +60,7 @@ source-repository head type: git - location: https://github.com/hvr/missingh.git + location: https://github.com/haskell-hvr/missingh.git library hs-source-dirs: src @@ -112,8 +116,8 @@ ExistentialQuantification FlexibleContexts FlexibleInstances + LambdaCase MultiParamTypeClasses - OverlappingInstances Rank2Types ScopedTypeVariables UndecidableInstances @@ -125,29 +129,31 @@ build-depends: array >= 0.4.0.0 && < 0.6 - , base >= 4.5.0.0 && < 4.17 - , containers >= 0.4.2.1 && < 0.7 + , base >= 4.9 && < 5 + , containers >= 0.4.2.1 && < 1 , directory >= 1.1.0.2 && < 1.4 - , filepath >= 1.3.0.0 && < 1.5 + , filepath >= 1.3.0.0 && < 1.6 , hslogger >= 1.3.0.0 && < 1.4 - , mtl >= 1.1.1.0 && < 2.3 + , mtl >= 1.1.1.0 && < 2.4 , old-locale == 1.0.* , old-time == 1.1.* , parsec == 3.1.* && (< 3.1.12 || >= 3.1.13) , process >= 1.1.0.1 && < 1.7 , regex-compat >= 0.95.1 && < 0.96 - , time >= 1.4 && < 1.13 + , time >= 1.4 && < 2 if flag(network--GE-3_0_0) build-depends: network-bsd >= 2.8.1 && <2.9, - network >= 3.0 && <3.2 + network >= 3.0 && <3.3 else build-depends: network >= 2.6.3.1 && <2.9 - If !os(windows) - Build-Depends: unix >= 2.5.1.0 && < 2.8 + if !os(windows) + build-depends: unix >= 2.5.1.0 && < 2.9 - ghc-options: -fno-warn-deprecations + ghc-options: + -Wall + -Wcompat ---------------------------------------------------------------------------- @@ -194,7 +200,6 @@ , old-time , parsec , regex-compat - , time if !os(windows) build-depends: unix @@ -203,9 +208,6 @@ build-depends: HUnit == 1.6.* - if impl(ghc < 7.8) - -- really, we would like to test for base < 4.7 - build-depends: - errorcall-eq-instance == 0.3.* - - ghc-options: -fno-warn-deprecations + ghc-options: + -Wall + -Wcompat diff --git a/examples/test3.hs b/examples/test3.hs --- a/examples/test3.hs +++ b/examples/test3.hs @@ -7,11 +7,11 @@ import MissingH.Str import System.Time -realhandler h = +realhandler h = let loop = do e <- hIsEOF h if e then return () else do c <- hGetLine h - case (rstrip c) of + case (rstrip c) of "QUIT" -> hPutStr h "Goodbye!\n" "COMMANDS" -> do hPutStrLn h "You can type TIME for the current time" loop diff --git a/src/Control/Concurrent/Thread/Utils.hs b/src/Control/Concurrent/Thread/Utils.hs --- a/src/Control/Concurrent/Thread/Utils.hs +++ b/src/Control/Concurrent/Thread/Utils.hs @@ -25,7 +25,7 @@ ) where -import Control.Concurrent +import safe Control.Concurrent ( forkIO, ThreadId ) {- | Takes a IO action and a function. The IO action will be called in a separate thread. When it is completed, the specified function is called with diff --git a/src/Data/BinPacking.hs b/src/Data/BinPacking.hs --- a/src/Data/BinPacking.hs +++ b/src/Data/BinPacking.hs @@ -36,9 +36,9 @@ ) where -import Data.List -import Control.Monad.Error +import Data.List (sortOn) + {- | Potential errors returned as Left values by 'BinPacker' functions. Calling 'show' on this value will produce a nice error message suitable for display. -} @@ -55,10 +55,6 @@ ++ " at " ++ show obj show (BPOther x) = x -{- | Let us use this as part of the Either monad -} -instance (Num size, Ord size, Show size, Show obj) => Error (BinPackerError size obj) where - strMsg = BPOther - {- | The primary type for bin-packing functions. These functions take a list of size of bins. If every bin is the same size, @@ -99,8 +95,7 @@ be found to put in the bin. This is substantially more efficient than 'packByOrder', but requires sorting the input. -} packLargeFirst :: BinPacker -packLargeFirst bins sizes = packLargeFirst' bins (sortBy fstSort sizes) - where fstSort a b = compare (fst a) (fst b) +packLargeFirst bins sizes = packLargeFirst' bins (sortOn fst sizes) packLargeFirst' :: BinPacker packLargeFirst' _ [] = Right [] -- Ran out of sizes diff --git a/src/Data/Bits/Utils.hs b/src/Data/Bits/Utils.hs --- a/src/Data/Bits/Utils.hs +++ b/src/Data/Bits/Utils.hs @@ -23,8 +23,9 @@ module Data.Bits.Utils(getBytes, fromBytes, c2w8, s2w8, w82c, w82s) where -import Data.Bits -import Data.Word +import safe Data.Bits + ( Bits((.|.), (.&.), shiftR, bitSizeMaybe, shiftL) ) +import safe Data.Word ( Word8 ) {- | Returns a list representing the bytes that comprise a data type. @@ -33,13 +34,13 @@ > getBytes (0x12345678::Int) -> [0x12, 0x34, 0x56, 0x78] -} getBytes :: (Integral a, Bounded a, Bits a) => a -> [a] -getBytes input = - let getByte _ 0 = [] - getByte x remaining = (x .&. 0xff) : getByte (shiftR x 8) (remaining - 1) - in - if (bitSize input `mod` 8) /= 0 - then error "Input data bit size must be a multiple of 8" - else reverse $ getByte input (bitSize input `div` 8) +getBytes input + | Just size <- bitSizeMaybe input, size `mod` 8 == 0 = + reverse $ getByte input $ size `div` 8 + | otherwise = error "Input data bit size must be a multiple of 8" + where + getByte _ 0 = [] + getByte x remaining = (x .&. 0xff) : getByte (shiftR x 8) (remaining - 1) {- | The opposite of 'getBytes', this function builds a number based on its component bytes. diff --git a/src/Data/CSV.hs b/src/Data/CSV.hs --- a/src/Data/CSV.hs +++ b/src/Data/CSV.hs @@ -21,7 +21,18 @@ -} module Data.CSV (csvFile, genCsvFile) where -import Text.ParserCombinators.Parsec +import safe Text.ParserCombinators.Parsec + ( char, + noneOf, + string, + endBy, + sepBy, + (), + (<|>), + many, + try, + GenParser, + CharParser ) import Data.List (intersperse) eol :: forall st. GenParser Char st String @@ -33,13 +44,13 @@ quotedchar :: GenParser Char st Char quotedchar = noneOf "\"" - <|> (try $ do string "\"\"" + <|> (try $ do _ <- string "\"\"" return '"' ) quotedcell :: CharParser st String -quotedcell = do char '"' +quotedcell = do _ <- char '"' content <- many quotedchar - char '"' + _ <- char '"' return content line :: GenParser Char st [String] diff --git a/src/Data/Compression/Inflate.hs b/src/Data/Compression/Inflate.hs --- a/src/Data/Compression/Inflate.hs +++ b/src/Data/Compression/Inflate.hs @@ -32,15 +32,16 @@ inflate, Output, Bit, bits_to_word32) where -import Control.Applicative -import Control.Monad -import Data.Array +import safe Control.Monad ( ap, unless ) +import safe Data.Array ( Array, array, (!), (//) ) import qualified Data.Char import Data.List -import Data.Maybe + ( mapAccumL, genericDrop, genericReplicate, genericSplitAt, genericTake + , sort ) +import safe Data.Maybe () -import Data.Bits -import Data.Word +import safe Data.Bits ( Bits(testBit) ) +import safe Data.Word ( Word8, Word32 ) inflate_string :: String -> String inflate_string = fst . inflate_string_remainder @@ -122,10 +123,10 @@ InfM y = f x in y s' -- return :: a -> InfM a - return x = InfM $ \s -> (x, s) + return = pure instance Applicative InfM where - pure = return + pure x = InfM $ \s -> (x, s) (<*>) = ap instance Functor InfM where diff --git a/src/Data/Either/Utils.hs b/src/Data/Either/Utils.hs --- a/src/Data/Either/Utils.hs +++ b/src/Data/Either/Utils.hs @@ -26,7 +26,8 @@ eitherToMonadError, fromLeft, fromRight, fromEither ) where -import Control.Monad.Error + +import Control.Monad.Except ( MonadError(..) ) {- | Converts a Maybe value to an Either value, using the supplied parameter as the Left value if the Maybe is Nothing. diff --git a/src/Data/Hash/CRC32/GZip.hs b/src/Data/Hash/CRC32/GZip.hs --- a/src/Data/Hash/CRC32/GZip.hs +++ b/src/Data/Hash/CRC32/GZip.hs @@ -23,11 +23,10 @@ module Data.Hash.CRC32.GZip where -import Data.Array -import Data.Bits -import Data.Char -import Data.List -import Data.Word +import safe Data.Array ( Array, array, (!) ) +import safe Data.Bits ( Bits(xor, (.&.), shiftR) ) +import safe Data.Char ( ord ) +import safe Data.Word ( Word32 ) update_crc :: Word32 -> Char -> Word32 update_crc crc ch = diff --git a/src/Data/Hash/MD5.hs b/src/Data/Hash/MD5.hs --- a/src/Data/Hash/MD5.hs +++ b/src/Data/Hash/MD5.hs @@ -28,9 +28,9 @@ , WordList(..) ) where -import Data.Bits -import Data.Char (chr, ord) -import Data.Word +import safe Data.Bits (Bits (complement, rotateL, shiftL, shiftR, xor, (.&.), (.|.))) +import safe Data.Char (chr, ord) +import safe Data.Word (Word32, Word64) -- | Synonym for 'Word64' due to historic reasons type Zord64 = Word64 diff --git a/src/Data/Hash/MD5/Zord64_HARD.hs b/src/Data/Hash/MD5/Zord64_HARD.hs --- a/src/Data/Hash/MD5/Zord64_HARD.hs +++ b/src/Data/Hash/MD5/Zord64_HARD.hs @@ -2,16 +2,20 @@ {-# OPTIONS_HADDOCK hide #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | Obsolete legacy module module Data.Hash.MD5.Zord64_HARD (Zord64) where -import Data.Bits -import Data.Word +import safe Data.Bits ( Bits(complement, (.&.), (.|.), shift) ) +import safe Data.Word ( Word32 ) data Zord64 = W64 {lo,hi::Word32} deriving (Eq, Ord, Bounded) +w64ToInteger :: Zord64 -> Integer w64ToInteger W64{lo=lo,hi=hi} = toInteger lo + 0x100000000 * toInteger hi + +integerToW64 :: Integer -> Zord64 integerToW64 x = case x `quotRem` 0x100000000 of (h,l) -> W64{lo=fromInteger l, hi=fromInteger h} @@ -35,14 +39,15 @@ W64{lo=lo_a,hi=hi_a} .|. W64{lo=lo_b,hi=hi_b} = W64{lo=lo', hi=hi'} where lo' = lo_a .|. lo_b hi' = hi_a .|. hi_b - shift w 0 = w - shift W64{lo=lo,hi=hi} x + shift w@W64{lo=lo,hi=hi} x + | x == 0 = w | x > 63 = W64{lo=0,hi=0} | x > 31 = W64{lo = 0, hi = shift lo (x-32)} | x > 0 = W64{lo = shift lo x, hi = shift hi x .|. shift lo (x-32)} | x < -63 = W64{lo=0,hi=0} | x < -31 = W64{lo = shift hi (x+32), hi = 0} | x < 0 = W64{lo = shift lo x .|. shift hi (x+32), hi = shift hi x} + | otherwise = error "impossible" complement W64{lo=lo,hi=hi} = W64{lo=complement lo,hi=complement hi} instance Integral Zord64 where diff --git a/src/Data/List/Utils.hs b/src/Data/List/Utils.hs --- a/src/Data/List/Utils.hs +++ b/src/Data/List/Utils.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Safe #-} + {- arch-tag: List utilities main file Copyright (c) 2004-2011 John Goerzen @@ -48,13 +49,11 @@ -- -- * Sub-List Selection -- sub, ) where + import Control.Monad.State (State, get, put) -import Data.List (concat, elemIndex, elemIndices, - elemIndices, find, findIndex, - intercalate, intersperse, +import Data.List (elemIndices, findIndex, intercalate, isInfixOf, isPrefixOf, isSuffixOf, nub, tails) -import Data.Maybe (isJust) {- | Merge two sorted lists into a single, sorted whole. @@ -83,8 +82,8 @@ cmp (x1,_) (x2,_) = compare x1 x2 -} mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] -mergeBy cmp [] ys = ys -mergeBy cmp xs [] = xs +mergeBy _ [] ys = ys +mergeBy _ xs [] = xs mergeBy cmp (allx@(x:xs)) (ally@(y:ys)) -- Ordering derives Eq, Ord, so the comparison below is valid. -- Explanation left as an exercise for the reader. @@ -137,7 +136,7 @@ The function is given the remainder of the list to examine. -} dropWhileList :: ([a] -> Bool) -> [a] -> [a] dropWhileList _ [] = [] -dropWhileList func list@(x:xs) = +dropWhileList func list@(_:xs) = if func list then dropWhileList func xs else list @@ -335,7 +334,7 @@ {- | Forces the evaluation of the entire list. -} seqList :: [a] -> [a] seqList [] = [] -seqList list@(x:xs) = seq (seqList xs) list +seqList list@(_:xs) = seq (seqList xs) list -------------------------------------------------- -- Advanced Conversions @@ -399,8 +398,8 @@ > --> ["Hello",", T","his is"," ","a test."] -} fixedWidth :: [Int] -> WholeFunc a [a] -fixedWidth len = - WholeFunc (fixedWidthFunc len) +fixedWidth = + WholeFunc . fixedWidthFunc where -- Empty input: Empty output, stop fixedWidthFunc _ [] = ((fixedWidth []), [], []) -- Empty length: Stop here. diff --git a/src/Data/MIME/Types.hs b/src/Data/MIME/Types.hs --- a/src/Data/MIME/Types.hs +++ b/src/Data/MIME/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE Safe #-} - {- arch-tag: MIME Types main file Copyright (c) 2004-2011 John Goerzen @@ -37,13 +35,14 @@ import qualified Data.Map as Map import qualified Control.Exception (try, IOException) -import Control.Monad +import Control.Monad ( foldM ) import System.IO -import System.IO.Error -import System.IO.Utils -import System.Path -import Data.Map.Utils -import Data.Char + ( Handle, hClose, openFile, IOMode(ReadMode) ) +import System.IO.Error () +import System.IO.Utils ( hGetLines ) +import System.Path ( splitExt ) +import Data.Map.Utils ( flippedLookupM ) +import Data.Char ( toLower ) ---------------------------------------------------------------------- -- Basic type declarations @@ -92,8 +91,9 @@ -> Bool -- ^ Whether to work on strict data -> Handle -- ^ Handle to read from -> IO MIMETypeData -- ^ New object -hReadMIMETypes mtd strict h = - let parseline :: MIMETypeData -> String -> MIMETypeData +hReadMIMETypes mtd strict h = foldl parseline mtd <$> hGetLines h + where + parseline :: MIMETypeData -> String -> MIMETypeData parseline obj line = let l1 = words line procwords [] = [] @@ -107,10 +107,6 @@ in foldl (\o suff -> addType o strict thetype ('.' : suff)) obj suffixlist else obj - in - do - lines <- hGetLines h - return (foldl parseline mtd lines) {- | Guess the type of a file given a filename or URL. The file is not opened; only the name is considered. -} diff --git a/src/Data/Maybe/Utils.hs b/src/Data/Maybe/Utils.hs --- a/src/Data/Maybe/Utils.hs +++ b/src/Data/Maybe/Utils.hs @@ -15,7 +15,7 @@ Stability : stable Portability: portable -Utilities for working with the Either data type +Utilities for working with the 'Maybe' data type. -} module Data.Maybe.Utils @@ -23,13 +23,16 @@ forceMaybe, forceMaybeMsg ) where -{- | Pulls a Just value out of a Maybe value. If the Maybe value is -Nothing, raises an exception with error. -} +import Data.Maybe (fromJust) + +{- | Pulls a 'Just' value out of a 'Maybe' value. If the 'Maybe' value is +'Nothing', raises an exception with error. + +Alias of 'Data.Maybe.fromJust'. -} forceMaybe :: Maybe a -> a -forceMaybe = forceMaybeMsg "forceMaybe: Got Nothing" +forceMaybe = fromJust {- | Like 'forceMaybe', but lets you customize the error message raised if -Nothing is supplied. -} +'Nothing' is supplied. -} forceMaybeMsg :: String -> Maybe a -> a -forceMaybeMsg msg Nothing = error msg -forceMaybeMsg _ (Just x) = x +forceMaybeMsg msg = maybe (error msg) id diff --git a/src/Data/Progress/Meter.hs b/src/Data/Progress/Meter.hs --- a/src/Data/Progress/Meter.hs +++ b/src/Data/Progress/Meter.hs @@ -40,13 +40,27 @@ killAutoDisplayMeter ) where -import Data.Progress.Tracker -import Control.Concurrent +import safe Data.Progress.Tracker + ( ProgressStatuses(..), + Progress, + ProgressStatus(totalUnits, completedUnits, trackerName), + getSpeed, + getETR ) +import safe Control.Concurrent + ( modifyMVar_, + withMVar, + newMVar, + MVar, + threadDelay, + forkIO, + myThreadId, + yield, + ThreadId ) import Control.Monad (when) import Data.String.Utils (join) import System.Time.Utils (renderSecs) import Data.Quantity (renderNums, binaryOpts) -import System.IO +import safe System.IO ( Handle, hFlush, hPutStr ) import Control.Monad (filterM) {- | The main data type for the progress meter. -} diff --git a/src/Data/Progress/Tracker.hs b/src/Data/Progress/Tracker.hs --- a/src/Data/Progress/Tracker.hs +++ b/src/Data/Progress/Tracker.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Safe #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {- Copyright (c) 2006-2011 John Goerzen @@ -47,10 +48,11 @@ ) where -import Control.Concurrent.MVar -import System.Time -import System.Time.Utils -import Data.Ratio +import safe Control.Concurrent.MVar + ( modifyMVar_, withMVar, newMVar, MVar ) +import safe System.Time ( getClockTime ) +import safe System.Time.Utils ( clockTimeToEpoch ) +import safe Data.Ratio ( (%) ) {- $introduction @@ -139,20 +141,8 @@ to the function. -} withStatus :: a -> (ProgressStatus -> b) -> b -class ProgressRecords a b where - withRecord :: a -> (ProgressRecord -> b) -> b - -{- -instance ProgressStatuses ProgressRecord b where - withStatus x func = func (status x) -instance ProgressRecords ProgressRecord b where - withRecord x func = func x --} - instance ProgressStatuses Progress (IO b) where withStatus (Progress x) func = withMVar x (\y -> func (status y)) -instance ProgressRecords Progress (IO b) where - withRecord (Progress x) func = withMVar x func instance ProgressStatuses ProgressStatus b where withStatus x func = func x @@ -367,9 +357,6 @@ -} defaultTimeSource :: ProgressTimeSource defaultTimeSource = getClockTime >>= (return . clockTimeToEpoch) - -now :: ProgressRecords a ProgressTimeSource => a -> ProgressTimeSource -now x = withRecord x (timeSource . status) modStatus :: Progress -> (ProgressStatus -> ProgressStatus) -> IO () -- FIXME/TODO: handle parents diff --git a/src/Data/Quantity.hs b/src/Data/Quantity.hs --- a/src/Data/Quantity.hs +++ b/src/Data/Quantity.hs @@ -1,4 +1,6 @@ {-# LANGUAGE Safe #-} + +{-# OPTIONS_GHC -fno-warn-type-defaults #-} {- Copyright (c) 2006-2011 John Goerzen @@ -32,9 +34,9 @@ ) where -import Data.Char -import Data.List -import Text.Printf +import safe Data.Char ( toLower ) +import safe Data.List (find) +import safe Text.Printf ( printf ) {- | The options for 'quantifyNum' and 'renderNum' -} data SizeOpts = SizeOpts { base :: Int, -- ^ The base from which calculations are made diff --git a/src/Data/String/Utils.hs b/src/Data/String/Utils.hs --- a/src/Data/String/Utils.hs +++ b/src/Data/String/Utils.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {- arch-tag: String utilities main file Copyright (c) 2004-2011 John Goerzen diff --git a/src/Data/Tuple/Utils.hs b/src/Data/Tuple/Utils.hs --- a/src/Data/Tuple/Utils.hs +++ b/src/Data/Tuple/Utils.hs @@ -4,7 +4,7 @@ All rights reserved. -For license and copyright information, see the file LICENSE +For license and copyright information, see the file LICENSE. -} {- | @@ -17,7 +17,7 @@ This module provides various helpful utilities for dealing with tuples. -Written by Neil Mitchell, +Written by Neil Mitchell. -} module Data.Tuple.Utils( @@ -41,12 +41,12 @@ -- | Take the first item out of a 3 element tuple fst3 :: (a,b,c) -> a -fst3 (a,b,c) = a +fst3 (a,_,_) = a -- | Take the second item out of a 3 element tuple snd3 :: (a,b,c) -> b -snd3 (a,b,c) = b +snd3 (_,b,_) = b -- | Take the third item out of a 3 element tuple thd3 :: (a,b,c) -> c -thd3 (a,b,c) = c +thd3 (_,_,c) = c diff --git a/src/Network/Email/Mailbox.hs b/src/Network/Email/Mailbox.hs --- a/src/Network/Email/Mailbox.hs +++ b/src/Network/Email/Mailbox.hs @@ -69,7 +69,7 @@ map (\(i, f, _) -> (i, f)) getMessages mb list = do messages <- getAll mb - return $ filter (\(id, f, m) -> id `elem` list) messages + return $ filter (\(x, _, _) -> x `elem` list) messages class (MailboxReader a b) => MailboxWriter a b where appendMessages :: a -> [(Flags, Message)] -> IO [b] diff --git a/src/Network/Email/Sendmail.hs b/src/Network/Email/Sendmail.hs --- a/src/Network/Email/Sendmail.hs +++ b/src/Network/Email/Sendmail.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} {- arch-tag: Sendmail utility Copyright (c) 2004-2011 John Goerzen @@ -31,10 +30,11 @@ module Network.Email.Sendmail(sendmail) where -import System.Cmd.Utils +import System.Cmd.Utils ( PipeMode(WriteToPipe), pOpen ) import System.Directory -import System.IO -import System.IO.Error + ( doesFileExist, getPermissions, Permissions(executable) ) +import System.IO ( hPutStr ) +import System.IO.Error () import qualified Control.Exception(try, IOException) sendmails :: [String] diff --git a/src/Network/SocketServer.hs b/src/Network/SocketServer.hs --- a/src/Network/SocketServer.hs +++ b/src/Network/SocketServer.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Trustworthy #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {- arch-tag: Generic Server Support Copyright (c) 2004-2011 John Goerzen @@ -45,11 +46,30 @@ handleHandler ) where -import Control.Concurrent -import Network.BSD -import Network.Socket -import Network.Utils -import System.IO +import Control.Concurrent ( forkIO ) +import Data.Functor (void) +import Network.BSD + ( getProtocolNumber, Family(AF_INET), HostAddress, PortNumber ) +import Network.Socket + ( socketToHandle, + setSocketOption, + accept, + bind, + getSocketName, + listen, + socket, + close, + SocketOption(ReuseAddr), + SockAddr(SockAddrInet), + Socket, + SocketType(Stream) ) +import Network.Utils ( showSockAddr ) +import System.IO + ( Handle, + hClose, + hSetBuffering, + BufferMode(LineBuffering), + IOMode(ReadWriteMode) ) import qualified System.Log.Logger {- | Options for your server. -} @@ -111,11 +131,10 @@ {- | Handle one incoming request from the given 'SocketServer'. -} handleOne :: SocketServer -> HandlerT -> IO () -handleOne ss func = - let opts = (optionsSS ss) - in do a <- accept (sockSS ss) - localaddr <- getSocketName (fst a) - func (fst a) (snd a) localaddr +handleOne ss func = do + a <- accept (sockSS ss) + localaddr <- getSocketName (fst a) + func (fst a) (snd a) localaddr {- | Handle all incoming requests from the given 'SocketServer'. -} serveForever :: SocketServer -> HandlerT -> IO () @@ -168,9 +187,8 @@ -- make the server multi-tasking. threadedHandler :: HandlerT -- ^ Handler to call in the new thread -> HandlerT -- ^ Resulting handler -threadedHandler nexth socket r_sockaddr l_sockaddr= - do forkIO (nexth socket r_sockaddr l_sockaddr) - return () +threadedHandler nexth socket r_sockaddr l_sockaddr = void $ + forkIO (nexth socket r_sockaddr l_sockaddr) {- | Give your handler function a Handle instead of a Socket. diff --git a/src/Network/Utils.hs b/src/Network/Utils.hs --- a/src/Network/Utils.hs +++ b/src/Network/Utils.hs @@ -26,9 +26,25 @@ listenTCPAddr, showSockAddr) where -import Network.BSD -import Network.Socket -import System.IO +import Network.BSD + ( getHostByName, + getProtocolNumber, + hostAddress, + HostName, + Family(AF_INET), + PortNumber ) +import Network.Socket + ( getNameInfo, + withSocketsDo, + bind, + connect, + listen, + socket, + close, + NameInfoFlag(NI_NUMERICHOST), + SockAddr(..), + Socket, + SocketType(Stream) ) #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) import qualified System.Posix.Signals #endif @@ -49,7 +65,7 @@ niceSocketsDo func = do #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -- No signals on Windows anyway - System.Posix.Signals.installHandler + _ <- System.Posix.Signals.installHandler System.Posix.Signals.sigPIPE System.Posix.Signals.Ignore Nothing @@ -79,6 +95,6 @@ #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) showSockAddr (SockAddrUnix x) = return $ "UNIX socket at " ++ x #endif -showSockAddr sa@(SockAddrInet port host) = +showSockAddr sa@(SockAddrInet port _host) = do (Just h,_) <- getNameInfo [NI_NUMERICHOST] True False sa return $ "IPv4 host " ++ h ++ ", port " ++ (show port) diff --git a/src/System/Cmd/Utils.hs b/src/System/Cmd/Utils.hs --- a/src/System/Cmd/Utils.hs +++ b/src/System/Cmd/Utils.hs @@ -22,8 +22,6 @@ Written by John Goerzen, jgoerzen\@complete.org -Please note: Most of this module is not compatible with Hugs. - Command lines executed will be logged using "System.Log.Logger" at the DEBUG level. Failure messages will be logged at the WARNING level in addition to being raised as an exception. Both are logged under @@ -95,18 +93,36 @@ -- FIXME - largely obsoleted by 6.4 - convert to wrappers. -import System.Exit +import System.Exit ( ExitCode(ExitFailure, ExitSuccess) ) +import System.Log.Logger ( debugM, warningM ) +#if (defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) import System.Process (rawSystem) -import System.Log.Logger -#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) +#else import System.Posix.IO + ( closeFd, + createPipe, + dupTo, + fdToHandle, + stdError, + stdInput, + stdOutput ) import System.Posix.Process + ( executeFile, forkProcess, getProcessStatus, ProcessStatus(..) ) import System.Posix.Signals -import qualified System.Posix.Signals + ( addSignal, + blockSignals, + emptySignalSet, + getSignalMask, + installHandler, + setSignalMask, + sigCHLD, + sigINT, + sigQUIT, + Handler(Ignore), + Signal ) #endif -import System.Posix.Types -import System.IO -import System.IO.Error +import System.Posix.Types ( Fd, ProcessID ) +import System.IO ( Handle, hClose, hGetContents, hPutStr ) import Control.Concurrent(forkIO) import Control.Exception(finally) import qualified Control.Exception(try, IOException) @@ -154,7 +170,6 @@ fail m #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Read data from a pipe. Returns a Handle and a 'PipeHandle'. When done, you must hClose the handle, and then use either 'forceSuccess' or @@ -162,13 +177,13 @@ This function logs as pipeFrom. -Not available on Windows or with Hugs. +Not available on Windows. -} hPipeFrom :: FilePath -> [String] -> IO (PipeHandle, Handle) hPipeFrom fp args = do pipepair <- createPipe logRunning "pipeFrom" fp args - let childstuff = do dupTo (snd pipepair) stdOutput + let childstuff = do _ <- dupTo (snd pipepair) stdOutput closeFd (fst pipepair) executeFile fp True args Nothing p <- Control.Exception.try (forkProcess childstuff) @@ -181,10 +196,8 @@ h <- fdToHandle (fst pipepair) return (PipeHandle pid fp args "pipeFrom", h) #endif -#endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Read data from a pipe. Returns a lazy string and a 'PipeHandle'. ONLY AFTER the string has been read completely, You must call either @@ -199,10 +212,8 @@ c <- hGetContents h return (pid, c) #endif -#endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Write data to a pipe. Returns a 'PipeHandle' and a new Handle to write to. @@ -217,7 +228,7 @@ hPipeTo fp args = do pipepair <- createPipe logRunning "pipeTo" fp args - let childstuff = do dupTo (fst pipepair) stdInput + let childstuff = do _ <- dupTo (fst pipepair) stdInput closeFd (snd pipepair) executeFile fp True args Nothing p <- Control.Exception.try (forkProcess childstuff) @@ -230,10 +241,8 @@ h <- fdToHandle (snd pipepair) return (PipeHandle pid fp args "pipeTo", h) #endif -#endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Write data to a pipe. Returns a ProcessID. You must call either @@ -249,10 +258,8 @@ (hClose h) return pid #endif -#endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Like a combination of 'hPipeTo' and 'hPipeFrom'; returns a 3-tuple of ('PipeHandle', Data From Pipe, Data To Pipe). @@ -271,9 +278,9 @@ do frompair <- createPipe topair <- createPipe logRunning "pipeBoth" fp args - let childstuff = do dupTo (snd frompair) stdOutput + let childstuff = do _ <- dupTo (snd frompair) stdOutput closeFd (fst frompair) - dupTo (fst topair) stdInput + _ <- dupTo (fst topair) stdInput closeFd (snd topair) executeFile fp True args Nothing p <- Control.Exception.try (forkProcess childstuff) @@ -288,10 +295,8 @@ toh <- fdToHandle (snd topair) return (PipeHandle pid fp args "pipeBoth", fromh, toh) #endif -#endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Like a combination of 'pipeTo' and 'pipeFrom'; forks an IO thread to send data to the piped program, and simultaneously returns its output stream. @@ -302,12 +307,10 @@ pipeBoth :: FilePath -> [String] -> String -> IO (PipeHandle, String) pipeBoth fp args message = do (pid, fromh, toh) <- hPipeBoth fp args - forkIO $ finally (hPutStr toh message) - (hClose toh) + _ <- forkIO $ finally (hPutStr toh message) (hClose toh) c <- hGetContents fromh return (pid, c) #endif -#endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) {- | Uses 'System.Posix.Process.getProcessStatus' to obtain the exit status @@ -346,7 +349,7 @@ safeSystem command args = do debugM (logbase ++ ".safeSystem") ("Running: " ++ command ++ " " ++ (show args)) -#if defined(__HUGS__) || defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__) +#if defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__) ec <- rawSystem command args case ec of ExitSuccess -> return () @@ -365,7 +368,6 @@ #endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Invokes the specified command in a subprocess, waiting for the result. Return the result status. Never raises an exception. Only available on POSIX platforms. @@ -399,15 +401,13 @@ do restoresignals oldint oldquit oldset executeFile program True args Nothing restoresignals oldint oldquit oldset = - do installHandler sigINT oldint Nothing - installHandler sigQUIT oldquit Nothing + do _ <- installHandler sigINT oldint Nothing + _ <- installHandler sigQUIT oldquit Nothing setSignalMask oldset #endif -#endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Invokes the specified command in a subprocess, without waiting for the result. Returns the PID of the subprocess -- it is YOUR responsibility to use getProcessStatus or getAnyProcessStatus on that at some point. Failure @@ -425,7 +425,6 @@ childaction = executeFile program True args Nothing #endif -#endif cmdfailed :: String -> FilePath -> [String] -> Int -> IO a cmdfailed funcname command args failcode = do @@ -436,7 +435,6 @@ ioError e #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ cmdsignalled :: String -> FilePath -> [String] -> Signal -> IO a cmdsignalled funcname command args failcode = do let errormsg = "Command " ++ command ++ " " ++ (show args) ++ @@ -445,10 +443,8 @@ warningM (logbase ++ "." ++ funcname) errormsg ioError e #endif -#endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Open a pipe to the specified command. Passes the handle on to the specified function. @@ -485,10 +481,8 @@ pOpen3 (Just (fst pipepair)) Nothing Nothing fp args callfunc (closeFd (snd pipepair)) #endif -#endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Runs a command, redirecting things to pipes. Not available on Windows. @@ -511,10 +505,8 @@ forceSuccess (PipeHandle (seq retval pid) fp args "pOpen3") return rv #endif -#endif #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -#ifndef __HUGS__ {- | Runs a command, redirecting things to pipes. Not available on Windows. @@ -535,7 +527,7 @@ pOpen3Raw pin pout perr fp args childfunc = let mayberedir Nothing _ = return () mayberedir (Just fromfd) tofd = do - dupTo fromfd tofd + _ <- dupTo fromfd tofd closeFd fromfd return () childstuff = do @@ -562,7 +554,6 @@ Left (e :: Control.Exception.IOException) -> fail ("Error in fork: " ++ (show e)) return pid -#endif #endif showCmd :: FilePath -> [String] -> String diff --git a/src/System/Console/GetOpt/Utils.hs b/src/System/Console/GetOpt/Utils.hs --- a/src/System/Console/GetOpt/Utils.hs +++ b/src/System/Console/GetOpt/Utils.hs @@ -27,8 +27,9 @@ stdOptional ) where -import System.Console.GetOpt -import System.Environment +import safe System.Console.GetOpt + ( getOpt, usageInfo, ArgOrder, OptDescr ) +import safe System.Environment ( getArgs ) {- | Simple command line parser -- a basic wrapper around the system's default getOpt. See the System.Console.GetOpt manual for a description of the diff --git a/src/System/Daemon.hs b/src/System/Daemon.hs --- a/src/System/Daemon.hs +++ b/src/System/Daemon.hs @@ -21,15 +21,9 @@ Written by John Goerzen, jgoerzen\@complete.org -Please note: Most of this module is not compatible with Hugs. - Messages from this module are logged under @System.Daemon@. See 'System.Log.Logger' for details. -Based on background -from and -. - This module is not available on Windows. -} @@ -42,11 +36,20 @@ where #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -import System.Directory -import System.Exit -import System.Log.Logger -import System.Posix.IO -import System.Posix.Process +import System.Directory ( setCurrentDirectory ) +import System.Exit ( ExitCode(ExitSuccess) ) +import System.Log.Logger ( traplogging, Priority(ERROR) ) +import System.Posix.IO + ( openFd, + closeFd, + defaultFileFlags, + dupTo, + stdError, + stdInput, + stdOutput, + OpenMode(ReadWrite) ) +import System.Posix.Process + ( createSession, exitImmediately, forkProcess ) trap :: IO a -> IO a @@ -70,20 +73,26 @@ -} detachDaemon :: IO () detachDaemon = trap $ - do forkProcess child1 + do _ <- forkProcess child1 exitImmediately ExitSuccess child1 :: IO () child1 = trap $ - do createSession - forkProcess child2 + do _ <- createSession + _ <- forkProcess child2 exitImmediately ExitSuccess child2 :: IO () child2 = trap $ do setCurrentDirectory "/" mapM_ closeFd [stdInput, stdOutput, stdError] - nullFd <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags + nullFd <- openFd + "/dev/null" + ReadWrite +#if !MIN_VERSION_unix(2,8,0) + Nothing +#endif + defaultFileFlags mapM_ (dupTo nullFd) [stdInput, stdOutput, stdError] closeFd nullFd #endif diff --git a/src/System/Debian.hs b/src/System/Debian.hs --- a/src/System/Debian.hs +++ b/src/System/Debian.hs @@ -27,9 +27,9 @@ ) where -import System.Exit -import System.IO.Unsafe (unsafePerformIO) -import System.Process +import System.Exit ( ExitCode(ExitFailure, ExitSuccess) ) +import System.IO.Unsafe (unsafePerformIO) +import System.Process ( rawSystem ) {- | The type representing the contents of a Debian control file, or any control-like file (such as the output from apt-cache show, etc.) -} diff --git a/src/System/Debian/ControlParser.hs b/src/System/Debian/ControlParser.hs --- a/src/System/Debian/ControlParser.hs +++ b/src/System/Debian/ControlParser.hs @@ -25,41 +25,53 @@ module System.Debian.ControlParser(control, depPart) where -import Data.String.Utils (split) -import Text.ParserCombinators.Parsec +import safe Data.List.Utils ( split ) +import safe Text.ParserCombinators.Parsec + ( char, + noneOf, + oneOf, + string, + many1, + manyTill, + (), + (<|>), + many, + try, + GenParser, + CharParser ) eol, extline :: GenParser Char st String eol = (try (string "\r\n")) <|> string "\n" "EOL" -extline = try (do char ' ' +extline = try (do _ <- char ' ' content <- many (noneOf "\r\n") - eol + _ <- eol return content ) entry :: GenParser Char st (String, String) entry = do key <- many1 (noneOf ":\r\n") - char ':' + _ <- char ':' val <- many (noneOf "\r\n") - eol + _ <- eol exts <- many extline return (key, unlines ([val] ++ exts)) {- | Main parser for the control file -} control :: CharParser a [(String, String)] -control = do many header +control = do _ <- many header retval <- many entry return retval headerPGP, blankLine, header, headerHash :: GenParser Char st () -headerPGP = do string "-----BEGIN PGP" - manyTill (noneOf "\r\n") eol +headerPGP = do _ <- string "-----BEGIN PGP" + _ <- manyTill (noneOf "\r\n") eol return () -blankLine = do many (oneOf " \t") - eol +blankLine = do _ <- many (oneOf " \t") + _ <- eol return () -headerHash = do string "Hash: " - manyTill (noneOf "\r\n") eol +headerHash = do _ <- string "Hash: " + _ <- manyTill (noneOf "\r\n") eol return () header = (try headerPGP) <|> (try blankLine) <|> (try headerHash) @@ -70,20 +82,20 @@ version is (operator, operand) -} depPart :: CharParser a (String, (Maybe (String, String)), [String]) depPart = do packagename <- many1 (noneOf " (") - many (char ' ') - version <- (do char '(' + _ <- many (char ' ') + version <- (do _ <- char '(' op <- many1 (oneOf "<>=") - many (char ' ') + _ <- many (char ' ') vers <- many1 (noneOf ") ") - many (char ' ') - char ')' + _ <- many (char ' ') + _ <- char ')' return $ Just (op, vers) ) <|> return Nothing - many (char ' ') - archs <- (do char '[' + _ <- many (char ' ') + archs <- (do _ <- char '[' t <- many1 (noneOf "]") - many (char ' ') - char ']' + _ <- many (char ' ') + _ <- char ']' return (split " " t) ) <|> return [] return (packagename, version, archs) diff --git a/src/System/FileArchive/GZip.hs b/src/System/FileArchive/GZip.hs --- a/src/System/FileArchive/GZip.hs +++ b/src/System/FileArchive/GZip.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Safe #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {- arch-tag: GZip file support in Haskell Copyright (c) 2004-2011 John Goerzen @@ -38,14 +39,14 @@ ) where -import Control.Monad.Error -import Data.Bits ((.&.)) -import Data.Bits.Utils (fromBytes) -import Data.Char (ord) -import Data.Compression.Inflate (inflate_string_remainder) -import Data.Hash.CRC32.GZip (update_crc) -import Data.Word (Word32) -import System.IO (Handle, hGetContents, hPutStr) +import Control.Monad.Except (MonadError(..)) +import Data.Bits ((.&.)) +import Data.Bits.Utils (fromBytes) +import Data.Char (ord) +import Data.Compression.Inflate (inflate_string_remainder) +import Data.Hash.CRC32.GZip (update_crc) +import Data.Word (Word32) +import System.IO (Handle, hGetContents, hPutStr) data GZipError = CRCError -- ^ CRC-32 check failed | NotGZIPFile -- ^ Couldn't find a GZip header @@ -53,10 +54,6 @@ | UnknownError String -- ^ Other problem arose deriving (Eq, Show) -instance Error GZipError where - noMsg = UnknownError "" - strMsg = UnknownError - -- | First two bytes of file magic :: String magic = "\x1f\x8b" @@ -194,12 +191,12 @@ read_header :: String -> Either GZipError (Header, String) read_header s = let ok = Right "ok" in - do let (mag, rem) = splitAt 2 s - if mag /= magic + do let (mag, rem1) = splitAt 2 s + _ <- if mag /= magic then throwError NotGZIPFile else ok - let (method, rem2) = split1 rem - if (ord(method) /= 8) + let (method, rem2) = split1 rem1 + _ <- if (ord(method) /= 8) then throwError UnknownMethod else ok let (flag_S, rem3) = split1 rem2 diff --git a/src/System/IO/Binary.hs b/src/System/IO/Binary.hs --- a/src/System/IO/Binary.hs +++ b/src/System/IO/Binary.hs @@ -29,21 +29,6 @@ Versions of MissingH prior 0.11.6 lacked the 'BinaryConvertible' class and worked only with Strings and Handles. -Important note: /binary functions are not supported in all Haskell -implementations/. Do not import or use this module unless you know you -are using an implementation that supports them. At this time, here -is the support status: - - * GHC 6.2 and above: yes - - * GHC 6.x, earlier versions: unknown - - * GHC 5.x: no - - * nhc98: no - - * Hugs: partial (maybe complete; needs more testing) - Non-binary functions may be found in "System.IO". See also: "System.IO.BlockIO" @@ -75,11 +60,21 @@ import Foreign.C.String (peekCStringLen, withCString) import Foreign.C.Types (CChar()) import Foreign.ForeignPtr + ( ForeignPtr, mallocForeignPtrArray, withForeignPtr ) import Foreign.Marshal.Array (peekArray, withArray) -import Foreign.Ptr +import Foreign.Ptr ( Ptr, castPtr ) import System.IO + ( stdout, + hClose, + openBinaryFile, + stdin, + IOMode(WriteMode, ReadMode) ) import System.IO.HVFS + ( SystemFS(SystemFS), + HVFSOpenable(vOpenBinaryFile), + HVFSOpenEncap(HVFSOpenEncap) ) import System.IO.HVIO + ( HVIO(vClose, vGetBuf, vPutBuf, vGetContents, vPutStr) ) import System.IO.Unsafe (unsafeInterleaveIO) {- | Provides support for handling binary blocks with convenient diff --git a/src/System/IO/HVFS.hs b/src/System/IO/HVFS.hs --- a/src/System/IO/HVFS.hs +++ b/src/System/IO/HVFS.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP, TypeSynonymInstances #-} -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeSynonymInstances #-} {- arch-tag: HVFS main file Copyright (c) 2004-2011 John Goerzen @@ -53,13 +53,48 @@ where import qualified Control.Exception (catch, IOException) -import System.IO.HVIO -import System.Time.Utils +import System.IO.HVIO ( HVIO(vGetContents, vPutStr, vClose) ) +import System.Time.Utils ( epochToClockTime ) import System.IO + ( openBinaryFile, openFile, IOMode(ReadMode, WriteMode) ) import System.IO.Error + ( IOErrorType, illegalOperationErrorType, mkIOError ) import System.IO.PlafCompat -import System.Posix.Types -import System.Time + ( DeviceID, + EpochTime, + FileID, + FileMode, + FileOffset, + GroupID, + LinkCount, + UserID, +#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) + createLink, + createSymbolicLink, + getSymbolicLinkStatus, + readSymbolicLink, +#endif + accessTime, + deviceID, + fileGroup, + fileID, + fileMode, + fileOwner, + fileSize, + getFileStatus, + isBlockDevice, + isCharacterDevice, + isDirectory, + isNamedPipe, + isRegularFile, + isSocket, + isSymbolicLink, + linkCount, + modificationTime, + specialDeviceID, + statusChangeTime, + FileStatus ) +import System.Time ( ClockTime(..) ) import qualified System.Directory as D #if MIN_VERSION_directory(1,2,0) @@ -222,7 +257,7 @@ return $ withStat s vIsDirectory ) (\(_ :: Control.Exception.IOException) -> return False) vDoesExist fs fp = - Control.Exception.catch (do s <- vGetSymbolicLinkStatus fs fp + Control.Exception.catch (do _ <- vGetSymbolicLinkStatus fs fp return True ) (\(_ :: Control.Exception.IOException) -> return False) vCreateDirectory fs _ = eh fs "vCreateDirectory" diff --git a/src/System/IO/HVFS/Combinators.hs b/src/System/IO/HVFS/Combinators.hs --- a/src/System/IO/HVFS/Combinators.hs +++ b/src/System/IO/HVFS/Combinators.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} {- arch-tag: HVFS Combinators Copyright (c) 2004-2011 John Goerzen @@ -26,14 +25,18 @@ HVFSChroot, newHVFSChroot) where -import System.IO -import System.IO.Error -import System.IO.HVFS +import System.IO ( IOMode(ReadMode) ) +import System.IO.Error + ( doesNotExistErrorType, permissionErrorType ) +import System.IO.HVFS + ( HVFSOpenable(vOpen), + HVFS(vRemoveFile, vCreateLink, vCreateSymbolicLink, vRenameFile, + vRenameDirectory, vRemoveDirectory, vCreateDirectory, + vGetCurrentDirectory, vGetDirectoryContents, vDoesFileExist, + vGetFileStatus, vGetSymbolicLinkStatus, vGetModificationTime, + vReadSymbolicLink, vRaiseError, vDoesDirectoryExist, + vSetCurrentDirectory) ) import System.IO.HVFS.InstanceHelpers (getFullPath) -#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -import System.Posix.Files - -- so, but I'm not sure... -#endif import System.FilePath (isPathSeparator, pathSeparator, ()) import System.Path (secureAbsNormPath) diff --git a/src/System/IO/HVFS/InstanceHelpers.hs b/src/System/IO/HVFS/InstanceHelpers.hs --- a/src/System/IO/HVFS/InstanceHelpers.hs +++ b/src/System/IO/HVFS/InstanceHelpers.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {- arch-tag: HVFS instance helpers Copyright (c) 2004-2011 John Goerzen @@ -36,11 +37,18 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.List (genericLength) import System.FilePath (isPathSeparator, pathSeparator, ()) -import System.IO +import System.IO ( IOMode(ReadMode) ) import System.IO.Error (doesNotExistErrorType, illegalOperationErrorType, permissionErrorType) -import System.IO.HVFS +import System.IO.HVFS + ( FileOffset, + HVFSOpenable(vOpen), + HVFS(vGetDirectoryContents, vGetFileStatus, vSetCurrentDirectory, + vRaiseError, vGetCurrentDirectory), + HVFSStat(vIsRegularFile, vFileSize, vIsDirectory), + HVFSOpenEncap(HVFSOpenEncap), + HVFSStatEncap(HVFSStatEncap) ) import System.IO.HVIO (newStreamReader) import System.Path (absNormPath) import System.Path.NameManip (slice_path) @@ -113,10 +121,10 @@ -} getFullPath :: HVFS a => a -> String -> IO String getFullPath fs path = - do cwd <- vGetCurrentDirectory fs - case (absNormPath cwd path) of + do dir <- vGetCurrentDirectory fs + case (absNormPath dir path) of Nothing -> vRaiseError fs doesNotExistErrorType - ("Trouble normalizing path " ++ path) (Just (cwd path)) + ("Trouble normalizing path " ++ path) (Just (dir path)) Just newpath -> return newpath {- | Gets the full path via 'getFullPath', then splits it via 'nice_slice'. @@ -183,8 +191,7 @@ "Bad internal error" (Just fp) Just y -> writeIORef (cwd x) y vGetFileStatus x fp = - do elem <- getMelem x fp - case elem of + getMelem x fp >>= \case (MemoryFile y) -> return $ HVFSStatEncap $ SimpleStat {isFile = True, fileSize = (genericLength y)} @@ -192,8 +199,7 @@ SimpleStat {isFile = False, fileSize = 0} vGetDirectoryContents x fp = - do elem <- getMelem x fp - case elem of + getMelem x fp >>= \case MemoryFile _ -> vRaiseError x doesNotExistErrorType "Can't list contents of a file" (Just fp) @@ -201,8 +207,7 @@ instance HVFSOpenable MemoryVFS where vOpen x fp (ReadMode) = - do elem <- getMelem x fp - case elem of + getMelem x fp >>= \case MemoryDirectory _ -> vRaiseError x doesNotExistErrorType "Can't open a directory" (Just fp) diff --git a/src/System/IO/HVFS/Utils.hs b/src/System/IO/HVFS/Utils.hs --- a/src/System/IO/HVFS/Utils.hs +++ b/src/System/IO/HVFS/Utils.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Trustworthy #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {- arch-tag: HVFS utilities main file Copyright (c) 2004-2011 John Goerzen @@ -33,14 +34,34 @@ ) where -import System.FilePath (pathSeparator, ()) -import System.IO.HVFS -import System.IO.PlafCompat -import System.IO.Unsafe (unsafeInterleaveIO) -import System.Locale -import System.Time -import System.Time.Utils -import Text.Printf +import System.FilePath (pathSeparator, ()) +import System.IO.HVFS + ( SystemFS(..), + HVFS(vGetSymbolicLinkStatus, vRemoveDirectory, vRemoveFile, + vReadSymbolicLink, vGetDirectoryContents), + HVFSStat(vFileSize, vIsDirectory, vIsBlockDevice, + vIsCharacterDevice, vIsSocket, vIsNamedPipe, vModificationTime, + vIsSymbolicLink, vFileMode, vFileOwner, vFileGroup), + HVFSStatEncap(..), + withStat ) +import System.IO.PlafCompat + ( groupExecuteMode, + groupReadMode, + groupWriteMode, + intersectFileModes, + otherExecuteMode, + otherReadMode, + otherWriteMode, + ownerExecuteMode, + ownerReadMode, + ownerWriteMode, + setGroupIDMode, + setUserIDMode ) +import System.IO.Unsafe (unsafeInterleaveIO) +import System.Locale ( defaultTimeLocale ) +import System.Time ( formatCalendarTime, toCalendarTime ) +import System.Time.Utils ( epochToClockTime ) +import Text.Printf ( printf ) {- | Obtain a recursive listing of all files\/directories beneath the specified directory. The traversal is depth-first @@ -83,8 +104,8 @@ child files\/directories. -} recursiveRemove :: HVFS a => a -> FilePath -> IO () -recursiveRemove h fn = - recurseDirStat h fn >>= (mapM_ $ +recursiveRemove h path = + recurseDirStat h path >>= (mapM_ $ \(fn, fs) -> if withStat fs vIsDirectory then vRemoveDirectory h fn else vRemoveFile h fn diff --git a/src/System/IO/HVIO.hs b/src/System/IO/HVIO.hs --- a/src/System/IO/HVIO.hs +++ b/src/System/IO/HVIO.hs @@ -120,14 +120,46 @@ ) where -import Control.Concurrent.MVar -import qualified Control.Exception (IOException, catch) -import Data.IORef -import Foreign.C -import Foreign.Ptr -import Foreign.Storable -import System.IO -import System.IO.Error +import safe Control.Concurrent.MVar + ( newEmptyMVar, putMVar, readMVar, takeMVar, MVar ) +import qualified Control.Exception (catch) +import safe Data.IORef ( IORef, modifyIORef, newIORef, readIORef ) +import safe Foreign.C ( castCharToCChar, peekCStringLen ) +import safe Foreign.Ptr ( Ptr, castPtr, plusPtr ) +import safe Foreign.Storable ( Storable(poke) ) +import safe System.IO + ( Handle, + hClose, + hFlush, + hGetBuffering, + hIsClosed, + hIsEOF, + hIsOpen, + hIsReadable, + hIsSeekable, + hIsWritable, + hSeek, + hSetBuffering, + hShow, + hTell, + hGetBuf, + hGetChar, + hGetContents, + hGetLine, + hPutBuf, + hPutChar, + hPutStr, + hPutStrLn, + hPrint, + hReady, + SeekMode(..), + BufferMode(NoBuffering) ) +import safe System.IO.Error + ( IOErrorType, + eofErrorType, + illegalOperationErrorType, + isEOFError, + mkIOError ) {- | This is the generic I\/O support class. All objects that are to be used in the HVIO system must provide an instance of 'HVIO'. diff --git a/src/System/IO/PlafCompat.hs b/src/System/IO/PlafCompat.hs --- a/src/System/IO/PlafCompat.hs +++ b/src/System/IO/PlafCompat.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} + {- Platform Compatibility Layer Copyright (c) 2005-2011 John Goerzen diff --git a/src/System/IO/StatCompat.hs b/src/System/IO/StatCompat.hs --- a/src/System/IO/StatCompat.hs +++ b/src/System/IO/StatCompat.hs @@ -21,19 +21,36 @@ -} -module System.IO.StatCompat -where -import System.Posix.Consts -import System.Posix.Types +module System.IO.StatCompat where + +import safe System.Posix.Consts + ( blockSpecialMode, + characterSpecialMode, + namedPipeMode, + regularFileMode, + directoryMode, + fileTypeModes, + socketMode, + symbolicLinkMode ) +import safe System.Posix.Types + ( DeviceID, + EpochTime, + FileID, + FileMode, + FileOffset ) + #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -import System.Posix.Files (intersectFileModes) -#endif -import Data.Bits ((.&.)) +import safe System.Posix.Types ( LinkCount, UserID, GroupID ) +import safe System.Posix.Files ( intersectFileModes ) +#else +import safe Data.Bits ( (.&.) ) -#if (defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) type LinkCount = Int type UserID = Int type GroupID = Int + +intersectFileModes :: FileMode -> FileMode -> FileMode +intersectFileModes m1 m2 = m1 .&. m2 #endif data FileStatusCompat = @@ -62,8 +79,3 @@ isDirectory = sc_helper directoryMode isSymbolicLink = sc_helper symbolicLinkMode isSocket = sc_helper socketMode - -#if (defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -intersectFileModes :: FileMode -> FileMode -> FileMode -intersectFileModes m1 m2 = m1 .&. m2 -#endif diff --git a/src/System/IO/Utils.hs b/src/System/IO/Utils.hs --- a/src/System/IO/Utils.hs +++ b/src/System/IO/Utils.hs @@ -36,8 +36,10 @@ ) where import Data.List (genericLength) -import System.IO -import System.IO.HVIO +import System.IO (BufferMode (BlockBuffering, LineBuffering), + IOMode (ReadMode, WriteMode), hClose, + hSetBuffering, openFile, stdin, stdout) +import System.IO.HVIO (HVIO (vGetContents, vGetLine, vIsEOF, vPutStr, vPutStrLn)) import System.IO.Unsafe (unsafeInterleaveIO) {- | Given a list of strings, output a line containing each item, adding @@ -118,8 +120,8 @@ hLineInteract :: (HVIO a, HVIO b) => a -> b -> ([String] -> [String]) -> IO () hLineInteract finput foutput func = do - lines <- hGetLines finput - hPutStrLns foutput (func lines) + ls <- hGetLines finput + hPutStrLns foutput (func ls) {- | Copies from one handle to another in raw mode (using hGetContents). diff --git a/src/System/IO/WindowsCompat.hs b/src/System/IO/WindowsCompat.hs --- a/src/System/IO/WindowsCompat.hs +++ b/src/System/IO/WindowsCompat.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} + {- Windows compatibility layer Copyright (c) 2005-2011 John Goerzen diff --git a/src/System/Path.hs b/src/System/Path.hs --- a/src/System/Path.hs +++ b/src/System/Path.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} {- arch-tag: Path utilities main file Copyright (C) 2004-2011 John Goerzen @@ -31,21 +30,23 @@ mktmpdir, brackettmpdir, brackettmpdirCWD ) where -import Data.List -import Data.List.Utils +import Data.List.Utils ( startswith, alwaysElemRIndex ) #if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__)) -import System.Directory hiding (createDirectory) -import System.Posix.Directory (createDirectory) -import System.Posix.Files -import System.Posix.Temp +import System.Directory + ( getCurrentDirectory, removeFile, setCurrentDirectory ) +import System.Posix.Directory ( createDirectory ) +import System.Posix.Temp ( mkstemp ) #else -import System.Directory +import System.Directory +import System.IO ( openTempFile ) #endif -import Control.Exception -import System.FilePath (isPathSeparator, pathSeparator, ()) -import System.IO -import System.IO.HVFS.Utils -import System.Path.NameManip +import Control.Exception ( finally ) +import System.FilePath ( pathSeparator ) +import System.IO ( hClose ) +import System.IO.HVFS.Utils + ( SystemFS(SystemFS), recurseDir, recurseDirStat, recursiveRemove ) +import System.Path.NameManip + ( normalise_path, absolute_path_by, guess_dotdot ) {- | Splits a pathname into a tuple representing the root of the name and the extension. The extension is considered to be all characters from the last @@ -76,8 +77,8 @@ -> String -- ^ The path name to make absolute -> Maybe String -- ^ Result absNormPath base thepath = - let abs = absolute_path_by base thepath - in case guess_dotdot (normalise_path abs) of + let path = absolute_path_by base thepath + in case guess_dotdot (normalise_path path) of Just "." -> Just [pathSeparator] x -> x diff --git a/src/System/Path/Glob.hs b/src/System/Path/Glob.hs --- a/src/System/Path/Glob.hs +++ b/src/System/Path/Glob.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE Safe #-} - {- Copyright (c) 2006-2011 John Goerzen @@ -25,12 +23,13 @@ module System.Path.Glob (glob, vGlob) where + import Control.Exception (tryJust) import Data.List (isSuffixOf) import Data.List.Utils (hasAny) -import System.FilePath (isPathSeparator, pathSeparator, - splitFileName, ()) -import System.IO.HVFS +import System.FilePath (pathSeparator, splitFileName, ()) +import System.IO.HVFS (HVFS (vDoesDirectoryExist, vDoesExist, vGetDirectoryContents), + SystemFS (SystemFS)) import System.Path.WildMatch (wildCheckCase) hasWild :: String -> Bool diff --git a/src/System/Path/NameManip.hs b/src/System/Path/NameManip.hs --- a/src/System/Path/NameManip.hs +++ b/src/System/Path/NameManip.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {- | Module : System.Path.NameManip Copyright : Copyright (C) 2004 Volker Wysk @@ -124,8 +125,7 @@ -} slice_filename' :: String -- ^ File name without path -> [String] -- ^ List of components the file name is made up of -slice_filename' filename = - case filename of +slice_filename' = \case ('.':filename') -> case slice_filename'' filename' of [] -> ["."] (t:ts) -> ('.':t) : ts diff --git a/src/System/Path/WildMatch.hs b/src/System/Path/WildMatch.hs --- a/src/System/Path/WildMatch.hs +++ b/src/System/Path/WildMatch.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE Safe #-} {- Copyright (c) 2006-2011 John Goerzen @@ -56,8 +56,8 @@ wildToRegex) where -import Data.String.Utils -import Text.Regex +import Data.String.Utils ( escapeRe ) +import Text.Regex ( matchRegex, mkRegex ) {- | Convert a wildcard to an (uncompiled) regular expression. diff --git a/src/System/Posix/Consts.hs b/src/System/Posix/Consts.hs --- a/src/System/Posix/Consts.hs +++ b/src/System/Posix/Consts.hs @@ -21,7 +21,8 @@ -} module System.Posix.Consts where -import System.Posix.Types + +import safe System.Posix.Types ( FileMode ) blockSpecialMode :: FileMode blockSpecialMode = 0o0060000 diff --git a/src/System/Time/Utils.hs b/src/System/Time/Utils.hs --- a/src/System/Time/Utils.hs +++ b/src/System/Time/Utils.hs @@ -31,8 +31,17 @@ renderSecs, renderTD ) where -import Data.Ratio -import System.Time +import safe Data.Ratio ( (%) ) +import safe System.Time + ( diffClockTimes, + normalizeTimeDiff, + toCalendarTime, + toClockTime, + CalendarTime(..), + ClockTime(..), + Day(Thursday), + Month(January), + TimeDiff(TimeDiff, tdSec, tdMin, tdHour, tdDay, tdMonth, tdYear) ) {- | January 1, 1970, midnight, UTC, represented as a CalendarTime. -} epoch :: CalendarTime @@ -98,7 +107,7 @@ where ratval = toRational x seconds = floor ratval secfrac = floor $ (ratval - (seconds % 1) ) * picosecondfactor - picosecondfactor = 10 ^ 12 + picosecondfactor = 10 ^ (12 :: Integer) {- | Converts a ClockTime to something represented with an arbitrary Real. The result could be treated as a CTime from Foreign.C.Types or EpochTime from diff --git a/src/Text/ParserCombinators/Parsec/Utils.hs b/src/Text/ParserCombinators/Parsec/Utils.hs --- a/src/Text/ParserCombinators/Parsec/Utils.hs +++ b/src/Text/ParserCombinators/Parsec/Utils.hs @@ -29,7 +29,16 @@ notMatching ) where -import Text.ParserCombinators.Parsec +import safe Text.ParserCombinators.Parsec + ( (), + (<|>), + getPosition, + many, + token, + unexpected, + try, + SourcePos, + GenParser ) type GeneralizedToken a = (SourcePos, a) type GeneralizedTokenParser a st b = GenParser (GeneralizedToken a) st b diff --git a/testsrc/GZiptest.hs b/testsrc/GZiptest.hs --- a/testsrc/GZiptest.hs +++ b/testsrc/GZiptest.hs @@ -38,7 +38,7 @@ in map f2 [0..1000] -} -test_inflate = +test_inflate = let f fn exp conv = mf fn exp (conv . snd . forceEither . read_header) in [ f "t1.gz" "Test 1" inflate_string @@ -60,7 +60,7 @@ filename = Nothing, comment = Nothing, mtime = 1102111446, xfl = 2, os = 3} ,f "empty.gz" Header {method = 8, flags = 8, extra = Nothing, - filename = Just "empty", + filename = Just "empty", comment = Nothing, mtime = 1102127257, xfl = 0, os = 3} ] diff --git a/testsrc/Globtest.hs b/testsrc/Globtest.hs --- a/testsrc/Globtest.hs +++ b/testsrc/Globtest.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -{- +{- Copyright (C) 2006-2011 John Goerzen All rights reserved. @@ -30,7 +30,7 @@ bp = "testtmp" touch x = writeFile (sep x) "" -globtest thetest = +globtest thetest = bracket_ (setupfs) (recursiveRemove SystemFS bp) thetest @@ -47,7 +47,7 @@ createSymbolicLink (preppath "broken") (preppath "sym1") createSymbolicLink (preppath "broken") (preppath "sym2") #endif - + eq msg exp res = assertEqual msg (sort exp) (sort res) mf msg func = TestLabel msg $ TestCase $ globtest func @@ -78,7 +78,7 @@ glob (preppath "a/*.foo") >>= eq "a/*.foo" [preppath "a/a.foo"] ] -test_dirnames = +test_dirnames = map f [glob (preppath "*/D") >>= eq "*/D" [preppath "a/D"], glob (preppath "*/*a") >>= eq "*/*a" [], @@ -96,14 +96,11 @@ #else [] #endif - + tests = TestList [TestLabel "test_literal" (TestList test_literal), TestLabel "test_one_dir" (TestList test_one_dir), TestLabel "test_nested_dir" (TestList test_nested_dir), TestLabel "test_dirnames" (TestList test_dirnames), TestLabel "test_brokensymlinks" (TestList test_brokensymlinks)] - - - diff --git a/testsrc/HVFStest.hs b/testsrc/HVFStest.hs --- a/testsrc/HVFStest.hs +++ b/testsrc/HVFStest.hs @@ -45,7 +45,7 @@ --,f [] "." ] -test_content = +test_content = let f exp fp' = TestLabel fp $ TestCase $ do x <- newMemoryVFS testTree h <- vOpen x fp ReadMode @@ -62,7 +62,7 @@ ] test_chroot = - let f msg testfunc = TestLabel msg $ TestCase $ + let f msg testfunc = TestLabel msg $ TestCase $ do x <- newMemoryVFS testTree vSetCurrentDirectory x (sep "/emptydir") y <- newHVFSChroot x (sep "/dir1") @@ -88,7 +88,7 @@ --vSetCurrentDirectory x ".." --"/" `ioeq` vGetCurrentDirectory x ) - --,f "test.txt" (\x -> "subdir test" `ioeq` + --,f "test.txt" (\x -> "subdir test" `ioeq` -- (vOpen x "/test.txt" ReadMode >>= vGetContents)) ] @@ -109,12 +109,12 @@ ,f "dir1" (\x -> ["file3.txt", "test.txt", "dir2"] `ioeq` vGetDirectoryContents x "/dir1") ,f (sep "dir1/dir2") (\x -> [] `ioeq` vGetDirectoryContents x (sep "/dir1/dir2")) - ,f "relative tests" (\x -> + ,f "relative tests" (\x -> do vSetCurrentDirectory x "dir1" [] `ioeq` vGetDirectoryContents x "dir2" ) ] - + tests = TestList [TestLabel "nice_slice" (TestList test_nice_slice) ,TestLabel "structure" (TestList test_structure) diff --git a/testsrc/IOtest.hs b/testsrc/IOtest.hs --- a/testsrc/IOtest.hs +++ b/testsrc/IOtest.hs @@ -12,8 +12,3 @@ import System.IO import TestUtils - - - - - diff --git a/testsrc/Listtest.hs b/testsrc/Listtest.hs --- a/testsrc/Listtest.hs +++ b/testsrc/Listtest.hs @@ -241,5 +241,3 @@ TestLabel "subIndex" (TestList test_subIndex), TestLabel "spanList" (TestList test_spanList)] - - diff --git a/testsrc/MIMETypestest.hs b/testsrc/MIMETypestest.hs --- a/testsrc/MIMETypestest.hs +++ b/testsrc/MIMETypestest.hs @@ -13,7 +13,7 @@ test_readMIMETypes = let omtd = readMIMETypes defaultmtd True "testsrc/mime.types.test" - f = \strict inp exp -> TestCase $ do + f = \strict inp exp -> TestCase $ do mtd <- omtd exp @=? guessType mtd strict inp fe = \strict inp exp -> TestCase $ do mtd <- omtd @@ -43,7 +43,7 @@ ] test_guessType = - let f strict inp exp = TestCase $ exp @=? guessType defaultmtd strict inp in + let f strict inp exp = TestCase $ exp @=? guessType defaultmtd strict inp in [ f True "" (Nothing, Nothing) ,f True "foo" (Nothing, Nothing) diff --git a/testsrc/Pathtest.hs b/testsrc/Pathtest.hs --- a/testsrc/Pathtest.hs +++ b/testsrc/Pathtest.hs @@ -21,7 +21,7 @@ p = sep p' exp = fmap sep exp' f2 = f "/usr/1/2" in - [ + [ f "/" "" (Just "/") ,f "/usr/test" "" (Just "/usr/test") ,f "/usr/test" ".." (Just "/usr") @@ -44,7 +44,7 @@ p = sep p' exp = fmap sep exp' f2 = f "/usr/1/2" in - [ + [ f "/" "" (Just "/") ,f "/usr/test" "" (Just "/usr/test") ,f "/usr/test" ".." Nothing diff --git a/testsrc/ProgressTrackertest.hs b/testsrc/ProgressTrackertest.hs --- a/testsrc/ProgressTrackertest.hs +++ b/testsrc/ProgressTrackertest.hs @@ -1,4 +1,4 @@ -{- +{- Copyright (C) 2006-2011 John Goerzen All rights reserved. @@ -19,7 +19,7 @@ settime timem newval = swapMVar timem newval >> return () -test_incrP = +test_incrP = do (po, timem) <- setup incrP po 5 withStatus po $ \s -> @@ -92,14 +92,14 @@ getETR po >>= assertEqual "etr 2" 44 getETA po >>= assertEqual "eta 2" 444 -test_callback = +test_callback = do (po, _) <- setup mcounter <- newMVar (0::Int) mcounter1 <- newMVar (0::Int) mcounter2 <- newMVar (0::Int) (po2, _) <- setup (po3, _) <- setup - + addCallback po (minc mcounter) addParent po po2 incrP po 5 @@ -107,13 +107,13 @@ withStatus po (\x -> 5 @=? completedUnits x) withStatus po2 (\x -> do 5 @=? completedUnits x 200 @=? totalUnits x) - + addCallback po2 (minc mcounter2) incrP po 100 readMVar mcounter2 >>= (\x -> assertBool "cb2" (0 /= x)) withStatus po2 (\x -> do 105 @=? completedUnits x 205 @=? totalUnits x) - + incrP' po 5 withStatus po2 (\x -> do 110 @=? completedUnits x 205 @=? totalUnits x) @@ -121,14 +121,12 @@ finishP po withStatus po2 (\x -> do 110 @=? completedUnits x 210 @=? totalUnits x) - - + + where minc mv _ _ = modifyMVar_ mv (\x -> return $ x + 1) tests = TestList [TestLabel "incrP" (TestCase test_incrP), TestLabel "setP" (TestCase test_setP), TestLabel "speed" (TestCase test_speed), TestLabel "test_callback" (TestCase test_callback)] - - diff --git a/testsrc/Str/CSVtest.hs b/testsrc/Str/CSVtest.hs --- a/testsrc/Str/CSVtest.hs +++ b/testsrc/Str/CSVtest.hs @@ -13,7 +13,7 @@ import Text.ParserCombinators.Parsec test_csv = - let f inp exp = TestLabel inp $ TestCase $ + let f inp exp = TestLabel inp $ TestCase $ exp @=? case parse csvFile "" inp of Right x -> Right x Left y -> Left (show y) diff --git a/testsrc/Strtest.hs b/testsrc/Strtest.hs --- a/testsrc/Strtest.hs +++ b/testsrc/Strtest.hs @@ -53,15 +53,15 @@ test_escapeRe = - map (\i -> TestLabel (show $ chr i) $ TestCase $ assertEqual [chr i] (Just []) + map (\i -> TestLabel (show $ chr i) $ TestCase $ assertEqual [chr i] (Just []) (matchRegex (mkRegex $ escapeRe $ [chr i]) [chr i])) - [1..255] + [1..127] ++ - [TestCase $ assertEqual "big string" + [TestCase $ assertEqual "big string" (Just ([], teststr, [], [])) (matchRegexAll (mkRegex $ escapeRe teststr) teststr) ] - where teststr = map chr [1..255] + where teststr = map chr [1..127] tests = TestList [TestLabel "lstrip" (TestList test_lstrip), TestLabel "rstrip" $ TestList test_rstrip, @@ -69,7 +69,3 @@ TestLabel "splitWs" $ TestList test_splitWs, TestLabel "escapeRe" $ TestList test_escapeRe ] - - - - diff --git a/testsrc/Tests.hs b/testsrc/Tests.hs --- a/testsrc/Tests.hs +++ b/testsrc/Tests.hs @@ -46,4 +46,3 @@ TestLabel "CRC32GZIPtest" CRC32GZIPtest.tests, TestLabel "GZiptest" GZiptest.tests] - diff --git a/testsrc/Timetest.hs b/testsrc/Timetest.hs --- a/testsrc/Timetest.hs +++ b/testsrc/Timetest.hs @@ -22,7 +22,7 @@ f (base {ctYear = 2005, ctMonth = January, ctDay = 21, ctHour = 1, ctMin = 1, ctSec = 20}) 1106269280 - + ,f (base {ctYear = 2004, ctMonth = July, ctDay = 1, ctHour = 17, ctMin = 0, ctSec = 0}) 1088701200 @@ -30,7 +30,7 @@ ] test_ct2e = - let f base exp = TestLabel (show base) $ TestCase $ + let f base exp = TestLabel (show base) $ TestCase $ do r <- timelocal base exp @=? r in [ diff --git a/testsrc/WildMatchtest.hs b/testsrc/WildMatchtest.hs --- a/testsrc/WildMatchtest.hs +++ b/testsrc/WildMatchtest.hs @@ -35,9 +35,6 @@ f0 "[!\\]" "\\", f0 "*.deb" "thedebianthing", f0 "a/*.foo" "testtmp/a/D"] - -tests = TestList [TestLabel "wildCheckCase" (TestList test_wildCheckCase)] - - +tests = TestList [TestLabel "wildCheckCase" (TestList test_wildCheckCase)] diff --git a/testsrc/runtests.hs b/testsrc/runtests.hs --- a/testsrc/runtests.hs +++ b/testsrc/runtests.hs @@ -7,7 +7,7 @@ -} -module Main where +module Main where import Test.HUnit import Tests