diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,14 +1,88 @@ -### 1.4.3.0 +# 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_ + +- Remove spurious dependency on `random`. +- Bump upper bounds on `base` and `time`. +- Tested with GHC 7.0 - 9.2. + +## 1.4.3.0 + +_Herbert Valerio Riedel, 2020-04-09_ + - New tuple construction helpers `Data.Tuple.Utils.dup` and `Data.Tuple.Utils.triple` - Close sockets on connection failure in `connectTCPAddr` ([#50](https://github.com/haskell-hvr/missingh/issues/50)) ### 1.4.2.1 +_Herbert Valerio Riedel, 2019-05-20_ + - GHC 7.0 only compat release ## 1.4.2.0 +_Herbert Valerio Riedel, 2019-05-14_ + - Fix regression (introduced in 1.4.1.0 release) in `Data.Compression.Inflate` - Drop redundant dependency on `HUnit` - Add more explicit `SafeHaskell` annotations to modules; all modules @@ -17,13 +91,19 @@ ## 1.4.1.0 +_John Goerzen, 2018-10-13_ + - Support for GHC 8.6.1 / `base-4.12` ([#45](https://github.com/haskell-hvr/missingh/issues/45)) ### 1.4.0.1 +_John Goerzen, 2016-06-15_ + - Restore compatibility with GHC 7.4.2 # 1.4.0.0 + +_John Goerzen, 2016-06-29_ - Removal of `Data.Hash.CRC32.Posix` and `System.Time.Utils.ParseDate` diff --git a/MissingH.cabal b/MissingH.cabal --- a/MissingH.cabal +++ b/MissingH.cabal @@ -1,37 +1,54 @@ -cabal-version: 1.12 +cabal-version: 1.24 name: MissingH -version: 1.4.3.0 +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==8.6.5, 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 +tested-with: + 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 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + synopsis: Large utility library description: @MissingH@ is a library of all sorts of utility functions for Haskell 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 @@ -43,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 @@ -99,8 +116,8 @@ ExistentialQuantification FlexibleContexts FlexibleInstances + LambdaCase MultiParamTypeClasses - OverlappingInstances Rank2Types ScopedTypeVariables UndecidableInstances @@ -112,30 +129,31 @@ build-depends: array >= 0.4.0.0 && < 0.6 - , base >= 4.5.0.0 && < 4.15 - , 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 - , random >= 1.0.1.1 && < 1.2 , regex-compat >= 0.95.1 && < 0.96 - , time >= 1.4 && < 1.10 + , 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 ---------------------------------------------------------------------------- @@ -167,6 +185,8 @@ WildMatchtest default-language: Haskell2010 + other-extensions: + CPP -- intra-package dependency build-depends: MissingH @@ -180,7 +200,6 @@ , old-time , parsec , regex-compat - , time if !os(windows) build-depends: unix @@ -188,7 +207,7 @@ -- additional testsuite-specific dependencies build-depends: HUnit == 1.6.* --- , QuickCheck == 2.7.* - , 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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable This module provides various helpful utilities for dealing with threads. @@ -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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2008-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Tools for packing into bins @@ -36,13 +36,13 @@ ) where -import Data.List -import Control.Monad.Error -{- | Potential errors returned as Left values by 'BinPacker' functions. +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. -} -data (Num size, Ord size, Show size, Show obj) => BinPackerError size obj = +data (Num size, Ord size, Show size, Show obj) => BinPackerError size obj = BPTooFewBins [(size, obj)] -- ^ Ran out of bins; attached value is the list of objects that do not fit | BPSizeTooLarge size (size, obj) -- ^ Bin size1 exceeded by at least the given object and size | BPOther String -- ^ Other error @@ -55,21 +55,17 @@ ++ " 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, you can pass @repeat binSize@ to pass an infinite list of bins if the -same size. Any surplus bins will simply be ignored. +same size. Any surplus bins will simply be ignored. > [size] is the sizes of bins > [(size, obj)] is the sizes and objects > result is Either error or results -} -type BinPacker = forall size obj. (Num size, Ord size, Show size, Show obj) => +type BinPacker = forall size obj. (Num size, Ord size, Show size, Show obj) => [size] -- The sizes of bins -> [(size, obj)] -- The sizes and objects -> Either (BinPackerError size obj) [[(size, obj)]] -- Either error or results @@ -85,7 +81,7 @@ packByOrder [] remainder = Left (BPTooFewBins remainder) packByOrder (thisbinsize:otherbins) sizes = let fillBin _ [] = Right [] - fillBin accumsize ((s, o):xs) + fillBin accumsize ((s, o):xs) | s > thisbinsize = Left $ BPSizeTooLarge thisbinsize (s, o) | s + accumsize > thisbinsize = Right [] | otherwise = do next <- fillBin (accumsize + s) xs @@ -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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable to platforms with rawSystem Bit-related utilities @@ -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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2005-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Haskell Parsec parsers for comma-separated value (CSV) files. @@ -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 @@ -19,7 +19,7 @@ Copyright : Copyright (C) 2004 Ian Lynagh SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Inflate algorithm implementation @@ -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 @@ -363,5 +364,3 @@ (one_tree, lcs_o) = make_tree (i+1) lcs_z in (Branch zero_tree one_tree, lcs_o) | otherwise = error "make_tree: can't happen" - - 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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Utilities for working with the Either data type @@ -26,8 +26,9 @@ 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. @@ -77,4 +78,3 @@ fromEither :: Either a a -> a fromEither (Left a) = a fromEither (Right a) = a - 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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable CRC32 checksumming using the GZIP\/PKZIP algorithm as used in both @@ -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 @@ -8,7 +8,7 @@ SPDX-License-Identifier: BSD-3-Clause OR GPL-2.0-or-later Maintainer : Ian Lynagh - Stability : provisional + Stability : stable Portability: portable Generation of MD5sums @@ -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 @@ -12,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable This module provides various helpful utilities for dealing with lists. @@ -48,12 +49,11 @@ -- -- * Sub-List Selection -- sub, ) where + import Control.Monad.State (State, get, put) -import Data.List (concat, elemIndex, elemIndices, - elemIndices, find, findIndex, 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. @@ -82,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. @@ -92,7 +92,7 @@ | otherwise = y : mergeBy cmp allx ys {- | Returns true if the given list starts with the specified elements; -false otherwise. (This is an alias for "Data.List.isPrefixOf".) +false otherwise. (This is an alias for 'Data.List.isPrefixOf'.) Example: @@ -104,7 +104,7 @@ startswith = isPrefixOf {- | Returns true if the given list ends with the specified elements; -false otherwise. (This is an alias for "Data.List.isSuffixOf".) +false otherwise. (This is an alias for 'Data.List.isSuffixOf'.) Example: @@ -123,7 +123,7 @@ hasAny _ [] = False -- An empty list to scan: always false hasAny search (x:xs) = if x `elem` search then True else hasAny search xs -{- | Similar to Data.List.takeWhile, takes elements while the func is true. +{- | Similar to 'Data.List.takeWhile', takes elements while the func is true. The function is given the remainder of the list to examine. -} takeWhileList :: ([a] -> Bool) -> [a] -> [a] takeWhileList _ [] = [] @@ -132,16 +132,16 @@ then x : takeWhileList func xs else [] -{- | Similar to Data.List.dropWhile, drops elements while the func is true. +{- | Similar to 'Data.List.dropWhile', drops elements while the func is true. 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 -{- | Similar to Data.List.span, but performs the test on the entire remaining +{- | Similar to 'Data.List.span', but performs the test on the entire remaining list instead of just one element. @spanList p xs@ is the same as @(takeWhileList p xs, dropWhileList p xs)@ @@ -155,7 +155,7 @@ else ([],list) where (ys,zs) = spanList func xs -{- | Similar to Data.List.break, but performs the test on the entire remaining +{- | Similar to 'Data.List.break', but performs the test on the entire remaining list instead of just one element. -} breakList :: ([a] -> Bool) -> [a] -> ([a], [a]) @@ -198,14 +198,14 @@ replace old new l = join new . split old $ l {- | Given a delimiter and a list of items (or strings), join the items -by using the delimiter. +by using the delimiter. Alias for 'Data.List.intercalate'. Example: > join "|" ["foo", "bar", "baz"] -> "foo|bar|baz" -} join :: [a] -> [[a]] -> [a] -join delim l = concat (intersperse delim l) +join = intercalate {- | Like 'join', but works with a list of anything showable, converting it to a String. @@ -219,18 +219,14 @@ genericJoin :: Show a => String -> [a] -> String genericJoin delim l = join delim (map show l) -{-# DEPRECATED contains "Use Data.List.isInfixOf, will be removed in MissingH 1.1.0" #-} {- | Returns true if the given parameter is a sublist of the given list; -false otherwise. +false otherwise. Alias for 'Data.List.isInfixOf'. Example: > contains "Haskell" "I really like Haskell." -> True > contains "Haskell" "OCaml is great." -> False -This function was submitted to GHC and was applied as -'Data.List.isInfixOf'. This function therefore is deprecated and will -be removed in future versions. -} contains :: Eq a => [a] -> [a] -> Bool @@ -338,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 @@ -402,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. @@ -467,13 +463,10 @@ This function is not compatible with infinite lists. -This is presently an alias for Data.List.nub +This is presently an alias for 'Data.List.nub'. -} uniq :: Eq a => [a] -> [a] uniq = nub ----- same as --uniq (x:xs) = x : [y | y <- uniq xs, y /= x] - - - 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 @@ -13,7 +11,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Utilities for guessing MIME types of files. @@ -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/Map/Utils.hs b/src/Data/Map/Utils.hs --- a/src/Data/Map/Utils.hs +++ b/src/Data/Map/Utils.hs @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable This module provides various helpful utilities for dealing with Data.Maps. 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 @@ -12,10 +12,10 @@ Copyright : Copyright (C) 2005-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + 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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2006-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Tool for maintaining a status bar, supporting multiple simultaneous tasks, @@ -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. -} @@ -219,5 +233,3 @@ speed <- getSpeed pts return $ head (rfunc [floor (speed :: Double)]) ++ u ++ "/s " ++ renderSecs etr - - 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 @@ -12,12 +13,12 @@ Copyright : Copyright (C) 2006-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Tools for tracking the status of a long operation. -Written by John Goerzen, jgoerzen\@complete.org +Written by John Goerzen, jgoerzen\@complete.org See also "Data.Progress.Meter" -} @@ -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 @@ -66,7 +68,7 @@ long-running. Downloading many large files over the Internet is a common example of this. -Any given ProgressTracker can be told about one or more parent trackers. +Any given ProgressTracker can be told about one or more parent trackers. When the child tracker's status is updated, the parent tracker's status is also updated in the same manner. Therefore, the progress on each individual component, as well as the overall progress, can all be kept in sync @@ -95,7 +97,7 @@ -- TYPES ---------------------------------------------------------------------- -{- | A function that, when called, yields the current time. +{- | A function that, when called, yields the current time. The default is 'defaultTimeSource'. -} type ProgressTimeSource = IO Integer @@ -112,7 +114,7 @@ type ProgressCallback = ProgressStatus -> ProgressStatus -> IO () {- | The main progress status record. -} -data ProgressStatus = +data ProgressStatus = ProgressStatus {completedUnits :: Integer, totalUnits :: Integer, startTime :: Integer, @@ -129,7 +131,7 @@ newtype Progress = Progress (MVar ProgressRecord) class ProgressStatuses a b where - {- | Lets you examine the 'ProgressStatus' that is contained + {- | Lets you examine the 'ProgressStatus' that is contained within a 'Progress' object. You can simply pass a 'Progress' object and a function to 'withStatus', and 'withStatus' will lock the 'Progress' object (blocking any @@ -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 @@ -184,7 +174,7 @@ timeSource = defaultTimeSource}) [] -{- | Create a new 'Progress' object initialized with the given status and +{- | Create a new 'Progress' object initialized with the given status and callbacks. No adjustment to the 'startTime' will be made. If you want to use the system clock, you can initialize 'startTime' with @@ -200,7 +190,7 @@ {- | Adds an new callback to an existing 'Progress'. The callback will be called whenever the object's status is updated, except by the call to finishP. -Please note that the Progress object will be locked while the callback is +Please note that the Progress object will be locked while the callback is running, so the callback will not be able to make any modifications to it. -} addCallback :: Progress -> ProgressCallback -> IO () @@ -227,7 +217,7 @@ called. This ensures that the total expected counts on the parent are always correct. -Without doing this, if, say, a transfer ended earlier than expected, ETA +Without doing this, if, say, a transfer ended earlier than expected, ETA values on the parent would be off since it would be expecting more data than actually arrived. -} finishP :: Progress -> IO () @@ -235,10 +225,10 @@ modifyMVar_ mp modfunc where modfunc :: ProgressRecord -> IO ProgressRecord modfunc oldpr = - do let adjustment = (completedUnits . status $ oldpr) + do let adjustment = (completedUnits . status $ oldpr) - (totalUnits . status $ oldpr) callParents oldpr (\x -> incrTotal x adjustment) - return $ oldpr {status = (status oldpr) + return $ oldpr {status = (status oldpr) {totalUnits = completedUnits . status $ oldpr}} ---------------------------------------------------------------------- @@ -246,23 +236,23 @@ ---------------------------------------------------------------------- {- | Increment the completed unit count in the 'Progress' object by the amount given. If the value as given exceeds the total, then -the total will also be raised to match this value so that the +the total will also be raised to match this value so that the completed count never exceeds the total. You can decrease the completed unit count by supplying a negative number here. -} incrP :: Progress -> Integer -> IO () incrP po count = modStatus po statusfunc - where statusfunc s = + where statusfunc s = s {completedUnits = newcu s, totalUnits = if newcu s > totalUnits s then newcu s else totalUnits s} - newcu s = completedUnits s + count + newcu s = completedUnits s + count {- | Like 'incrP', but never modify the total. -} incrP' :: Progress -> Integer -> IO () -incrP' po count = +incrP' po count = modStatus po (\s -> s {completedUnits = completedUnits s + count}) {- | Set the completed unit count in the 'Progress' object to the specified @@ -283,10 +273,10 @@ setP' po count = modStatus po (\s -> s {completedUnits = count}) {- | Increment the total unit count in the 'Progress' object by the amount -given. This would rarely be needed, but could be needed in some special cases +given. This would rarely be needed, but could be needed in some special cases when the total number of units is not known in advance. -} incrTotal :: Progress -> Integer -> IO () -incrTotal po count = +incrTotal po count = modStatus po (\s -> s {totalUnits = totalUnits s + count}) {- | Set the total unit count in the 'Progress' object to the specified @@ -318,14 +308,14 @@ a number that is valid as any Fractional type, such as a Double, Float, or Rational. -} getSpeed :: (ProgressStatuses a (IO b), Fractional b) => a -> IO b -getSpeed po = withStatus po $ \status -> +getSpeed po = withStatus po $ \status -> do t <- timeSource status let elapsed = t - (startTime status) return $ if elapsed == 0 then fromRational 0 else fromRational ((completedUnits status) % elapsed) -{- | Returns the estimated time remaining, in standard time units. +{- | Returns the estimated time remaining, in standard time units. Returns 0 whenever 'getSpeed' would return 0. @@ -333,11 +323,11 @@ and result. -} getETR :: (ProgressStatuses a (IO Integer), ProgressStatuses a (IO Rational)) => a -> IO Integer -getETR po = +getETR po = do speed <- ((getSpeed po)::IO Rational) if speed == 0 then return 0 - else + else -- FIXME: potential for a race condition here, but it should -- be negligible withStatus po $ \status -> @@ -368,15 +358,12 @@ 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 modStatus (Progress mp) func = modifyMVar_ mp modfunc where modfunc :: ProgressRecord -> IO ProgressRecord - modfunc oldpr = + modfunc oldpr = do let newpr = oldpr {status = func (status oldpr)} mapM_ (\x -> x (status oldpr) (status newpr)) (callbacks oldpr) @@ -394,4 +381,3 @@ callParents :: ProgressRecord -> (Progress -> IO ()) -> IO () callParents pr func = mapM_ func (parents pr) - 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 @@ -12,7 +14,7 @@ Copyright : Copyright (C) 2006-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Tools for rendering sizes @@ -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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable This module provides various helpful utilities for dealing with strings. 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. -} {- | @@ -12,12 +12,12 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable 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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2005-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable General support for e-mail mailboxes @@ -26,7 +26,7 @@ where {- | The flags which may be assigned to a message. -} -data Flag = +data Flag = SEEN | ANSWERED | FLAGGED @@ -35,14 +35,14 @@ | FORWARDED | OTHERFLAG String deriving (Eq, Show) - + {- | Convenience shortcut -} type Flags = [Flag] {- | A Message is represented as a simple String. -} type Message = String -{- | Main class for readable mailboxes. +{- | Main class for readable mailboxes. The mailbox object /a/ represents zero or more 'Message's. Each message has a unique identifier /b/ in a format specific to each given mailbox. @@ -65,12 +65,12 @@ getMessages :: a -> [b] -> IO [(b, Flags, Message)] listIDs mb = listMessageFlags mb >>= return . map fst - listMessageFlags mb = getAll mb >>= return . + listMessageFlags mb = getAll mb >>= return . 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] deleteMessages :: a -> [b] -> IO () 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 @@ -14,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable This Haskell module provides an interface to transmitting a mail message. @@ -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] @@ -101,4 +101,3 @@ return $! r #endif - 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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: systems with networking This module provides various helpful utilities for dealing with networking @@ -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 @@ -15,15 +15,13 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable to platforms with POSIX process\/signal tools Command invocation utilities. 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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2005-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Written by John Goerzen, jgoerzen\@complete.org @@ -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 @@ -14,22 +14,16 @@ Copyright : Copyright (C) 2005-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable to platforms with POSIX process\/signal tools Tools for writing daemons\/server processes 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 @@ -11,7 +11,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable This module provides various helpful utilities for dealing with Debian @@ -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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable This module provides various helpful utilities for dealing with Debian @@ -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 @@ -12,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable GZip file decompression @@ -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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable to platforms supporting binary I\/O This module provides various helpful utilities for dealing with binary @@ -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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Haskell Virtual FS -- generic support for real or virtual filesystem in Haskell @@ -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 @@ -12,7 +11,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Support for combining different HVFS modules together @@ -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 @@ -12,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Utilities for creating instances of the items defined in @@ -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) @@ -210,4 +215,3 @@ vOpen x fp _ = vRaiseError x permissionErrorType "Only ReadMode is supported with MemoryVFS files" (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 @@ -13,7 +14,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable This module provides various helpful utilities for dealing @@ -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 @@ -145,5 +166,3 @@ ) c linedata <- mapM (showentry fp fs) pairs return $ unlines $ ["total 1"] ++ linedata - - 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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Haskell Virtual I\/O -- a system to increase the flexibility of input and @@ -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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2005-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable On Unix, exports System.Posix.Types and System.Posix.Files. 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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2005-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Provide a stat-like structure for use in MissingH. Especially @@ -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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable -} @@ -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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2005-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Provides some types and related items on Windows to be compatible with 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 @@ -13,7 +12,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable This module provides various helpful utilities for dealing with path and @@ -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 @@ -13,7 +11,7 @@ Copyright : Copyright (C) 2006-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Functions for expanding wildcards, filenames, and pathnames. @@ -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,10 +1,11 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {- | Module : System.Path.NameManip Copyright : Copyright (C) 2004 Volker Wysk SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Low-level path name manipulations. @@ -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 @@ -13,7 +13,7 @@ Copyright : Copyright (C) 2006-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Matching filenames with wildcards. See also "System.Path.Glob" for @@ -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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2005-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Exports some POSIX constants and functions that are not exported in fptools @@ -21,8 +21,9 @@ -} module System.Posix.Consts where -import System.Posix.Types +import safe System.Posix.Types ( FileMode ) + blockSpecialMode :: FileMode blockSpecialMode = 0o0060000 @@ -46,5 +47,3 @@ symbolicLinkMode :: FileMode symbolicLinkMode = 0o0120000 - - 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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable This module provides various Haskell utilities for dealing with times and @@ -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 @@ -131,4 +140,3 @@ zippedlist = zip quantlist suffixlist -- Drop all leading elements that are 0, then take at most 2 workinglist = take 2 . dropWhile (\(q, _) -> q == 0) $ zippedlist - 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 @@ -12,7 +12,7 @@ Copyright : Copyright (C) 2004-2011 John Goerzen SPDX-License-Identifier: BSD-3-Clause - Stability : provisional + Stability : stable Portability: portable Written by John Goerzen, jgoerzen\@complete.org @@ -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 @@ -98,4 +107,3 @@ Just _ -> unexpected errormsg in try workerFunc - diff --git a/testsrc/Eithertest.hs b/testsrc/Eithertest.hs --- a/testsrc/Eithertest.hs +++ b/testsrc/Eithertest.hs @@ -6,10 +6,14 @@ For license and copyright information, see the file LICENSE -} +{-# LANGUAGE CPP #-} module Eithertest(tests) where + import Control.Exception +#if !MIN_VERSION_base(4,7,0) import Control.Exception.ErrorCall.EqInstance +#endif import Data.Either.Utils import Test.HUnit import TestUtils @@ -37,4 +41,3 @@ tests = TestList [TestLabel "test_maybeToEither" (TestList test_maybeToEither), TestLabel "test_forceEither" (TestList test_forceEither) ] - 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