base-orphans-0.4.5/0000755000000000000000000000000012634046535012300 5ustar0000000000000000base-orphans-0.4.5/Setup.hs0000644000000000000000000000005612634046535013735 0ustar0000000000000000import Distribution.Simple main = defaultMain base-orphans-0.4.5/README.markdown0000644000000000000000000000741012634046535015003 0ustar0000000000000000# `base-orphans` [![Hackage](https://img.shields.io/hackage/v/base-orphans.svg)][Hackage: base-orphans] [![Hackage Dependencies](https://img.shields.io/hackage-deps/v/base-orphans.svg)](http://packdeps.haskellers.com/reverse/base-orphans) [![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org] [![BSD3 License](http://img.shields.io/badge/license-MIT-brightgreen.svg)][tl;dr Legal: MIT] [![Build](https://img.shields.io/travis/haskell-compat/base-orphans.svg)](https://travis-ci.org/haskell-compat/base-orphans) [Hackage: base-orphans]: http://hackage.haskell.org/package/base-orphans "base-orphans package on Hackage" [Haskell.org]: http://www.haskell.org "The Haskell Programming Language" [tl;dr Legal: MIT]: https://tldrlegal.com/license/mit-license "MIT License" ## Scope `base-orphans` defines orphan instances that mimic instances available in later versions of `base` to a wider (older) range of compilers. `base-orphans` does not export anything except the orphan instances themselves and complements [base-compat](http://hackage.haskell.org/package/base-compat). Note that `base-orphans` doesn't cover every possible instance. See the [What is not covered](#what-is-not-covered) section for exceptions. ## Usage To use `base-orphans`, simply `import Data.Orphans ()`. ## What is covered * Added `Applicative` and `Alternative` instances for `ReadP` and `ReadPrec` * Added `Bits`, `Bounded`, and `Integral` instances for `CDev` * Added `Eq` and `Ord` instances for `Control.Exception.ErrorCall` * Added `Eq`, `Ord`, `Read`, and `Show` instances for data types in `GHC.Generics` * Added `Functor`, `Applicative`, `Alternative`, and `MonadPlus` instances for `ArrowMonad` * Added `Functor`, `Applicative`, and `Monad` instances for `First` and `Last` * Added `Monoid`, `Eq`, `Ord`, `Read`, and `Show` instances for `Const` * Added `Read` and `Show` instances for `Down` * Added `Eq`, `Ord`, `Read`, and `Show` instances for `ZipList` * Added `Monad` instance for `WrappedMonad` * Added `Data` and `IsList` instances for `Version` * `Applicative` instance for strict and lazy `ST` * `Bits` instance for `Bool` * `Foldable` instance for `Either`, `(,)` and `Const` * `Functor` instance for `Handler`, `ArgOrder`, `OptDescr`, and `ArgDescr` * `Num` instance for `Sum` and `Product` * `Read` instance for `Fixed` * `Show` instance for `Fingerprint` * `Storable` instance for `Complex` and `Ratio` * `Traversable` instance for `Either`, `(,)` and `Const` * `Typeable` instance for most data types, typeclasses, and promoted data constructors (when possible) ## What is not covered `base-orphans` does not define the following instances: * `Generic` or `Generic1` instances. These can be found in the [`Generics.Deriving.Instances`](https://hackage.haskell.org/package/generic-deriving-1.8.0/docs/Generics-Deriving-Instances.html) module of the [`generic-deriving`](https://hackage.haskell.org/package/generic-deriving) library. ## Supported versions of GHC/`base` * `ghc-7.10.2` / `base-4.8.1.0` * `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` We also make an attempt to keep `base-orphans` building with GHC HEAD, but due to its volatility, it may not work at any given point in time. If it doesn't, please report it! Patches are welcome; add tests for new code! base-orphans-0.4.5/LICENSE0000644000000000000000000000220412634046535013303 0ustar0000000000000000Copyright (c) 2015 Simon Hengel , João Cristóvão , 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-orphans-0.4.5/CHANGES.markdown0000644000000000000000000000471012634046535015116 0ustar0000000000000000## Changes in 0.4.5 - Import `Control.Monad.Instances` (which exports `Functor` and `Monad` instances for `(->) r`, and `Functor` instances for `(,) a` and `Either a`) on GHCs before 7.6. This ensures that these instances will always be in scope, and you won't have to import a module which is deprecated on recent GHC releases. - Fix build on GHC HEAD (again) ## Changes in 0.4.4 - Fix build on GHC HEAD ## Changes in 0.4.3 - Fix build on OSes where `HTYPE_DEV_T = Int32` (e.g., OS X) ## Changes in 0.4.2 - `Functor` instances for `Handler` - `Functor`. `Applicative`, `Alternative`, and `MonadPlus` instances for `ArrowMonad` - Expose `Read` and `Show` instances for `Down` on GHCs before 7.8 - `Bits`, `Bounded`, and `Integral` instances for `CDev` ## Changes in 0.4.1 - Fixed imports on GHC < 7.8 on Windows ## Changes in 0.4.0 - Removed all `Generic` and `Generic1` instances. These have been moved to the `generic-deriving` library. ## Changes in 0.3.3 - `Typeable` instances for `(~)`, `Any`, `Constraint`, `CSigset`, `Handler`, `Opaque`, `SPEC`, and every promotable data constructor in `base` ## Changes in 0.3.2 - `Storable (Complex a)` instance no longer requires a `RealFloat a` constraint if using `base-4.4` or later ## Changes in 0.3.1 - `Functor`, `Applicative`, and `Monad` instances for `First` and `Last` ## Changes in 0.3.0 - `Show` instance for `Fingerprint` - `Data.Orphans` is now `Trustworthy` - Backported the `Generic` and `Generic1` instances available in `base-4.7.0.0` to GHC 7.2, 7.4, and 7.6, namely * `Const`, `WrappedMonad`, and `ZipList` from `Control.Applicative` * `WrappedArrow` from `Control.Category` * `All`, `Any`, `Dual`, `Endo`, `First`, `Last`, `Product`, and `Sum` from `Data.Monoid` * `U1`, `Par1`, `Rec1`, `K1`, `M1`, `(:+:)`, `(:*:)`, `(:.:)`, `Arity`, `Associativity`, and `Fixity` from `GHC.Generics` ## Changes in 0.2.0 - Drop GHC 6.12 (and `base-4.2.0.0`) compatibility - Fix Windows, GHCJS build - `Read` instance for `Fixed` - `Applicative` instances for strict and lazy `ST` - `Typeable` instance for `SampleVar` - `Applicative` and `Alternative` instances for `ReadP` and `ReadPrec` - `Typeable` instance for `KProxy` - `Typeable` instances for more data types in `GHC.`-prefixed modules - `Generic` instances for `Arity`, `Associativity`, and `Fixity` from the `GHC.Generics` module - Corrected the `Generic` instance for `(:*:)` to work around GHC bug #9830 base-orphans-0.4.5/base-orphans.cabal0000644000000000000000000000510412634046535015646 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.8.0. -- -- see: https://github.com/sol/hpack name: base-orphans version: 0.4.5 synopsis: Backwards-compatible orphan instances for base description: @base-orphans@ defines orphan instances that mimic instances available in later versions of @base@ to a wider (older) range of compilers. @base-orphans@ does not export anything except the orphan instances themselves and complements @@. See the README for what instances are covered: . See also the section. category: Compatibility homepage: https://github.com/haskell-compat/base-orphans#readme bug-reports: https://github.com/haskell-compat/base-orphans/issues author: Simon Hengel , João Cristóvão , Ryan Scott maintainer: Simon Hengel , João Cristóvão , Ryan Scott copyright: (c) 2012-2015 Simon Hengel, (c) 2014 João Cristóvão, (c) 2015 Ryan Scott license: MIT license-file: LICENSE build-type: Simple cabal-version: >= 1.10 extra-source-files: CHANGES.markdown README.markdown source-repository head type: git location: https://github.com/haskell-compat/base-orphans library hs-source-dirs: src ghc-options: -Wall build-depends: base >= 4.3 && < 5, ghc-prim exposed-modules: Data.Orphans other-modules: Data.Orphans.Prelude default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test ghc-options: -Wall build-depends: base >= 4.3 && < 5, base-orphans, hspec == 2.*, QuickCheck other-modules: Control.Applicative.OrphansSpec Control.Exception.OrphansSpec Data.Bits.OrphansSpec Data.Foldable.OrphansSpec Data.Monoid.OrphansSpec Data.Traversable.OrphansSpec Data.Version.OrphansSpec Foreign.Storable.OrphansSpec GHC.Fingerprint.OrphansSpec System.Posix.Types.IntWord System.Posix.Types.OrphansSpec default-language: Haskell2010 base-orphans-0.4.5/test/0000755000000000000000000000000012634046535013257 5ustar0000000000000000base-orphans-0.4.5/test/Spec.hs0000644000000000000000000000005412634046535014504 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} base-orphans-0.4.5/test/System/0000755000000000000000000000000012634046535014543 5ustar0000000000000000base-orphans-0.4.5/test/System/Posix/0000755000000000000000000000000012634046535015645 5ustar0000000000000000base-orphans-0.4.5/test/System/Posix/Types/0000755000000000000000000000000012634046535016751 5ustar0000000000000000base-orphans-0.4.5/test/System/Posix/Types/OrphansSpec.hs0000644000000000000000000001061312634046535021533 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} module System.Posix.Types.OrphansSpec (main, spec) where #include "HsBaseConfig.h" import Test.Hspec #if defined(HTYPE_DEV_T) import Control.Applicative (liftA2) import Data.Bits (Bits(..)) import Data.Orphans () import System.Posix.Types.IntWord import System.Posix.Types import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (NonZero(..)) #endif main :: IO () main = hspec spec #if defined(HTYPE_DEV_T) type HDev = HTYPE_DEV_T spec :: Spec spec = describe "CDev" $ do describe "Bits instance" $ do prop "implements (.&.)" $ pred2HDevHDev (.&.) (.&.) prop "implements (.|.)" $ pred2HDevHDev (.|.) (.|.) prop "implements xor" $ pred2HDevHDev xor xor prop "implements shift" $ pred2IntHDev shift shift prop "implements rotate" $ pred2IntHDev rotate rotate prop "implements setBit" $ pred2IntHDev setBit setBit prop "implements clearBit" $ pred2IntHDev clearBit clearBit prop "implements complementBit" $ pred2IntHDev complementBit complementBit prop "implements testBit" $ pred2IntEq testBit testBit prop "implements complement" $ pred1HDevHDev complement complement prop "implements bit" $ pred1IntHDev bit bit prop "implements bitSize" $ pred1HDevEq bitSize bitSize prop "implements isSigned" $ pred1HDevEq isSigned isSigned describe "Bounded instance" $ do it "implements minBound" $ toInteger (minBound :: CDev) `shouldBe` toInteger (minBound :: HDev) it "implements maxBound" $ toInteger (maxBound :: CDev) `shouldBe` toInteger (maxBound :: HDev) describe "Integral instance" $ do prop "implements quot" $ pred2HDevHDev quot quot prop "implements rem" $ pred2HDevHDev rem rem prop "implements div" $ pred2HDevHDev div div prop "implements mod" $ pred2HDevHDev mod mod prop "implements quotRem" $ pred2HDevPair quotRem quotRem prop "implements divMod" $ pred2HDevPair divMod divMod prop "implements toInteger" $ pred1HDevEq toInteger toInteger eqCDevHDev :: CDev -> HDev -> Bool eqCDevHDev cDev hDev = toInteger cDev == toInteger hDev pred1Common :: (b -> c -> d) -> (a -> b) -> (a -> c) -> a -> d pred1Common = liftA2 pred1HDev :: (b -> c -> Bool) -> (CDev -> b) -> (HDev -> c) -> HDev -> Bool pred1HDev p f = pred1Common p (f . fromIntegral) pred1HDevEq :: Eq a => (CDev -> a) -> (HDev -> a) -> HDev -> Bool pred1HDevEq = pred1HDev (==) pred1HDevHDev :: (CDev -> CDev) -> (HDev -> HDev) -> HDev -> Bool pred1HDevHDev = pred1HDev eqCDevHDev pred1IntHDev :: (Int -> CDev) -> (Int -> HDev) -> Int -> Bool pred1IntHDev = pred1Common eqCDevHDev pred2Common :: (c -> d -> e) -> (a -> b -> c) -> (a -> b -> d) -> a -> b -> e pred2Common p f g x y = p (f x y) (g x y) pred2HDev :: (a -> b -> Bool) -> (CDev -> CDev -> a) -> (HDev -> HDev -> b) -> NonZero HDev -> NonZero HDev -> Bool pred2HDev eqv cDevPred hDevPred = pred2Common eqv (\nz1 nz2 -> cDevPred (fromIntegral $ getNonZero nz1) (fromIntegral $ getNonZero nz2)) (\nz1 nz2 -> hDevPred (getNonZero nz1) (getNonZero nz2)) pred2HDevHDev :: (CDev -> CDev -> CDev) -> (HDev -> HDev -> HDev) -> NonZero HDev -> NonZero HDev -> Bool pred2HDevHDev = pred2HDev eqCDevHDev pred2HDevPair :: (CDev -> CDev -> (CDev, CDev)) -> (HDev -> HDev -> (HDev, HDev)) -> NonZero HDev -> NonZero HDev -> Bool pred2HDevPair = pred2HDev $ \(cDev1, cDev2) (hDev1, hDev2) -> toInteger cDev1 == toInteger hDev1 && toInteger cDev2 == toInteger hDev2 pred2Int :: (a -> b -> Bool) -> (CDev -> Int -> a) -> (HDev -> Int -> b) -> HDev -> Int -> Bool pred2Int eqv cDevPred = pred2Common eqv (cDevPred . fromIntegral) pred2IntHDev :: (CDev -> Int -> CDev) -> (HDev -> Int -> HDev) -> HDev -> Int -> Bool pred2IntHDev = pred2Int eqCDevHDev pred2IntEq :: Eq a => (CDev -> Int -> a) -> (HDev -> Int -> a) -> HDev -> Int -> Bool pred2IntEq = pred2Int (==) #else spec :: Spec spec = return () #endifbase-orphans-0.4.5/test/System/Posix/Types/IntWord.hs0000644000000000000000000000016212634046535020672 0ustar0000000000000000module System.Posix.Types.IntWord (module IntWord) where import Data.Int as IntWord import Data.Word as IntWord base-orphans-0.4.5/test/GHC/0000755000000000000000000000000012634046535013660 5ustar0000000000000000base-orphans-0.4.5/test/GHC/Fingerprint/0000755000000000000000000000000012634046535016147 5ustar0000000000000000base-orphans-0.4.5/test/GHC/Fingerprint/OrphansSpec.hs0000644000000000000000000000111112634046535020722 0ustar0000000000000000{-# LANGUAGE CPP #-} module GHC.Fingerprint.OrphansSpec (main, spec) where import Test.Hspec #if MIN_VERSION_base(4,4,0) import Data.Orphans () import Data.Word (Word64) import GHC.Fingerprint.Type #endif main :: IO () main = hspec spec spec :: Spec spec = #if MIN_VERSION_base(4,4,0) describe "Fingerprint" $ it "has a Show instance" $ do let w1, w2 :: Word64 w1 = 0x0123456789abcdef w2 = 0x42 f :: Fingerprint f = Fingerprint w1 w2 show f `shouldBe` "0123456789abcdef0000000000000042" #else return () #endif base-orphans-0.4.5/test/Foreign/0000755000000000000000000000000012634046535014650 5ustar0000000000000000base-orphans-0.4.5/test/Foreign/Storable/0000755000000000000000000000000012634046535016423 5ustar0000000000000000base-orphans-0.4.5/test/Foreign/Storable/OrphansSpec.hs0000644000000000000000000000141512634046535021205 0ustar0000000000000000module Foreign.Storable.OrphansSpec (main, spec) where import Test.Hspec import Data.Complex import Data.Orphans () import Data.Ratio import Foreign.Storable main :: IO () main = hspec spec spec :: Spec spec = do describe "Storable Complex instance" $ do it "has twice the sizeOf its realPart" $ do sizeOf ((1 :: Double) :+ 2) `shouldBe` 2*sizeOf (1 :: Double) it "has the alignment of its realPart" $ do alignment ((1 :: Double) :+ 2) `shouldBe` alignment (1 :: Double) describe "Storable Ratio instance" $ do it "has twice the sizeOf its parameterized type" $ do sizeOf ((1 :: Int) % 2) `shouldBe` 2*sizeOf (1 :: Int) it "has the alignment of its parameterized type" $ do alignment ((1 :: Int) % 2) `shouldBe` alignment (1 :: Int) base-orphans-0.4.5/test/Data/0000755000000000000000000000000012634046535014130 5ustar0000000000000000base-orphans-0.4.5/test/Data/Version/0000755000000000000000000000000012634046535015555 5ustar0000000000000000base-orphans-0.4.5/test/Data/Version/OrphansSpec.hs0000644000000000000000000000115012634046535020333 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,7,0) {-# LANGUAGE OverloadedLists #-} #endif module Data.Version.OrphansSpec (main, spec) where import Test.Hspec import Data.Data import Data.Orphans () import Data.Version main :: IO () main = hspec spec spec :: Spec spec = do describe "Data Version instance" $ it "allows obtaining a Version constructor" $ dataTypeName (dataTypeOf (Version [1,2,3] [])) `shouldBe` "Data.Version.Version" #if MIN_VERSION_base(4,7,0) describe "IsList Version instance" $ it "creates a Version from an Int list" $ [1,2,3] `shouldBe` Version [1,2,3] [] #endif base-orphans-0.4.5/test/Data/Traversable/0000755000000000000000000000000012634046535016402 5ustar0000000000000000base-orphans-0.4.5/test/Data/Traversable/OrphansSpec.hs0000644000000000000000000000143612634046535021167 0ustar0000000000000000module Data.Traversable.OrphansSpec (main, spec) where import Test.Hspec import Control.Applicative import Data.Orphans () import Data.Traversable import Prelude main :: IO () main = hspec spec spec :: Spec spec = do describe "Either Traversable Instance" $ do it "traverses a Left value" $ traverse (:[]) (Left 5 :: Either Int String) `shouldBe` [Left 5] it "traverses a Right Value" $ traverse (:[]) (Right "aaa" :: Either Int String) `shouldBe` [Right "aaa"] describe "(,) a Traversable Instance" $ do it "traverses a (,) a value" $ traverse (:[]) (5::Int,"aaa") `shouldBe` [(5,"aaa")] describe "Const m Traversable Instance" $ do it "traverses a Const a value" $ do fmap getConst (traverse (:[]) (Const 5 :: Const Int String)) `shouldBe` [5] base-orphans-0.4.5/test/Data/Monoid/0000755000000000000000000000000012634046535015355 5ustar0000000000000000base-orphans-0.4.5/test/Data/Monoid/OrphansSpec.hs0000644000000000000000000000066412634046535020144 0ustar0000000000000000module Data.Monoid.OrphansSpec (main, spec) where import Test.Hspec import Data.Monoid import Data.Orphans () main :: IO () main = hspec spec spec :: Spec spec = do describe "Num (Sum a) instance" $ it "allows a Sum value to be created from a number" $ 1 `shouldBe` Sum (1 :: Int) describe "Num (Product a) instance" $ it "allows a Product value to be created from a number" $ 1 `shouldBe` Product (1 :: Int) base-orphans-0.4.5/test/Data/Foldable/0000755000000000000000000000000012634046535015640 5ustar0000000000000000base-orphans-0.4.5/test/Data/Foldable/OrphansSpec.hs0000644000000000000000000000273612634046535020431 0ustar0000000000000000module Data.Foldable.OrphansSpec (main, spec) where import Test.Hspec import Control.Applicative import Data.Foldable as F import Data.Monoid import Data.Orphans () import Prelude main :: IO () main = hspec spec spec :: Spec spec = do describe "Either Foldable Instance" $ do it "foldMap returns mempty for a Left value" $ foldMap (`mappend` "+") (Left "abc" :: Either String String) `shouldBe` mempty it "foldMap returns the result of the function on the Right value" $ foldMap (`mappend` "+") (Right "abc" :: Either String String) `shouldBe` "abc+" it "foldr returns the accumulator for a Left value" $ F.foldr mappend "+" (Left "abc" :: Either String String) `shouldBe` "+" it "foldr returns the result of the function on the Right value and accumulator" $ F.foldr mappend "+" (Right "abc" :: Either String String) `shouldBe` "abc+" describe "(,) Foldable Instance" $ do it "foldMap returns the result of the function applied to the second element" $ foldMap (`mappend` "+") ("xyz","abc") `shouldBe` "abc+" it "foldr returns the result of the function on the second element of the tuple and accumulator" $ F.foldr mappend "+" ("xyz","abc") `shouldBe` "abc+" describe "Const m Foldable Instance" $ do it "foldMap always returns mempty" $ foldMap (`mappend` "+") (Const "abc") `shouldBe` "" it "foldr applies the function to the accumulator and mempty" $ do F.foldr mappend "+" (Const "abc") `shouldBe` "+" base-orphans-0.4.5/test/Data/Bits/0000755000000000000000000000000012634046535015031 5ustar0000000000000000base-orphans-0.4.5/test/Data/Bits/OrphansSpec.hs0000644000000000000000000000077512634046535017623 0ustar0000000000000000{-# LANGUAGE CPP #-} module Data.Bits.OrphansSpec (main, spec) where import Test.Hspec #if MIN_VERSION_base(4,6,0) import Data.Bits import Data.Orphans () #endif main :: IO () main = hspec spec spec :: Spec spec = #if MIN_VERSION_base(4,6,0) describe "Bits Bool instance" $ it "allows bitwise operations on Bools" $ do True .&. True `shouldBe` True True .&. False `shouldBe` False False .&. True `shouldBe` False False .&. False `shouldBe` False #else return () #endif base-orphans-0.4.5/test/Control/0000755000000000000000000000000012634046535014677 5ustar0000000000000000base-orphans-0.4.5/test/Control/Exception/0000755000000000000000000000000012634046535016635 5ustar0000000000000000base-orphans-0.4.5/test/Control/Exception/OrphansSpec.hs0000644000000000000000000000057712634046535021427 0ustar0000000000000000module Control.Exception.OrphansSpec (main, spec) where import Test.Hspec import Control.Exception import Data.Orphans () main :: IO () main = hspec spec spec :: Spec spec = do describe "ErrorCall" $ do it "has an Eq instance" $ do ErrorCall "foo" `shouldBe` ErrorCall "foo" it "has an Ord instance" $ do ErrorCall "foo" `shouldSatisfy` (> ErrorCall "bar") base-orphans-0.4.5/test/Control/Applicative/0000755000000000000000000000000012634046535017140 5ustar0000000000000000base-orphans-0.4.5/test/Control/Applicative/OrphansSpec.hs0000644000000000000000000000210012634046535021712 0ustar0000000000000000module Control.Applicative.OrphansSpec (main, spec) where import Test.Hspec import Control.Applicative import Data.Orphans () import Data.Monoid import Prelude -- simplest one to use newtype Identity a = Identity { runIdentity :: a } instance Functor Identity where fmap f = Identity . f . runIdentity instance Applicative Identity where pure = Identity Identity f <*> x = f <$> x instance Monad Identity where return = Identity m >>= k = k (runIdentity m) main :: IO () main = hspec spec spec :: Spec spec = do describe "Monoid (Const a b)" $ do it "mempty returns an empty const" $ getConst (mempty :: (Const String Int)) `shouldBe` "" it "mappends const part" $ getConst ((Const "aaa" :: Const String Int) `mappend` (Const "bbb" :: Const String Int)) `shouldBe` "aaabbb" describe "Monad (WrappedMonad m)" $ it "allows to use a Monad interface in a WrappedMonad" $ (runIdentity . unwrapMonad $ (WrapMonad (return 1 :: Identity Int)) >> (WrapMonad (return 2 :: Identity Int))) `shouldBe` (2::Int) base-orphans-0.4.5/src/0000755000000000000000000000000012634046535013067 5ustar0000000000000000base-orphans-0.4.5/src/Data/0000755000000000000000000000000012634046535013740 5ustar0000000000000000base-orphans-0.4.5/src/Data/Orphans.hs0000644000000000000000000007745612634046535015731 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 {-# LANGUAGE DataKinds #-} {-# LANGUAGE NullaryTypeClasses #-} #endif {-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Exports orphan instances that mimic instances available in later versions of @base@. To use them, simply @import Data.Orphans ()@. -} module Data.Orphans () where #if !(MIN_VERSION_base(4,4,0)) import Control.Monad.ST as Strict #endif #if __GLASGOW_HASKELL__ >= 701 && __GLASGOW_HASKELL__ < 710 import GHC.Generics as Generics #endif #if !(MIN_VERSION_base(4,6,0)) import Control.Monad.Instances () #endif #if __GLASGOW_HASKELL__ < 710 import Control.Exception as Exception import Control.Monad.ST.Lazy as Lazy import Data.Data as Data import qualified Data.Foldable as F (Foldable(..)) import Data.Monoid as Monoid import qualified Data.Traversable as T (Traversable(..)) import GHC.Exts as Exts import GHC.IO.Exception as Exception import Text.ParserCombinators.ReadP as ReadP import Text.ParserCombinators.ReadPrec as ReadPrec import Text.Read as Read # if defined(mingw32_HOST_OS) import GHC.ConsoleHandler as Console # endif #endif #if !(MIN_VERSION_base(4,8,0)) import Data.Orphans.Prelude #endif #include "HsBaseConfig.h" ------------------------------------------------------------------------------- #if MIN_VERSION_base(4,4,0) && !(MIN_VERSION_base(4,7,0)) instance Show Fingerprint where show (Fingerprint w1 w2) = hex16 w1 ++ hex16 w2 where -- Formats a 64 bit number as 16 digits hex. hex16 :: Word64 -> String hex16 i = let hex = showHex i "" in replicate (16 - length hex) '0' ++ hex #endif #if !(MIN_VERSION_base(4,4,0)) instance HasResolution a => Read (Fixed a) where readsPrec _ = readsFixed readsFixed :: (HasResolution a) => ReadS (Fixed a) readsFixed = readsSigned where readsSigned ('-' : xs) = [ (negate x, rest) | (x, rest) <- readsUnsigned xs ] readsSigned xs = readsUnsigned xs readsUnsigned xs = case span isDigit xs of ([], _) -> [] (is, xs') -> let i = fromInteger (read is) in case xs' of '.' : xs'' -> case span isDigit xs'' of ([], _) -> [] (js, xs''') -> let j = fromInteger (read js) l = genericLength js :: Integer in [(i + (j / (10 ^ l)), xs''')] _ -> [(i, xs')] deriving instance Typeable1 SampleVar instance Applicative (Strict.ST s) where pure = return (<*>) = ap instance Applicative (Lazy.ST s) where pure = return (<*>) = ap #endif -- These instances are only valid if Bits isn't a subclass of Num (as Bool is -- not a Num instance), which is only true as of base-4.6.0.0 and later. #if MIN_VERSION_base(4,6,0) && !(MIN_VERSION_base(4,7,0)) instance Bits Bool where (.&.) = (&&) (.|.) = (||) xor = (/=) complement = not shift x 0 = x shift _ _ = False rotate x _ = x bit 0 = True bit _ = False testBit x 0 = x testBit _ _ = False bitSize _ = 1 isSigned _ = False popCount False = 0 popCount True = 1 #endif #if !(MIN_VERSION_base(4,6,0)) # if defined(HTYPE_DEV_T) # if MIN_VERSION_base(4,5,0) deriving instance Bits CDev deriving instance Bounded CDev deriving instance Integral CDev # else type HDev = HTYPE_DEV_T instance Bits CDev where (.&.) = unsafeCoerce ((.&.) :: HDev -> HDev -> HDev) (.|.) = unsafeCoerce ((.|.) :: HDev -> HDev -> HDev) xor = unsafeCoerce (xor :: HDev -> HDev -> HDev) shift = unsafeCoerce (shift :: HDev -> Int -> HDev) rotate = unsafeCoerce (rotate :: HDev -> Int -> HDev) setBit = unsafeCoerce (setBit :: HDev -> Int -> HDev) clearBit = unsafeCoerce (clearBit :: HDev -> Int -> HDev) complementBit = unsafeCoerce (complementBit :: HDev -> Int -> HDev) testBit = unsafeCoerce (testBit :: HDev -> Int -> Bool) complement = unsafeCoerce (complement :: HDev -> HDev) bit = unsafeCoerce (bit :: Int -> HDev) bitSize = unsafeCoerce (bitSize :: HDev -> Int) isSigned = unsafeCoerce (isSigned :: HDev -> Bool) instance Bounded CDev where minBound = unsafeCoerce (minBound :: HDev) maxBound = unsafeCoerce (maxBound :: HDev) instance Integral CDev where quot = unsafeCoerce (quot :: HDev -> HDev -> HDev) rem = unsafeCoerce (rem :: HDev -> HDev -> HDev) div = unsafeCoerce (div :: HDev -> HDev -> HDev) mod = unsafeCoerce (mod :: HDev -> HDev -> HDev) quotRem = unsafeCoerce (quotRem :: HDev -> HDev -> (HDev, HDev)) divMod = unsafeCoerce (divMod :: HDev -> HDev -> (HDev, HDev)) toInteger = unsafeCoerce (toInteger :: HDev -> Integer) # endif # endif instance Applicative ReadP where pure = return (<*>) = ap instance Alternative ReadP where empty = mzero (<|>) = mplus instance Applicative ReadPrec where pure = return (<*>) = ap instance Alternative ReadPrec where empty = mzero (<|>) = mplus instance Functor Exception.Handler where fmap f (Exception.Handler h) = Exception.Handler (fmap f . h) instance # if MIN_VERSION_base(4,4,0) Arrow a # else ArrowApply a # endif => Functor (ArrowMonad a) where fmap f (ArrowMonad m) = ArrowMonad $ m >>> arr f instance # if MIN_VERSION_base(4,4,0) Arrow a # else ArrowApply a # endif => Applicative (ArrowMonad a) where pure x = ArrowMonad (arr (const x)) ArrowMonad f <*> ArrowMonad x = ArrowMonad (f &&& x >>> arr (uncurry id)) instance # if MIN_VERSION_base(4,4,0) ArrowPlus a # else (ArrowApply a, ArrowPlus a) # endif => Alternative (ArrowMonad a) where empty = ArrowMonad zeroArrow ArrowMonad x <|> ArrowMonad y = ArrowMonad (x <+> y) instance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a) where mzero = ArrowMonad zeroArrow ArrowMonad x `mplus` ArrowMonad y = ArrowMonad (x <+> y) #endif #if !(MIN_VERSION_base(4,7,0)) deriving instance F.Foldable (Const m) deriving instance F.Foldable (Either a) deriving instance T.Traversable (Const m) deriving instance T.Traversable (Either a) instance F.Foldable ((,) a) where foldMap f (_, y) = f y foldr f z (_, y) = f y z instance T.Traversable ((,) a) where traverse f (x, y) = (,) x <$> f y deriving instance Monoid a => Monoid (Const a b) deriving instance Read a => Read (Down a) deriving instance Show a => Show (Down a) deriving instance Eq ErrorCall deriving instance Ord ErrorCall deriving instance Num a => Num (Sum a) deriving instance Num a => Num (Product a) deriving instance Data Version -- GHC Trac #8218 deriving instance Monad m => Monad (WrappedMonad m) deriving instance Eq a => Eq (ZipList a) deriving instance Ord a => Ord (ZipList a) deriving instance Read a => Read (ZipList a) deriving instance Show a => Show (ZipList a) deriving instance Functor ArgOrder deriving instance Functor OptDescr deriving instance Functor ArgDescr #endif #if __GLASGOW_HASKELL__ >= 701 && !(MIN_VERSION_base(4,7,0)) deriving instance Eq (U1 p) deriving instance Ord (U1 p) deriving instance Read (U1 p) deriving instance Show (U1 p) deriving instance Eq p => Eq (Par1 p) deriving instance Ord p => Ord (Par1 p) deriving instance Read p => Read (Par1 p) deriving instance Show p => Show (Par1 p) deriving instance Eq (f p) => Eq (Rec1 f p) deriving instance Ord (f p) => Ord (Rec1 f p) deriving instance Read (f p) => Read (Rec1 f p) deriving instance Show (f p) => Show (Rec1 f p) deriving instance Eq c => Eq (K1 i c p) deriving instance Ord c => Ord (K1 i c p) deriving instance Read c => Read (K1 i c p) deriving instance Show c => Show (K1 i c p) deriving instance Eq (f p) => Eq (M1 i c f p) deriving instance Ord (f p) => Ord (M1 i c f p) deriving instance Read (f p) => Read (M1 i c f p) deriving instance Show (f p) => Show (M1 i c f p) deriving instance (Eq (f p), Eq (g p)) => Eq ((f :+: g) p) deriving instance (Ord (f p), Ord (g p)) => Ord ((f :+: g) p) deriving instance (Read (f p), Read (g p)) => Read ((f :+: g) p) deriving instance (Show (f p), Show (g p)) => Show ((f :+: g) p) deriving instance (Eq (f p), Eq (g p)) => Eq ((f :*: g) p) deriving instance (Ord (f p), Ord (g p)) => Ord ((f :*: g) p) -- Due to a GHC bug (https://ghc.haskell.org/trac/ghc/ticket/9830), the derived -- Read and Show instances for infix data constructors will use the wrong -- precedence (prior to GHC 7.10). -- We'll manually derive Read :*: and Show :*: instances to avoid this. instance (Read (f p), Read (g p)) => Read ((f :*: g) p) where readPrec = parens . ReadPrec.prec 6 $ do fp <- ReadPrec.step readPrec Symbol ":*:" <- lexP gp <- ReadPrec.step readPrec return $ fp :*: gp readListPrec = readListPrecDefault instance (Show (f p), Show (g p)) => Show ((f :*: g) p) where showsPrec p (l :*: r) = showParen (p > sixPrec) $ showsPrec (sixPrec + 1) l . showString " :*: " . showsPrec (sixPrec + 1) r where sixPrec = 6 deriving instance Eq (f (g p)) => Eq ((f :.: g) p) deriving instance Ord (f (g p)) => Ord ((f :.: g) p) deriving instance Read (f (g p)) => Read ((f :.: g) p) deriving instance Show (f (g p)) => Show ((f :.: g) p) #endif #if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) -- | Construct tag-less 'Version' -- -- /Since: 4.8.0.0/ makeVersion :: [Int] -> Version makeVersion b = Version b [] -- | /Since: 4.8.0.0/ instance IsList Version where type (Item Version) = Int fromList = makeVersion toList = versionBranch #endif #if !(MIN_VERSION_base(4,8,0)) deriving instance Eq a => Eq (Const a b) deriving instance Ord a => Ord (Const a b) instance Read a => Read (Const a b) where readsPrec d = readParen (d > 10) $ \r -> [(Const x,t) | ("Const", s) <- lex r, (x, t) <- readsPrec 11 s] instance Show a => Show (Const a b) where showsPrec d (Const x) = showParen (d > 10) $ showString "Const " . showsPrec 11 x deriving instance Functor First deriving instance Applicative First deriving instance Monad First deriving instance Functor Last deriving instance Applicative Last deriving instance Monad Last -- In base-4.3 and earlier, pattern matching on a Complex value invokes a -- RealFloat constraint due to the use of the DatatypeContexts extension. # if MIN_VERSION_base(4,4,0) instance Storable a # else instance (Storable a, RealFloat a) # endif => Storable (Complex a) where sizeOf (a :+ _) = 2 * sizeOf a alignment (a :+ _) = alignment a peek p = do q <- return $ castPtr p r <- peek q i <- peekElemOff q 1 return (r :+ i) poke p (r :+ i) = do q <-return $ (castPtr p) poke q r pokeElemOff q 1 i instance (Storable a, Integral a) => Storable (Ratio a) where sizeOf (n :% _) = 2 * sizeOf n alignment (n :% _) = alignment n peek p = do q <- return $ castPtr p r <- peek q i <- peekElemOff q 1 return (r % i) poke p (r :% i) = do q <-return $ (castPtr p) poke q r pokeElemOff q 1 i #endif #if __GLASGOW_HASKELL__ < 710 deriving instance Typeable All deriving instance Typeable AnnotationWrapper deriving instance Typeable Monoid.Any deriving instance Typeable1 ArgDescr deriving instance Typeable1 ArgOrder deriving instance Typeable BlockReason deriving instance Typeable1 Buffer deriving instance Typeable3 BufferCodec deriving instance Typeable1 BufferList deriving instance Typeable BufferMode deriving instance Typeable BufferState deriving instance Typeable CFile deriving instance Typeable CFpos deriving instance Typeable CJmpBuf deriving instance Typeable2 Const deriving instance Typeable Constr deriving instance Typeable ConstrRep deriving instance Typeable DataRep deriving instance Typeable DataType deriving instance Typeable1 Dual deriving instance Typeable1 Endo deriving instance Typeable Errno deriving instance Typeable1 First deriving instance Typeable Data.Fixity deriving instance Typeable GeneralCategory deriving instance Typeable HandlePosn deriving instance Typeable1 Exception.Handler deriving instance Typeable HandleType deriving instance Typeable IODeviceType deriving instance Typeable IOErrorType deriving instance Typeable IOMode deriving instance Typeable1 Last deriving instance Typeable Lexeme deriving instance Typeable Newline deriving instance Typeable NewlineMode deriving instance Typeable Opaque deriving instance Typeable1 OptDescr deriving instance Typeable Pool deriving instance Typeable1 Product deriving instance Typeable1 ReadP deriving instance Typeable1 ReadPrec deriving instance Typeable SeekMode deriving instance Typeable2 Lazy.ST deriving instance Typeable2 STret deriving instance Typeable1 Sum deriving instance Typeable TextEncoding deriving instance Typeable ThreadStatus deriving instance Typeable1 ZipList # if defined(mingw32_HOST_OS) deriving instance Typeable CodePageArrays deriving instance Typeable2 CompactArray deriving instance Typeable1 ConvArray deriving instance Typeable Console.Handler # endif # if MIN_VERSION_base(4,3,0) deriving instance Typeable MaskingState # endif # if MIN_VERSION_base(4,4,0) deriving instance Typeable CodingFailureMode deriving instance Typeable CodingProgress deriving instance Typeable Fingerprint # if !defined(mingw32_HOST_OS) && !defined(__GHCJS__) deriving instance Typeable Event deriving instance Typeable EventManager deriving instance Typeable FdKey deriving instance Typeable TimeoutKey # endif # endif # if __GLASGOW_HASKELL__ >= 701 deriving instance Typeable Arity deriving instance Typeable Associativity deriving instance Typeable C deriving instance Typeable D deriving instance Typeable Generics.Fixity deriving instance Typeable3 K1 deriving instance Typeable NoSelector deriving instance Typeable P deriving instance Typeable1 Par1 deriving instance Typeable R deriving instance Typeable S deriving instance Typeable1 U1 deriving instance Typeable1 V1 # endif # if MIN_VERSION_base(4,5,0) deriving instance Typeable CostCentre deriving instance Typeable CostCentreStack deriving instance Typeable GCStats # endif # if MIN_VERSION_base(4,6,0) deriving instance Typeable CSigset deriving instance Typeable1 Down deriving instance Typeable ForeignPtrContents deriving instance Typeable Nat deriving instance Typeable1 NoIO deriving instance Typeable Symbol # endif # if MIN_VERSION_ghc_prim(0,3,1) deriving instance Typeable SPEC # endif # if MIN_VERSION_base(4,7,0) deriving instance Typeable FieldFormat deriving instance Typeable FormatAdjustment deriving instance Typeable FormatParse deriving instance Typeable FormatSign deriving instance Typeable KProxy deriving instance Typeable Number deriving instance Typeable SomeNat deriving instance Typeable SomeSymbol deriving instance Typeable QSem -- This instance seems to have been removed -- (accidentally?) in base-4.7.0.0 # endif # if __GLASGOW_HASKELL__ >= 708 -- Data types which have more than seven type arguments deriving instance Typeable (,,,,,,,) deriving instance Typeable (,,,,,,,,) deriving instance Typeable (,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) -- Data types which require PolyKinds deriving instance Typeable (:+:) deriving instance Typeable (:*:) deriving instance Typeable (:.:) deriving instance Typeable Exts.Any deriving instance Typeable ArrowMonad deriving instance Typeable Kleisli deriving instance Typeable M1 deriving instance Typeable Rec1 deriving instance Typeable WrappedArrow deriving instance Typeable WrappedMonad -- Typeclasses deriving instance Typeable Arrow deriving instance Typeable ArrowApply deriving instance Typeable ArrowChoice deriving instance Typeable ArrowLoop deriving instance Typeable ArrowZero deriving instance Typeable Bits deriving instance Typeable Bounded deriving instance Typeable BufferedIO deriving instance Typeable Category deriving instance Typeable Coercible deriving instance Typeable Constructor deriving instance Typeable Data deriving instance Typeable Datatype deriving instance Typeable Enum deriving instance Typeable Exception deriving instance Typeable Eq deriving instance Typeable FiniteBits deriving instance Typeable Floating deriving instance Typeable F.Foldable deriving instance Typeable Fractional deriving instance Typeable Functor deriving instance Typeable Generic deriving instance Typeable Generic1 deriving instance Typeable GHCiSandboxIO deriving instance Typeable HasResolution deriving instance Typeable HPrintfType deriving instance Typeable Integral deriving instance Typeable IODevice deriving instance Typeable IP deriving instance Typeable IsChar deriving instance Typeable IsList deriving instance Typeable IsString deriving instance Typeable Ix deriving instance Typeable KnownNat deriving instance Typeable KnownSymbol deriving instance Typeable Monad deriving instance Typeable MonadFix deriving instance Typeable MonadPlus deriving instance Typeable MonadZip deriving instance Typeable Num deriving instance Typeable Ord deriving instance Typeable PrintfArg deriving instance Typeable PrintfType deriving instance Typeable RawIO deriving instance Typeable Read deriving instance Typeable Real deriving instance Typeable RealFloat deriving instance Typeable RealFrac deriving instance Typeable Selector deriving instance Typeable Show deriving instance Typeable Storable deriving instance Typeable TestCoercion deriving instance Typeable TestEquality deriving instance Typeable T.Traversable deriving instance Typeable Typeable -- Constraints deriving instance Typeable (~) deriving instance Typeable Constraint -- Promoted data constructors deriving instance Typeable '() deriving instance Typeable '(,) deriving instance Typeable '(,,) deriving instance Typeable '(,,,) deriving instance Typeable '(,,,,) deriving instance Typeable '(,,,,,) deriving instance Typeable '(,,,,,,) deriving instance Typeable '(,,,,,,,) deriving instance Typeable '(,,,,,,,,) deriving instance Typeable '(,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable '[] deriving instance Typeable '(:) deriving instance Typeable '(:%) deriving instance Typeable '(:+) deriving instance Typeable 'AbsoluteSeek deriving instance Typeable 'All deriving instance Typeable 'AlreadyExists deriving instance Typeable 'Any deriving instance Typeable 'AppendHandle deriving instance Typeable 'AppendMode deriving instance Typeable 'BlockedIndefinitelyOnMVar deriving instance Typeable 'BlockedIndefinitelyOnSTM deriving instance Typeable 'BlockedOnBlackHole deriving instance Typeable 'BlockedOnException deriving instance Typeable 'BlockedOnForeignCall deriving instance Typeable 'BlockedOnMVar deriving instance Typeable 'BlockedOnOther deriving instance Typeable 'BlockedOnSTM deriving instance Typeable 'ClosedHandle deriving instance Typeable 'ClosePunctuation deriving instance Typeable 'ConnectorPunctuation deriving instance Typeable 'Const deriving instance Typeable 'Control deriving instance Typeable 'CRLF deriving instance Typeable 'CurrencySymbol deriving instance Typeable 'DashPunctuation deriving instance Typeable 'Deadlock deriving instance Typeable 'DecimalNumber deriving instance Typeable 'Denormal deriving instance Typeable 'Directory deriving instance Typeable 'DivideByZero deriving instance Typeable 'Down deriving instance Typeable 'Dual deriving instance Typeable 'EnclosingMark deriving instance Typeable 'Endo deriving instance Typeable 'Exception.EOF deriving instance Typeable 'EQ deriving instance Typeable 'ErrorOnCodingFailure deriving instance Typeable 'False deriving instance Typeable 'FinalQuote deriving instance Typeable 'First deriving instance Typeable 'ForceSpecConstr deriving instance Typeable 'Format deriving instance Typeable 'GT deriving instance Typeable 'HardwareFault deriving instance Typeable 'HeapOverflow deriving instance Typeable 'IgnoreCodingFailure deriving instance Typeable 'IllegalOperation deriving instance Typeable 'InappropriateType deriving instance Typeable 'Data.Infix deriving instance Typeable 'InitialQuote deriving instance Typeable 'InputUnderflow deriving instance Typeable 'Interrupted deriving instance Typeable 'InvalidArgument deriving instance Typeable 'InvalidSequence deriving instance Typeable 'Just deriving instance Typeable 'K1 deriving instance Typeable 'KProxy deriving instance Typeable 'Last deriving instance Typeable 'Left deriving instance Typeable 'LeftAdjust deriving instance Typeable 'LeftAssociative deriving instance Typeable 'LetterNumber deriving instance Typeable 'LF deriving instance Typeable 'LineSeparator deriving instance Typeable 'LossOfPrecision deriving instance Typeable 'LowercaseLetter deriving instance Typeable 'LT deriving instance Typeable 'MaskedInterruptible deriving instance Typeable 'MaskedUninterruptible deriving instance Typeable 'MathSymbol deriving instance Typeable 'ModifierLetter deriving instance Typeable 'ModifierSymbol deriving instance Typeable 'NestedAtomically deriving instance Typeable 'NewlineMode deriving instance Typeable 'NonSpacingMark deriving instance Typeable 'NonTermination deriving instance Typeable 'NoSpecConstr deriving instance Typeable 'NoSuchThing deriving instance Typeable 'NotAssigned deriving instance Typeable 'NotAssociative deriving instance Typeable 'Nothing deriving instance Typeable 'O deriving instance Typeable 'OpenPunctuation deriving instance Typeable 'OtherError deriving instance Typeable 'OtherLetter deriving instance Typeable 'OtherNumber deriving instance Typeable 'OtherPunctuation deriving instance Typeable 'OtherSymbol deriving instance Typeable 'OutputUnderflow deriving instance Typeable 'Overflow deriving instance Typeable 'Par1 deriving instance Typeable 'ParagraphSeparator deriving instance Typeable 'PermissionDenied deriving instance Typeable 'Data.Prefix deriving instance Typeable 'PrivateUse deriving instance Typeable 'Product deriving instance Typeable 'ProtocolError deriving instance Typeable 'RatioZeroDenominator deriving instance Typeable 'RawDevice deriving instance Typeable 'ReadBuffer deriving instance Typeable 'ReadHandle deriving instance Typeable 'ReadMode deriving instance Typeable 'ReadWriteHandle deriving instance Typeable 'ReadWriteMode deriving instance Typeable 'RegularFile deriving instance Typeable 'RelativeSeek deriving instance Typeable 'ResourceBusy deriving instance Typeable 'ResourceExhausted deriving instance Typeable 'ResourceVanished deriving instance Typeable 'Right deriving instance Typeable 'RightAssociative deriving instance Typeable 'RoundtripFailure deriving instance Typeable 'SeekFromEnd deriving instance Typeable 'SemiClosedHandle deriving instance Typeable 'SignPlus deriving instance Typeable 'SignSpace deriving instance Typeable 'Space deriving instance Typeable 'SpacingCombiningMark deriving instance Typeable 'SPEC deriving instance Typeable 'SPEC2 deriving instance Typeable 'StackOverflow deriving instance Typeable 'Stream deriving instance Typeable 'Sum deriving instance Typeable 'Surrogate deriving instance Typeable 'SystemError deriving instance Typeable 'ThreadBlocked deriving instance Typeable 'ThreadDied deriving instance Typeable 'ThreadFinished deriving instance Typeable 'ThreadKilled deriving instance Typeable 'ThreadRunning deriving instance Typeable 'TimeExpired deriving instance Typeable 'TitlecaseLetter deriving instance Typeable 'TransliterateCodingFailure deriving instance Typeable 'True deriving instance Typeable 'U1 deriving instance Typeable 'Underflow deriving instance Typeable 'Unmasked deriving instance Typeable 'UnsatisfiedConstraints deriving instance Typeable 'UnsupportedOperation deriving instance Typeable 'UppercaseLetter deriving instance Typeable 'UserError deriving instance Typeable 'UserInterrupt deriving instance Typeable 'WriteBuffer deriving instance Typeable 'WriteHandle deriving instance Typeable 'WriteMode deriving instance Typeable 'ZeroPad deriving instance Typeable 'ZipList # if defined(mingw32_HOST_OS) deriving instance Typeable 'Break deriving instance Typeable 'Close deriving instance Typeable 'ControlC deriving instance Typeable 'Logoff deriving instance Typeable 'Shutdown # endif # endif #endif base-orphans-0.4.5/src/Data/Orphans/0000755000000000000000000000000012634046535015352 5ustar0000000000000000base-orphans-0.4.5/src/Data/Orphans/Prelude.hs0000644000000000000000000000644612634046535017320 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-| Exports modules that Data.Orphans needs. Because Data.Orphans uses several modules that only need to be in scope for certain versions of GHC, exporting all of the modules separately eliminates the need to use CPP pragmas for GHC-version-specific imports. This makes it much easier to be -Wall-compliant. Note that this module does not export any modules that could introduce name clashes. -} module Data.Orphans.Prelude #if MIN_VERSION_base(4,8,0) () where #else (module OrphansPrelude) where import Control.Applicative as OrphansPrelude import Control.Arrow as OrphansPrelude hiding (loop) import Control.Category as OrphansPrelude hiding ((.), id) import Control.Concurrent.QSem as OrphansPrelude import Control.Monad as OrphansPrelude hiding (mapM, sequence) import Control.Monad.Fix as OrphansPrelude import Data.Bits as OrphansPrelude import Data.Char as OrphansPrelude import Data.Complex as OrphansPrelude (Complex(..)) import Data.Fixed as OrphansPrelude import Data.Int as OrphansPrelude import Data.Ix as OrphansPrelude import Data.List as OrphansPrelude (genericLength) import Data.Version as OrphansPrelude import Data.Word as OrphansPrelude import Foreign.C.Error as OrphansPrelude import Foreign.C.Types as OrphansPrelude import Foreign.Marshal.Pool as OrphansPrelude import Foreign.Ptr as OrphansPrelude (castPtr) import Foreign.Storable as OrphansPrelude import GHC.Base as OrphansPrelude import GHC.Conc as OrphansPrelude import GHC.Desugar as OrphansPrelude (AnnotationWrapper) import GHC.ForeignPtr as OrphansPrelude import GHC.IO.Buffer as OrphansPrelude import GHC.IO.BufferedIO as OrphansPrelude (BufferedIO) import GHC.IO.Device as OrphansPrelude (IODevice, IODeviceType(..), RawIO) import GHC.IO.Encoding as OrphansPrelude import GHC.IO.Handle as OrphansPrelude import GHC.IO.Handle.Types as OrphansPrelude import GHC.Real as OrphansPrelude (Ratio(..), (%)) import GHC.ST as OrphansPrelude import Numeric as OrphansPrelude (showHex) import System.Console.GetOpt as OrphansPrelude import System.IO as OrphansPrelude import System.Posix.Internals as OrphansPrelude import System.Posix.Types as OrphansPrelude import Text.Printf as OrphansPrelude import Unsafe.Coerce as OrphansPrelude (unsafeCoerce) # if defined(mingw32_HOST_OS) import GHC.IO.Encoding.CodePage.Table as OrphansPrelude # endif # if MIN_VERSION_base(4,4,0) import Control.Monad.Zip as OrphansPrelude import Data.Typeable.Internal as OrphansPrelude import GHC.Fingerprint as OrphansPrelude import GHC.IO.Encoding.Failure as OrphansPrelude # if !defined(mingw32_HOST_OS) && !defined(__GHCJS__) import GHC.Event as OrphansPrelude # endif # endif # if MIN_VERSION_base(4,5,0) import GHC.Stack as OrphansPrelude import GHC.Stats as OrphansPrelude # endif # if MIN_VERSION_base(4,6,0) import GHC.GHCi as OrphansPrelude import GHC.TypeLits as OrphansPrelude # endif # if MIN_VERSION_base(4,6,0) && !(MIN_VERSION_base(4,8,2)) import GHC.IP as OrphansPrelude # endif # if MIN_VERSION_base(4,7,0) import Data.Proxy as OrphansPrelude import Data.Type.Coercion as OrphansPrelude (Coercion, TestCoercion) import Data.Type.Equality as OrphansPrelude ((:~:), TestEquality) import Text.Read.Lex as OrphansPrelude (Number) # else import Control.Concurrent.SampleVar as OrphansPrelude # endif #endif