base-compat-0.8.2/0000755000000000000000000000000012524570365012113 5ustar0000000000000000base-compat-0.8.2/README.markdown0000644000000000000000000001165512524570365014624 0ustar0000000000000000# A compatibility layer for `base` [![Hackage version](https://img.shields.io/hackage/v/base-compat.svg?style=flat)](http://hackage.haskell.org/package/base-compat) [![Build Status](https://img.shields.io/travis/haskell-compat/base-compat.svg?style=flat)](https://travis-ci.org/haskell-compat/base-compat) ## Scope The scope of `base-compat` is to provide functions available in later versions of base to a wider (older) range of compilers. In addition, successful library proposals that have been accepted to be part of upcoming versions of `base` are also included. This package is not intended to replace `base`, but to complement it. Note that `base-compat` does not add any orphan instances. There is a separate package [`base-orphans`](https://github.com/haskell-compat/base-orphans) for that. ## Basic usage In your cabal file, you should have something like this: ``` build-depends: base >= 4.3 , base-compat >= 0.8.0 ``` Then, lets say you want to use the `isRight` function introduced with `base-4.7.0.0`. Replace: ``` import Data.Either ``` with ``` import Data.Either.Compat ``` _Note (1)_: There is no need to import both unqualified. The `.Compat` modules re-exports the original module. _Note (2)_: If a given module `.Compat` version is not defined, that either means that: * The module has not changed in recent base versions, thus no `.Compat` is needed. * The module has changed, but the changes depend on newer versions of GHC, and thus are not portable. * The module has changed, but those changes have not yet been merged in `base-compat`: patches are welcomed! ## Using `Prelude.Compat` If you want to use `Prelude.Compat` (which provides all the AMP/Traversable/Foldable changes from `base-4.8.0.0`), it's best to hide `Prelude`, e.g.: import Prelude () import Prelude.Compat main :: IO () main = mapM_ print (Just 23) Alternatively, you can use the `NoImplicitPrelude` language extension: {-# LANGUAGE NoImplicitPrelude #-} import Prelude.Compat main :: IO () main = mapM_ print (Just 23) Note that we use mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m () from `Data.Foldable` here, which is only exposed from `Prelude` since `base-4.8.0.0`. Using this approach allows you to write code that works seamlessly with all versions of GHC that are supported by `base-compat`. ## What is covered So far the following is covered. ### For compatibility with the latest released version of `base` * `Prelude.Compat` incorporates the AMP/Foldable/Traversable changes and exposes the same interface as `Prelude` from `base-4.8.0.0` * `System.IO.Error.catch` is not re-exported from `Prelude.Compat` for older versions of `base` * `Text.Read.Compat.readMaybe` * `Text.Read.Compat.readEither` * `Data.Monoid.Compat.<>` * Added `bitDefault`, `testBitDefault`, and `popCountDefault` to `Data.Bits.Compat` * Added `toIntegralSized` to `Data.Bits.Compat` (if using `base-4.7`) * Added `bool` function to `Data.Bool.Compat` * Added `isLeft` and `isRight` to `Data.Either.Compat` * Added `withMVarMasked` function to `Control.Concurrent.MVar.Compat` * Added `(<$!>)` function to `Control.Monad.Compat` * Added `($>)` and `void` functions to `Data.Functor.Compat` * `(&)` function to `Data.Function.Compat` * `($>)` and `void` functions to `Data.Functor.Compat` * `dropWhileEnd`, `isSubsequenceOf`, `sortOn`, and `uncons` functions to `Data.List.Compat` * Correct versions of `nub`, `nubBy`, `union`, and `unionBy` to `Data.List.Compat` * `makeVersion` function to `Data.Version.Compat` * `traceId`, `traceShowId`, `traceM`, and `traceShowM` functions to `Debug.Trace.Compat` * `byteSwap16`, `byteSwap32`, and `byteSwap64` to `Data.Word.Compat` * `calloc` and `callocBytes` functions to `Foreign.Marshal.Alloc.Compat` * `callocArray` and `callocArray0` functions to `Foreign.Marshal.Array.Compat` * `fillBytes` to `Foreign.Marshal.Utils.Compat` * Added `Data.List.Compat.scanl'` * `showFFloatAlt` and `showGFloatAlt` to `Numeric.Compat` * `lookupEnv`, `setEnv` and `unsetEnv` to `System.Environment.Compat` ## Supported versions of GHC/base * `ghc-7.10.1` / `base-4.8.0.0` * `ghc-7.8.4` / `base-4.7.0.2` * `ghc-7.8.3` / `base-4.7.0.1` * `ghc-7.8.2` / `base-4.7.0.0` * `ghc-7.8.1` / `base-4.7.0.0` * `ghc-7.6.3` / `base-4.6.0.1` * `ghc-7.6.2` / `base-4.6.0.1` * `ghc-7.6.1` / `base-4.6.0.0` * `ghc-7.4.2` / `base-4.5.1.0` * `ghc-7.4.1` / `base-4.5.0.0` * `ghc-7.2.2` / `base-4.4.1.0` * `ghc-7.2.1` / `base-4.4.0.0` * `ghc-7.0.4` / `base-4.3.1.0` * `ghc-7.0.3` / `base-4.3.1.0` * `ghc-7.0.2` / `base-4.3.1.0` * `ghc-7.0.1` / `base-4.3.0.0` Patches are welcome; add tests for new code! ## Development For `Prelude.Compat` there is an `Prelude.index` file that was generated from the output of ghc --show-iface Prelude.hi To verify that `Prelude.Compat` matches the specification given in `Prelude.types` run: ./check-Prelude.sh base-compat-0.8.2/base-compat.cabal0000644000000000000000000000511312524570365015272 0ustar0000000000000000name: base-compat version: 0.8.2 license: MIT license-file: LICENSE copyright: (c) 2012-2015 Simon Hengel, (c) 2014 João Cristóvão, (c) 2015 Ryan Scott author: Simon Hengel , João Cristóvão , Ryan Scott maintainer: Simon Hengel , João Cristóvão , Ryan Scott build-type: Simple cabal-version: >= 1.8 category: Compatibility synopsis: A compatibility layer for base description: Provides functions available in later versions of @base@ to a wider range of compilers, without requiring you to use CPP pragmas in your code. See the for what is covered. Also see the for recent changes. . Note that @base-compat@ does not add any orphan instances. There is a separate package @@ for that. extra-source-files: CHANGES.markdown, README.markdown source-repository head type: git location: https://github.com/haskell-compat/base-compat library ghc-options: -Wall build-depends: base >= 4.3 && < 5 if !os(windows) build-depends: unix ghc-options: -fno-warn-duplicate-exports hs-source-dirs: src exposed-modules: Control.Concurrent.MVar.Compat Control.Monad.Compat Data.Bits.Compat Data.Bool.Compat Data.Either.Compat Data.Foldable.Compat Data.Function.Compat Data.Functor.Compat Data.List.Compat Data.Monoid.Compat Data.Version.Compat Data.Word.Compat Debug.Trace.Compat Foreign.Compat Foreign.Marshal.Alloc.Compat Foreign.Marshal.Array.Compat Foreign.Marshal.Compat Foreign.Marshal.Utils.Compat Numeric.Compat Prelude.Compat System.Environment.Compat System.Exit.Compat Text.Read.Compat test-suite spec type: exitcode-stdio-1.0 ghc-options: -Wall hs-source-dirs: test main-is: Spec.hs build-depends: base >= 4.3 && < 5 , base-compat , hspec >= 1.8 , QuickCheck base-compat-0.8.2/Setup.lhs0000644000000000000000000000011412524570365013717 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain base-compat-0.8.2/CHANGES.markdown0000644000000000000000000000555512524570365014741 0ustar0000000000000000## Changes in 0.8.2 - Backport `bitDefault`, `testBitDefault`, and `popCountDefault` in `Data.Bits.Compat` to all versions of `base` - Backport `toIntegralSized` to `base-4.7` - Backport `nub` and `nubBy` (as well as `union` and `unionBy`, which are implemented in terms of them) to fix logic error in `Data.List.Compat` - Backport `byteSwap16`, `byteSwap32`, and `byteSwap64` to `Data.Word.Compat` - Backport `fillBytes` in `Foreign.Marshal.Utils.Compat` - Backport `showFFloatAlt` and `showGFloatAlt` to `Numeric.Compat` ## Changes in 0.8.1.1 - Fixed Windows build ## Changes in 0.8.1 - Implement `setEnv` and `unsetEnv` in `System.Environment.Compat` (which were ported from the `setenv` package). As a result, `base-compat` now depends on `unix` on POSIX-like operating systems. - Drop GHC 6.12 (and `base-4.2.0.0`) compatibility ## Changes in 0.8.0.1 - Retrospective version bump updating the changelog to reflect the changes made in 0.8.0 ## Changes 0.8.0 - All orphan instances were split off into a separate package, [`base-orphans`](https://github.com/haskell-compat/base-orphans) - `base-compat` no longer redefines the data types `Down` and `Alt`. See [here](https://github.com/haskell-compat/base-compat/issues/17) for the discussion that led to this change. - Update `Control.Monad.Compat` for `base-4.8.0.0` - Update `Data.List.Compat` for `base-4.8.0.0` - Update `Data.Foldable.Compat` for `base-4.8.0.0` ## Changes in 0.7.1 - Backported `Alt` to `Data.Monoid.Compat` - Backported `Down` to `Data.Ord.Compat` ## Changes in 0.7.0 - Add functions and orphan instances introduced by changes to `base-4.7.0.0` and `base-4.8.0.0` ## Changes in 0.6.0 - Update `Prelude.Compat` for `base-4.8.0.0` and AMP ## Changes in 0.5.0 - Remove Control.Exception.Base.Compat and GHC.Exception.Compat - Add System.Exit.Compat.die - Compatibility with base-4.7.1 ## Changes in 0.4.1 - Add `setEnv` and `unsetEnv` to `System.Environment.Compat` ## Changes in 0.4.0 - Major refactoring: base-compat no longer aims to replace all base, only new code is included in module .Compat - Removed stubbed modules - Removed generation scripts ## Changes in 0.3 - Added functions from Base 4.7 (bool, isLeft, isRight) - Added instances from Base 4.7 (Either Foldable, Traversable,...) ## Changes in 0.2.1 - Fix build on windows ## Changes in 0.2.0 - Re-export everything from base - provides access to `VERSION_base` and `MIN_VERSION_base` CPP macros (with `#include "base-compat.h"`) - Do not re-export `System.IO.Error.catch` from `Prelude` for `base` < 4.6.0 - Add `Eq`/`Ord` instance for `ErrorCall` - Remove `GHC.IOBase`, `GHC.Handle`, `Control.Concurrent.QSem`, `Control.Concurrent.QSemN`, `Control.Concurrent.SampleVar`, `Data.HashTable` ## Changes in 0.1.0 - Remove getExecutablePath, it did not work with GHC < 7.2 (patches welcome!) - Add `<>` base-compat-0.8.2/LICENSE0000644000000000000000000000213512524570365013121 0ustar0000000000000000Copyright (c) 2012-2015 Simon Hengel and Ryan Scott Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. base-compat-0.8.2/src/0000755000000000000000000000000012524570365012702 5ustar0000000000000000base-compat-0.8.2/src/Data/0000755000000000000000000000000012524570365013553 5ustar0000000000000000base-compat-0.8.2/src/Data/Word/0000755000000000000000000000000012524570365014466 5ustar0000000000000000base-compat-0.8.2/src/Data/Word/Compat.hs0000644000000000000000000000226712524570365016254 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Data.Word.Compat ( module Base , byteSwap16 , byteSwap32 , byteSwap64 ) where import Data.Word as Base #if !(MIN_VERSION_base(4,7,0)) import Data.Bits -- | Swap bytes in 'Word16'. -- -- /Since: 4.7.0.0/ byteSwap16 :: Word16 -> Word16 byteSwap16 w = ((w `shiftR` 8) .&. 0x00ff) .|. ((w .&. 0x00ff) `shiftL` 8) -- | Reverse order of bytes in 'Word32'. -- -- /Since: 4.7.0.0/ byteSwap32 :: Word32 -> Word32 byteSwap32 w = ((w .&. 0xff000000) `shiftR` 24) .|. ((w .&. 0x00ff0000) `shiftR` 8) .|. ((w .&. 0x0000ff00) `shiftL` 8) .|. ((w .&. 0x000000ff) `shiftL` 24) -- | Reverse order of bytes in 'Word64'. -- -- /Since: 4.7.0.0/ byteSwap64 :: Word64 -> Word64 byteSwap64 w = ((w .&. 0xff00000000000000) `shiftR` 56) .|. ((w .&. 0x00ff000000000000) `shiftR` 40) .|. ((w .&. 0x0000ff0000000000) `shiftR` 24) .|. ((w .&. 0x000000ff00000000) `shiftR` 8) .|. ((w .&. 0x00000000ff000000) `shiftL` 8) .|. ((w .&. 0x0000000000ff0000) `shiftL` 24) .|. ((w .&. 0x000000000000ff00) `shiftL` 40) .|. ((w .&. 0x00000000000000ff) `shiftL` 56) #endif base-compat-0.8.2/src/Data/Bits/0000755000000000000000000000000012524570365014454 5ustar0000000000000000base-compat-0.8.2/src/Data/Bits/Compat.hs0000644000000000000000000000745412524570365016245 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} {-# LANGUAGE BangPatterns, PatternGuards #-} module Data.Bits.Compat ( module Base , bitDefault , testBitDefault , popCountDefault #if MIN_VERSION_base(4,7,0) , toIntegralSized #endif ) where import Data.Bits as Base #if !(MIN_VERSION_base(4,8,0)) import Prelude #endif #if !(MIN_VERSION_base(4,6,0)) -- | Default implementation for 'bit'. -- -- Note that: @bitDefault i = 1 `shiftL` i@ -- -- /Since: 4.6.0.0/ bitDefault :: (Bits a, Num a) => Int -> a bitDefault = \i -> 1 `shiftL` i {-# INLINE bitDefault #-} -- | Default implementation for 'testBit'. -- -- Note that: @testBitDefault x i = (x .&. bit i) /= 0@ -- -- /Since: 4.6.0.0/ testBitDefault :: (Bits a, Num a) => a -> Int -> Bool testBitDefault = \x i -> (x .&. bit i) /= 0 {-# INLINE testBitDefault #-} -- | Default implementation for 'popCount'. -- -- This implementation is intentionally naive. Instances are expected to provide -- an optimized implementation for their size. -- -- /Since: 4.6.0.0/ popCountDefault :: (Bits a, Num a) => a -> Int popCountDefault = go 0 where go !c 0 = c go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant {-# INLINABLE popCountDefault #-} #endif #if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) -- | Attempt to convert an 'Integral' type @a@ to an 'Integral' type @b@ using -- the size of the types as measured by 'Bits' methods. -- -- A simpler version of this function is: -- -- > toIntegral :: (Integral a, Integral b) => a -> Maybe b -- > toIntegral x -- > | toInteger x == y = Just (fromInteger y) -- > | otherwise = Nothing -- > where -- > y = toInteger x -- -- This version requires going through 'Integer', which can be inefficient. -- However, @toIntegralSized@ is optimized to allow GHC to statically determine -- the relative type sizes (as measured by 'bitSizeMaybe' and 'isSigned') and -- avoid going through 'Integer' for many types. (The implementation uses -- 'fromIntegral', which is itself optimized with rules for @base@ types but may -- go through 'Integer' for some type pairs.) -- -- /Since: 4.8.0.0/ toIntegralSized :: (Integral a, Integral b, Bits a, Bits b) => a -> Maybe b toIntegralSized x -- See Note [toIntegralSized optimization] | maybe True (<= x) yMinBound , maybe True (x <=) yMaxBound = Just y | otherwise = Nothing where y = fromIntegral x xWidth = bitSizeMaybe x yWidth = bitSizeMaybe y yMinBound | isBitSubType x y = Nothing | isSigned x, not (isSigned y) = Just 0 | isSigned x, isSigned y , Just yW <- yWidth = Just (negate $ bit (yW-1)) -- Assumes sub-type | otherwise = Nothing yMaxBound | isBitSubType x y = Nothing | isSigned x, not (isSigned y) , Just xW <- xWidth, Just yW <- yWidth , xW <= yW+1 = Nothing -- Max bound beyond a's domain | Just yW <- yWidth = if isSigned y then Just (bit (yW-1)-1) else Just (bit yW-1) | otherwise = Nothing {-# INLINEABLE toIntegralSized #-} -- | 'True' if the size of @a@ is @<=@ the size of @b@, where size is measured -- by 'bitSizeMaybe' and 'isSigned'. isBitSubType :: (Bits a, Bits b) => a -> b -> Bool isBitSubType x y -- Reflexive | xWidth == yWidth, xSigned == ySigned = True -- Every integer is a subset of 'Integer' | ySigned, Nothing == yWidth = True | not xSigned, not ySigned, Nothing == yWidth = True -- Sub-type relations between fixed-with types | xSigned == ySigned, Just xW <- xWidth, Just yW <- yWidth = xW <= yW | not xSigned, ySigned, Just xW <- xWidth, Just yW <- yWidth = xW < yW | otherwise = False where xWidth = bitSizeMaybe x xSigned = isSigned x yWidth = bitSizeMaybe y ySigned = isSigned y {-# INLINE isBitSubType #-} #endif base-compat-0.8.2/src/Data/Monoid/0000755000000000000000000000000012524570365015000 5ustar0000000000000000base-compat-0.8.2/src/Data/Monoid/Compat.hs0000644000000000000000000000046212524570365016561 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Data.Monoid.Compat ( module Base , (<>) ) where import Data.Monoid as Base #if !(MIN_VERSION_base(4,5,0)) infixr 6 <> -- | An infix synonym for 'mappend'. -- -- /Since: 4.5.0.0/ (<>) :: Monoid m => m -> m -> m (<>) = mappend {-# INLINE (<>) #-} #endif base-compat-0.8.2/src/Data/Version/0000755000000000000000000000000012524570365015200 5ustar0000000000000000base-compat-0.8.2/src/Data/Version/Compat.hs0000644000000000000000000000047112524570365016761 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Data.Version.Compat ( module Base , makeVersion ) where import Data.Version as Base #if !(MIN_VERSION_base(4,8,0)) import Prelude.Compat -- | Construct tag-less 'Version' -- -- /Since: 4.8.0.0/ makeVersion :: [Int] -> Version makeVersion b = Version b [] #endif base-compat-0.8.2/src/Data/Foldable/0000755000000000000000000000000012524570365015263 5ustar0000000000000000base-compat-0.8.2/src/Data/Foldable/Compat.hs0000644000000000000000000000140512524570365017042 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Data.Foldable.Compat ( module Base #if !(MIN_VERSION_base(4,8,0)) , length , null #endif ) where import Data.Foldable as Base #if !(MIN_VERSION_base(4,8,0)) import Prelude (Bool(..), Int, (+)) -- | Test whether the structure is empty. The default implementation is -- optimized for structures that are similar to cons-lists, because there -- is no general way to do better. null :: Foldable t => t a -> Bool null = foldr (\_ _ -> False) True -- | Returns the size/length of a finite structure as an 'Int'. The -- default implementation is optimized for structures that are similar to -- cons-lists, because there is no general way to do better. length :: Foldable t => t a -> Int length = foldl' (\c _ -> c+1) 0 #endif base-compat-0.8.2/src/Data/Either/0000755000000000000000000000000012524570365014773 5ustar0000000000000000base-compat-0.8.2/src/Data/Either/Compat.hs0000644000000000000000000000106312524570365016552 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Data.Either.Compat ( module Base , isLeft , isRight ) where import Data.Either as Base #if !(MIN_VERSION_base(4,7,0)) import Data.Bool (Bool(..)) -- | Return `True` if the given value is a `Left`-value, `False` otherwise. -- -- /Since: 4.7.0.0/ isLeft :: Either a b -> Bool isLeft (Left _) = True isLeft (Right _) = False -- | Return `True` if the given value is a `Right`-value, `False` otherwise. -- -- /Since: 4.7.0.0/ isRight :: Either a b -> Bool isRight (Left _) = False isRight (Right _) = True #endif base-compat-0.8.2/src/Data/List/0000755000000000000000000000000012524570365014466 5ustar0000000000000000base-compat-0.8.2/src/Data/List/Compat.hs0000644000000000000000000001254512524570365016254 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} {-# LANGUAGE BangPatterns #-} module Data.List.Compat ( module Base #if !(MIN_VERSION_base(4,8,0)) , all , and , any , concat , concatMap , elem , find , foldl , foldl' , foldl1 , foldr , foldr1 , length , maximum , maximumBy , minimum , minimumBy , notElem , nub , nubBy , null , or , product , sum , union , unionBy , mapAccumL , mapAccumR , isSubsequenceOf , sortOn , uncons , scanl' #endif #if !(MIN_VERSION_base(4,5,0)) , dropWhileEnd #endif ) where #if MIN_VERSION_base(4,8,0) import Data.List as Base #else import Data.List as Base hiding ( all , and , any , concat , concatMap , elem , find , foldl , foldl' , foldl1 , foldr , foldr1 , length , maximum , maximumBy , minimum , minimumBy , notElem , nub , nubBy , null , or , product , sum , union , unionBy , mapAccumL , mapAccumR ) import Data.Foldable.Compat import Data.Traversable import Prelude.Compat hiding (foldr, null) import Data.Ord (comparing) #endif #if !(MIN_VERSION_base(4,5,0)) -- | The 'dropWhileEnd' function drops the largest suffix of a list -- in which the given predicate holds for all elements. For example: -- -- > dropWhileEnd isSpace "foo\n" == "foo" -- > dropWhileEnd isSpace "foo bar" == "foo bar" -- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined -- -- /Since: 4.5.0.0/ dropWhileEnd :: (a -> Bool) -> [a] -> [a] dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] #endif #if !(MIN_VERSION_base(4,8,0)) -- | The 'isSubsequenceOf' function takes two lists and returns 'True' if the -- first list is a subsequence of the second list. -- -- @'isSubsequenceOf' x y@ is equivalent to @'elem' x ('subsequences' y)@. -- -- /Since: 4.8.0.0/ -- -- ==== __Examples__ -- -- >>> isSubsequenceOf "GHC" "The Glorious Haskell Compiler" -- True -- >>> isSubsequenceOf ['a','d'..'z'] ['a'..'z'] -- True -- >>> isSubsequenceOf [1..10] [10,9..0] -- False isSubsequenceOf :: (Eq a) => [a] -> [a] -> Bool isSubsequenceOf [] _ = True isSubsequenceOf _ [] = False isSubsequenceOf a@(x:a') (y:b) | x == y = isSubsequenceOf a' b | otherwise = isSubsequenceOf a b -- | Sort a list by comparing the results of a key function applied to each -- element. @sortOn f@ is equivalent to @sortBy . comparing f@, but has the -- performance advantage of only evaluating @f@ once for each element in the -- input list. This is called the decorate-sort-undecorate paradigm, or -- Schwartzian transform. -- -- /Since: 4.8.0.0/ sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) -- | Decompose a list into its head and tail. If the list is empty, -- returns 'Nothing'. If the list is non-empty, returns @'Just' (x, xs)@, -- where @x@ is the head of the list and @xs@ its tail. -- -- /Since: 4.8.0.0/ uncons :: [a] -> Maybe (a, [a]) uncons [] = Nothing uncons (x:xs) = Just (x, xs) -- | A strictly accumulating version of 'scanl' {-# NOINLINE [1] scanl' #-} scanl' :: (b -> a -> b) -> b -> [a] -> [b] -- This peculiar form is needed to prevent scanl' from being rewritten -- in its own right hand side. scanl' = scanlGo' where scanlGo' :: (b -> a -> b) -> b -> [a] -> [b] scanlGo' f !q ls = q : (case ls of [] -> [] x:xs -> scanlGo' f (f q x) xs) -- | /O(n^2)/. The 'nub' function removes duplicate elements from a list. -- In particular, it keeps only the first occurrence of each element. -- (The name 'nub' means \`essence\'.) -- It is a special case of 'nubBy', which allows the programmer to supply -- their own equality test. nub :: (Eq a) => [a] -> [a] nub = nubBy (==) -- | The 'nubBy' function behaves just like 'nub', except it uses a -- user-supplied equality predicate instead of the overloaded '==' -- function. nubBy :: (a -> a -> Bool) -> [a] -> [a] -- stolen from HBC nubBy eq l = nubBy' l [] where nubBy' [] _ = [] nubBy' (y:ys) xs | elem_by eq y xs = nubBy' ys xs | otherwise = y : nubBy' ys (y:xs) -- Not exported: -- Note that we keep the call to `eq` with arguments in the -- same order as in the reference (prelude) implementation, -- and that this order is different from how `elem` calls (==). -- See #2528, #3280 and #7913. -- 'xs' is the list of things we've seen so far, -- 'y' is the potential new element elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool elem_by _ _ [] = False elem_by eq y (x:xs) = x `eq` y || elem_by eq y xs -- | The 'union' function returns the list union of the two lists. -- For example, -- -- > "dog" `union` "cow" == "dogcw" -- -- Duplicates, and elements of the first list, are removed from the -- the second list, but if the first list contains duplicates, so will -- the result. -- It is a special case of 'unionBy', which allows the programmer to supply -- their own equality test. union :: (Eq a) => [a] -> [a] -> [a] union = unionBy (==) -- | The 'unionBy' function is the non-overloaded version of 'union'. unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] unionBy eq xs ys = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs #endif base-compat-0.8.2/src/Data/Functor/0000755000000000000000000000000012524570365015173 5ustar0000000000000000base-compat-0.8.2/src/Data/Functor/Compat.hs0000644000000000000000000000056312524570365016756 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Data.Functor.Compat ( module Base , Functor(..) , ($>) , void ) where import Data.Functor as Base #if !(MIN_VERSION_base(4,7,0)) import Control.Monad.Compat (void) import Data.Function (flip) infixl 4 $> -- | Flipped version of '$>'. -- -- /Since: 4.7.0.0/ ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) #endif base-compat-0.8.2/src/Data/Function/0000755000000000000000000000000012524570365015340 5ustar0000000000000000base-compat-0.8.2/src/Data/Function/Compat.hs0000644000000000000000000000070012524570365017114 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Data.Function.Compat ( module Base , (&) ) where import Data.Function as Base #if !(MIN_VERSION_base(4,8,0)) infixl 1 & -- | '&' is a reverse application operator. This provides notational -- convenience. Its precedence is one higher than that of the forward -- application operator '$', which allows '&' to be nested in '$'. -- -- /Since: 4.8.0.0/ (&) :: a -> (a -> b) -> b x & f = f x #endif base-compat-0.8.2/src/Data/Bool/0000755000000000000000000000000012524570365014446 5ustar0000000000000000base-compat-0.8.2/src/Data/Bool/Compat.hs0000644000000000000000000000060312524570365016224 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Data.Bool.Compat ( module Base , bool ) where import Data.Bool as Base #if !(MIN_VERSION_base(4,7,0)) -- | Case analysis for the 'Bool' type. -- @bool a b p@ evaluates to @a@ when @p@ is @False@, and evaluates to @b@ -- when @p@ is @True@. -- -- /Since: 4.7.0.0/ bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t #endif base-compat-0.8.2/src/System/0000755000000000000000000000000012524570365014166 5ustar0000000000000000base-compat-0.8.2/src/System/Environment/0000755000000000000000000000000012524570365016472 5ustar0000000000000000base-compat-0.8.2/src/System/Environment/Compat.hs0000644000000000000000000001015012524570365020246 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} {-# LANGUAGE ForeignFunctionInterface #-} -- | Miscellaneous information about the system environment. module System.Environment.Compat ( getArgs , getProgName , getEnv , lookupEnv , setEnv , unsetEnv , withArgs , withProgName , getEnvironment ) where import System.Environment #if !(MIN_VERSION_base(4,7,0)) import Prelude.Compat # ifdef mingw32_HOST_OS import Control.Monad import Foreign.C import Foreign.Safe import GHC.Windows # else import qualified System.Posix.Env as Posix # endif # ifdef mingw32_HOST_OS # if defined(i386_HOST_ARCH) # define WINDOWS_CCONV stdcall # elif defined(x86_64_HOST_ARCH) # define WINDOWS_CCONV ccall # else # error Unknown mingw32 arch # endif foreign import WINDOWS_CCONV unsafe "windows.h GetLastError" c_GetLastError:: IO DWORD eRROR_ENVVAR_NOT_FOUND :: DWORD eRROR_ENVVAR_NOT_FOUND = 203 # endif # if !(MIN_VERSION_base(4,6,0)) -- | Return the value of the environment variable @var@, or @Nothing@ if -- there is no such value. -- -- For POSIX users, this is equivalent to 'System.Posix.Env.getEnv'. lookupEnv :: String -> IO (Maybe String) lookupEnv k = lookup k `fmap` getEnvironment # endif -- | @setEnv name value@ sets the specified environment variable to @value@. -- -- On Windows setting an environment variable to the /empty string/ removes -- that environment variable from the environment. For the sake of -- compatibility we adopt that behavior. In particular -- -- @ -- setEnv name \"\" -- @ -- -- has the same effect as -- -- @ -- `unsetEnv` name -- @ -- -- If you don't care about Windows support and want to set an environment -- variable to the empty string use @System.Posix.Env.setEnv@ from the @unix@ -- package instead. -- -- Throws `Control.Exception.IOException` if @name@ is the empty string or -- contains an equals sign. -- -- Note that setting Unicode values may not work correctly on versions of GHC -- prior to 7.2. setEnv :: String -> String -> IO () setEnv key value_ | null value = unsetEnv key | otherwise = setEnv_ key value where -- NOTE: Anything that follows NUL is ignored on both POSIX and Windows. -- We still strip it manually so that the null check above succeds if a -- value starts with NUL, and `unsetEnv` is called. This is important for -- two reasons. -- -- * On POSIX setting an environment variable to the empty string does not -- remove it. -- -- * On Windows setting an environment variable to the empty string -- removes that environment variable. A subsequent call to -- GetEnvironmentVariable will then return 0, but the calling thread's -- last-error code will not be updated, and hence a call to GetLastError -- may not return ERROR_ENVVAR_NOT_FOUND. The failed lookup will then -- result in a random error instead of the expected -- `isDoesNotExistError` (this is at least true for Windows XP, SP 3). -- Explicitly calling `unsetEnv` prevents this. value = takeWhile (/= '\NUL') value_ setEnv_ :: String -> String -> IO () # ifdef mingw32_HOST_OS setEnv_ key value = withCWString key $ \k -> withCWString value $ \v -> do success <- c_SetEnvironmentVariable k v unless success (throwGetLastError "setEnv") foreign import WINDOWS_CCONV unsafe "windows.h SetEnvironmentVariableW" c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> IO Bool # else setEnv_ k v = Posix.setEnv k v True # endif -- | @unsetEnv name@ removes the specified environment variable from the -- environment of the current process. -- -- Throws `Control.Exception.IOException` if @name@ is the empty string or -- contains an equals sign. unsetEnv :: String -> IO () # ifdef mingw32_HOST_OS unsetEnv key = withCWString key $ \k -> do success <- c_SetEnvironmentVariable k nullPtr unless success $ do -- We consider unsetting an environment variable that does not exist not as -- an error, hence we ignore eRROR_ENVVAR_NOT_FOUND. err <- c_GetLastError unless (err == eRROR_ENVVAR_NOT_FOUND) $ do throwGetLastError "unsetEnv" # else unsetEnv = Posix.unsetEnv # endif #endif base-compat-0.8.2/src/System/Exit/0000755000000000000000000000000012524570365015077 5ustar0000000000000000base-compat-0.8.2/src/System/Exit/Compat.hs0000644000000000000000000000060712524570365016661 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} {-# LANGUAGE CPP #-} module System.Exit.Compat ( module Base , die ) where import System.Exit as Base #if !(MIN_VERSION_base(4,8,0)) import Prelude.Compat import System.IO -- | Write given error message to `stderr` and terminate with `exitFailure`. -- -- @since 4.8.0.0 die :: String -> IO a die err = hPutStrLn stderr err >> exitFailure #endif base-compat-0.8.2/src/Debug/0000755000000000000000000000000012524570365013730 5ustar0000000000000000base-compat-0.8.2/src/Debug/Trace/0000755000000000000000000000000012524570365014766 5ustar0000000000000000base-compat-0.8.2/src/Debug/Trace/Compat.hs0000644000000000000000000000223612524570365016550 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Debug.Trace.Compat ( module Base , traceId , traceShowId , traceM , traceShowM ) where import Debug.Trace as Base #if !(MIN_VERSION_base(4,7,0)) import Prelude.Compat {-| Like 'trace' but returns the message instead of a third value. /Since: 4.7.0.0/ -} traceId :: String -> String traceId a = trace a a {-| Like 'traceShow' but returns the shown value instead of a third value. /Since: 4.7.0.0/ -} traceShowId :: (Show a) => a -> a traceShowId a = trace (show a) a {-| Like 'trace' but returning unit in an arbitrary monad. Allows for convenient use in do-notation. Note that the application of 'trace' is not an action in the monad, as 'traceIO' is in the 'IO' monad. > ... = do > x <- ... > traceM $ "x: " ++ show x > y <- ... > traceM $ "y: " ++ show y /Since: 4.7.0.0/ -} traceM :: (Monad m) => String -> m () traceM string = trace string $ return () {-| Like 'traceM', but uses 'show' on the argument to convert it to a 'String'. > ... = do > x <- ... > traceMShow $ x > y <- ... > traceMShow $ x + y /Since: 4.7.0.0/ -} traceShowM :: (Show a, Monad m) => a -> m () traceShowM = traceM . show #endif base-compat-0.8.2/src/Prelude/0000755000000000000000000000000012524570365014302 5ustar0000000000000000base-compat-0.8.2/src/Prelude/Compat.hs0000644000000000000000000000546212524570365016070 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Prelude.Compat ( #if MIN_VERSION_base(4,8,0) module Base #else either , all , and , any , concat , concatMap , mapM_ , notElem , or , sequence_ , (<$>) , maybe , lines , unlines , unwords , words , curry , fst , snd , uncurry , ($!) , (++) , (.) , (=<<) , asTypeOf , const , flip , id , map , otherwise , until , ioError , userError , (!!) , break , cycle , drop , dropWhile , filter , head , init , iterate , last , lookup , repeat , replicate , reverse , scanl , scanl1 , scanr , scanr1 , span , splitAt , tail , take , takeWhile , unzip , unzip3 , zip , zip3 , zipWith , zipWith3 , subtract , lex , readParen , (^) , (^^) , even , fromIntegral , gcd , lcm , odd , realToFrac , showChar , showParen , showString , shows , appendFile , getChar , getContents , getLine , interact , print , putChar , putStr , putStrLn , readFile , readIO , readLn , writeFile , read , reads , (&&) , not , (||) , ($) , error , undefined , seq , elem , foldMap , foldl , foldl1 , foldr , foldr1 , length , maximum , minimum , null , product , sum , mapM , sequence , sequenceA , traverse , (*>) , (<*) , (<*>) , pure , (<$) , fmap , (>>) , (>>=) , fail , return , mappend , mconcat , mempty , maxBound , minBound , enumFrom , enumFromThen , enumFromThenTo , enumFromTo , fromEnum , pred , succ , toEnum , (**) , acos , acosh , asin , asinh , atan , atanh , cos , cosh , exp , log , logBase , pi , sin , sinh , sqrt , tan , tanh , atan2 , decodeFloat , encodeFloat , exponent , floatDigits , floatRadix , floatRange , isDenormalized , isIEEE , isInfinite , isNaN , isNegativeZero , scaleFloat , significand , (*) , (+) , (-) , abs , negate , signum , readList , readsPrec , (/) , fromRational , recip , div , divMod , mod , quot , quotRem , rem , toInteger , toRational , ceiling , floor , properFraction , round , truncate , show , showList , showsPrec , (/=) , (==) , (<) , (<=) , (>) , (>=) , compare , max , min -- classes , Applicative , Bounded , Enum , Eq , Floating , Foldable , Fractional , Functor , Integral , Monad , Monoid , Num (fromInteger) , Ord , Read , Real , RealFloat , RealFrac , Show , Traversable -- data types , IO , Char , Double , Float , Int , Integer , Word , Bool (True, False) , Either(Left, Right) , Maybe(Just, Nothing) , Ordering (EQ, GT, LT) -- type synonyms , FilePath , IOError , Rational , ReadS , ShowS , String #endif ) where #if MIN_VERSION_base(4,8,0) import Prelude as Base #else import Prelude hiding ( length , null , foldr , mapM , sequence , all , and , any , concat , concatMap , mapM , mapM_ , notElem , or , sequence , sequence_ , elem , foldl , foldl1 , foldr1 , maximum , minimum , product , sum ) import Data.Word import Data.Foldable.Compat import Data.Traversable import Data.Monoid import Control.Applicative #endif base-compat-0.8.2/src/Text/0000755000000000000000000000000012524570365013626 5ustar0000000000000000base-compat-0.8.2/src/Text/Read/0000755000000000000000000000000012524570365014501 5ustar0000000000000000base-compat-0.8.2/src/Text/Read/Compat.hs0000644000000000000000000000245512524570365016266 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Text.Read.Compat ( -- * The 'Read' class Read(..), ReadS, -- * Haskell 2010 functions reads, read, readParen, lex, -- * New parsing functions module Text.ParserCombinators.ReadPrec, L.Lexeme(..), lexP, parens, readListDefault, readListPrecDefault, readEither, readMaybe ) where import Text.Read import Text.ParserCombinators.ReadPrec import qualified Text.Read.Lex as L #if !(MIN_VERSION_base(4,6,0)) import Prelude.Compat import qualified Text.ParserCombinators.ReadP as P -- | Parse a string using the 'Read' instance. -- Succeeds if there is exactly one valid result. -- A 'Left' value indicates a parse error. -- -- /Since: 4.6.0.0/ readEither :: Read a => String -> Either String a readEither s = case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of [x] -> Right x [] -> Left "Prelude.read: no parse" _ -> Left "Prelude.read: ambiguous parse" where read' = do x <- readPrec lift P.skipSpaces return x -- | Parse a string using the 'Read' instance. -- Succeeds if there is exactly one valid result. -- -- /Since: 4.6.0.0/ readMaybe :: Read a => String -> Maybe a readMaybe s = case readEither s of Left _ -> Nothing Right a -> Just a #endif base-compat-0.8.2/src/Numeric/0000755000000000000000000000000012524570365014304 5ustar0000000000000000base-compat-0.8.2/src/Numeric/Compat.hs0000644000000000000000000000617712524570365016076 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Numeric.Compat ( module Base , showFFloatAlt , showGFloatAlt ) where import Numeric as Base #if !(MIN_VERSION_base(4,7,0)) import Data.Char (intToDigit) import GHC.Float import Prelude -- | Show a signed 'RealFloat' value -- using standard decimal notation (e.g. @245000@, @0.0015@). -- -- This behaves as 'showFFloat', except that a decimal point -- is always guaranteed, even if not needed. -- -- /Since: 4.7.0.0/ showFFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS showFFloatAlt d x = showString (formatRealFloatAlt FFFixed d True x) -- | Show a signed 'RealFloat' value -- using standard decimal notation for arguments whose absolute value lies -- between @0.1@ and @9,999,999@, and scientific notation otherwise. -- -- This behaves as 'showFFloat', except that a decimal point -- is always guaranteed, even if not needed. -- -- /Since: 4.7.0.0/ showGFloatAlt :: (RealFloat a) => Maybe Int -> a -> ShowS showGFloatAlt d x = showString (formatRealFloatAlt FFGeneric d True x) formatRealFloatAlt :: (RealFloat a) => FFFormat -> Maybe Int -> Bool -> a -> String formatRealFloatAlt fmt decs alt x | isNaN x = "NaN" | isInfinite x = if x < 0 then "-Infinity" else "Infinity" | x < 0 || isNegativeZero x = '-':doFmt fmt (floatToDigits (toInteger base) (-x)) | otherwise = doFmt fmt (floatToDigits (toInteger base) x) where base = 10 doFmt format (is, e) = let ds = map intToDigit is in case format of FFGeneric -> doFmt (if e < 0 || e > 7 then FFExponent else FFFixed) (is,e) FFExponent -> case decs of Nothing -> let show_e' = show (e-1) in case ds of "0" -> "0.0e0" [d] -> d : ".0e" ++ show_e' (d:ds') -> d : '.' : ds' ++ "e" ++ show_e' [] -> error "formatRealFloat/doFmt/FFExponent: []" Just dec -> let dec' = max dec 1 in case is of [0] -> '0' :'.' : take dec' (repeat '0') ++ "e0" _ -> let (ei,is') = roundTo base (dec'+1) is (d:ds') = map intToDigit (if ei > 0 then init is' else is') in d:'.':ds' ++ 'e':show (e-1+ei) FFFixed -> let mk0 ls = case ls of { "" -> "0" ; _ -> ls} in case decs of Nothing | e <= 0 -> "0." ++ replicate (-e) '0' ++ ds | otherwise -> let f 0 s rs = mk0 (reverse s) ++ '.':mk0 rs f n s "" = f (n-1) ('0':s) "" f n s (r:rs) = f (n-1) (r:s) rs in f e "" ds Just dec -> let dec' = max dec 0 in if e >= 0 then let (ei,is') = roundTo base (dec' + e) is (ls,rs) = splitAt (e+ei) (map intToDigit is') in mk0 ls ++ (if null rs && not alt then "" else '.':rs) else let (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is) d:ds' = map intToDigit (if ei > 0 then is' else 0:is') in d : (if null ds' && not alt then "" else '.':ds') #endif base-compat-0.8.2/src/Control/0000755000000000000000000000000012524570365014322 5ustar0000000000000000base-compat-0.8.2/src/Control/Monad/0000755000000000000000000000000012524570365015360 5ustar0000000000000000base-compat-0.8.2/src/Control/Monad/Compat.hs0000644000000000000000000000547712524570365017154 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Control.Monad.Compat ( module Base , Monad(..) , MonadPlus(..) #if !(MIN_VERSION_base(4,8,0)) , foldM , foldM_ , forM , forM_ , guard , mapM , mapM_ , msum , sequence , sequence_ , unless , when , (<$!>) #endif ) where #if MIN_VERSION_base(4,8,0) import Control.Monad as Base #else import Control.Monad as Base hiding ( foldM , foldM_ , forM , forM_ , guard , mapM , mapM_ , msum , sequence , sequence_ , unless , when ) import Control.Applicative (Alternative(..)) import Data.Foldable.Compat import Data.Traversable import Prelude.Compat #endif #if !(MIN_VERSION_base(4,8,0)) -- | Conditional execution of 'Applicative' expressions. For example, -- -- > when debug (putStrLn "Debugging") -- -- will output the string @Debugging@ if the Boolean value @debug@ -- is 'True', and otherwise do nothing. when :: (Applicative f) => Bool -> f () -> f () {-# INLINEABLE when #-} {-# SPECIALISE when :: Bool -> IO () -> IO () #-} {-# SPECIALISE when :: Bool -> Maybe () -> Maybe () #-} when p s = if p then s else pure () -- | @'guard' b@ is @'pure' ()@ if @b@ is 'True', -- and 'empty' if @b@ is 'False'. guard :: (Alternative f) => Bool -> f () guard True = pure () guard False = empty -- | The reverse of 'when'. unless :: (Applicative f) => Bool -> f () -> f () {-# INLINEABLE unless #-} {-# SPECIALISE unless :: Bool -> IO () -> IO () #-} {-# SPECIALISE unless :: Bool -> Maybe () -> Maybe () #-} unless p s = if p then pure () else s {- | The 'foldM' function is analogous to 'foldl', except that its result is encapsulated in a monad. Note that 'foldM' works from left-to-right over the list arguments. This could be an issue where @('>>')@ and the `folded function' are not commutative. > foldM f a1 [x1, x2, ..., xm] == > do > a2 <- f a1 x1 > a3 <- f a2 x2 > ... > f am xm If right-to-left evaluation is required, the input list should be reversed. Note: 'foldM' is the same as 'foldlM' -} foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b {-# INLINEABLE foldM #-} {-# SPECIALISE foldM :: (a -> b -> IO a) -> a -> [b] -> IO a #-} {-# SPECIALISE foldM :: (a -> b -> Maybe a) -> a -> [b] -> Maybe a #-} foldM = foldlM -- | Like 'foldM', but discards the result. foldM_ :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m () {-# INLINEABLE foldM_ #-} {-# SPECIALISE foldM_ :: (a -> b -> IO a) -> a -> [b] -> IO () #-} {-# SPECIALISE foldM_ :: (a -> b -> Maybe a) -> a -> [b] -> Maybe () #-} foldM_ f a xs = foldlM f a xs >> return () infixl 4 <$!> -- | Strict version of 'Data.Functor.<$>'. -- -- /Since: 4.8.0.0/ (<$!>) :: Monad m => (a -> b) -> m a -> m b {-# INLINE (<$!>) #-} f <$!> m = do x <- m let z = f x z `seq` return z #endif base-compat-0.8.2/src/Control/Concurrent/0000755000000000000000000000000012524570365016444 5ustar0000000000000000base-compat-0.8.2/src/Control/Concurrent/MVar/0000755000000000000000000000000012524570365017311 5ustar0000000000000000base-compat-0.8.2/src/Control/Concurrent/MVar/Compat.hs0000644000000000000000000000122712524570365021072 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Control.Concurrent.MVar.Compat ( module Base , withMVarMasked ) where import Control.Concurrent.MVar as Base #if !(MIN_VERSION_base(4,7,0)) import Control.Exception (mask_, onException) import Control.Monad (return) import Data.Function (($)) import System.IO (IO) {-| Like 'withMVar', but the @IO@ action in the second argument is executed with asynchronous exceptions masked. @since 4.7.0.0 -} {-# INLINE withMVarMasked #-} withMVarMasked :: MVar a -> (a -> IO b) -> IO b withMVarMasked m io = mask_ $ do a <- takeMVar m b <- io a `onException` putMVar m a putMVar m a return b #endif base-compat-0.8.2/src/Foreign/0000755000000000000000000000000012524570365014273 5ustar0000000000000000base-compat-0.8.2/src/Foreign/Compat.hs0000644000000000000000000000024312524570365016051 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} module Foreign.Compat ( module Base , module Marshal ) where import Foreign as Base import Foreign.Marshal.Compat as Marshal base-compat-0.8.2/src/Foreign/Marshal/0000755000000000000000000000000012524570365015662 5ustar0000000000000000base-compat-0.8.2/src/Foreign/Marshal/Compat.hs0000644000000000000000000000046212524570365017443 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Foreign.Marshal.Compat ( module Base , module Alloc , module Array , module Utils ) where import Foreign.Marshal as Base import Foreign.Marshal.Alloc.Compat as Alloc import Foreign.Marshal.Array.Compat as Array import Foreign.Marshal.Utils.Compat as Utils base-compat-0.8.2/src/Foreign/Marshal/Array/0000755000000000000000000000000012524570365016740 5ustar0000000000000000base-compat-0.8.2/src/Foreign/Marshal/Array/Compat.hs0000644000000000000000000000143712524570365020524 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} module Foreign.Marshal.Array.Compat ( module Base , callocArray , callocArray0 ) where import Foreign.Marshal.Array as Base #if !(MIN_VERSION_base(4,8,0)) import Foreign.Marshal.Alloc.Compat import Foreign.Ptr (Ptr) import Foreign.Storable (Storable(..)) import Prelude.Compat -- |Like 'mallocArray', but allocated memory is filled with bytes of value zero. -- callocArray :: Storable a => Int -> IO (Ptr a) callocArray = doCalloc undefined where doCalloc :: Storable a' => a' -> Int -> IO (Ptr a') doCalloc dummy size = callocBytes (size * sizeOf dummy) -- |Like 'callocArray0', but allocated memory is filled with bytes of value -- zero. -- callocArray0 :: Storable a => Int -> IO (Ptr a) callocArray0 size = callocArray (size + 1) #endif base-compat-0.8.2/src/Foreign/Marshal/Utils/0000755000000000000000000000000012524570365016762 5ustar0000000000000000base-compat-0.8.2/src/Foreign/Marshal/Utils/Compat.hs0000644000000000000000000000117412524570365020544 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} {-# LANGUAGE ForeignFunctionInterface #-} module Foreign.Marshal.Utils.Compat ( module Base , fillBytes ) where import Foreign.Marshal.Utils as Base #if !(MIN_VERSION_base(4,8,0)) import Data.Word (Word8) import Foreign.C.Types import Foreign.Ptr import Prelude -- |Fill a given number of bytes in memory area with a byte value. -- -- /Since: 4.8.0.0/ fillBytes :: Ptr a -> Word8 -> Int -> IO () fillBytes dest char size = do _ <- memset dest (fromIntegral char) (fromIntegral size) return () foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO (Ptr a) #endif base-compat-0.8.2/src/Foreign/Marshal/Alloc/0000755000000000000000000000000012524570365016714 5ustar0000000000000000base-compat-0.8.2/src/Foreign/Marshal/Alloc/Compat.hs0000644000000000000000000000237412524570365020501 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} {-# LANGUAGE ForeignFunctionInterface #-} module Foreign.Marshal.Alloc.Compat ( module Base , calloc , callocBytes ) where import Foreign.Marshal.Alloc as Base #if !(MIN_VERSION_base(4,8,0)) import Foreign.C.Types import Foreign.Ptr (Ptr, nullPtr) import Foreign.Storable (Storable(..)) import GHC.IO.Exception import Prelude.Compat -- |Like 'malloc' but memory is filled with bytes of value zero. -- {-# INLINE calloc #-} calloc :: Storable a => IO (Ptr a) calloc = doCalloc undefined where doCalloc :: Storable b => b -> IO (Ptr b) doCalloc dummy = callocBytes (sizeOf dummy) -- |Llike 'mallocBytes' but memory is filled with bytes of value zero. -- callocBytes :: Int -> IO (Ptr a) callocBytes size = failWhenNULL "calloc" $ _calloc 1 (fromIntegral size) -- asserts that the pointer returned from the action in the second argument is -- non-null -- failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a) failWhenNULL name f = do addr <- f if addr == nullPtr then ioError (IOError Nothing ResourceExhausted name "out of memory" Nothing Nothing) else return addr foreign import ccall unsafe "stdlib.h calloc" _calloc :: CSize -> CSize -> IO (Ptr a) #endif base-compat-0.8.2/test/0000755000000000000000000000000012524570365013072 5ustar0000000000000000base-compat-0.8.2/test/Spec.hs0000644000000000000000000000005412524570365014317 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}