diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,187 @@ +## Changes in 0.9.4 [2026.01.10] + - Allow building with MicroHs. + +## Changes in 0.9.3 [2024.12.06] + - Backport new instances from GHC 9.12/`base-4.21`: + * `MonadFix` instance for `(,) a` + * `Eq1`, `Ord1`, `Read1`, and `Show1` instances for basic `GHC.Generics` + representation types + * `Show` instance for `UAddr` + - Drop support for pre-8.0 versions of GHC. + +## Changes in 0.9.2 [2024.04.30] + - Backport new instances from GHC 9.10/`base-4.20`: + * `Fractional`, `RealFrac`, `Floating`, and `RealFloat` instances for `Compose` + +## Changes in 0.9.1 [2023.10.11] + - Backport new instances from GHC 9.8/`base-4.19`: + * `Eq` and `Ord` instances for `SChar`, `SNat`, and `SSymbol` + * `Enum`, `Bounded`, `Num`, `Real`, and `Integral` instances for `Compose` + +## Changes in 0.9.0 [2023.03.05] + - Adapt to recent changes to `Down` instances: + * The `Bounded` instance for `Down` was changed in `base-4.15.0.0` to swap + the values of `minBound` and `maxBound` for the underlying type. This + change has now been propagated to `base-orphans`. + * The `Enum` instance for `Down` was removed in `base-4.15.0.0`, but a + different version of the instance was added back in `base-4.18.0.0`, where + `succ` and `pred` are swapped. We have changed the backported version of + this instance in `base-orphans` to match the behavior of the instance + added in `base-4.18.0.0`. + * The `Integral` instance for `Down` was removed from `base` entirely in + `base-4.15.0.0`. We have finally removed it from `base-orphans` in this + release, as it actively makes it more difficult to define the + aforementioned `Enum` instance. + +## Changes in 0.8.8.1 [2023.03.05] + - Fix GHC 9.4 build error that was accidentally introduced in + `base-orphans-0.8.8`. + +## Changes in 0.8.8 [2023.03.05] + - Backport new instances from GHC 9.6.1/`base-4.18.0.0`: + * `Functor` instances for the `(,,,,) a b c d`, `(,,,,,) a b c d e`, and + `(,,,,,) a b c d e f` tuple types. + * `Eq` and `Ord` instances for `Generically1` + +## Changes in 0.8.7 [2022.08.11] + - Backport new instances from GHC 9.2.2/`base-4.16.1.0`: + * `Ix` instances for various integral types in `Foreign.C.Types`, + `Foreign.Ptr`, and `System.Posix.Types`. For a complete list of such types, + see https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7385. + - Backport a bugfix for the `Ord1 Down` instance from GHC 9.4/`base-4.17` such + that it now uses reverse sort order. + +## Changes in 0.8.6 [2021.10.29] + - Backport `Eq`, `Ord`, `Bounded`, `Enum`, and `Ix` instances for `Solo`, + introduced in GHC 9.2/`base-4.16` + - Remove the backported `Eq1` and `Ord1` instances for `Fixed` that were + introduced in `base-orphans-0.8.5`. While these briefly appeared in a + release candidate version of GHC 9.2.1, they were ultimately removed from + the final 9.2.1 release. This release of `base-orphans` synchronizes with + that change. + +## Changes in 0.8.5 [2021.08.29] + - Backport new instances from GHC 9.2/`base-4.16` + * `Eq1`, `Read1`, and `Show1` instances for `Complex` + * `Eq1` and `Ord1` instances for `Fixed` + * `Eq{1,2}`, `Ord{1,2}`, `Show{1,2}`, and `Read{1,2}` instances for `(,,)` + and `(,,,)` + * `Semigroup` and `Monoid` instances for `Data.Functor.Product` and + `Data.Functor.Compose` + +## Changes in 0.8.4 [2020.12.09] + - Backport the `Ord` instances for `TyCon` and `TypeRep` to be available on + GHC 7.0. + +## Changes in 0.8.3 [2020.09.30] + - Backport new instances from GHC 9.0/`base-4.15` + * `MonadFix` and `MonadZip` instances for `Complex` + * `Ix` instances for tuples of size 6 through 15 + +## Changes in 0.8.2 [2020.01.27] + - Backport new instances from GHC 8.10/`base-4.14` + * `Bits`, `Bounded`, `Enum`, `FiniteBits`, `Floating`, `Fractional`, + `Integral`, `Ix`, `Real`, `RealFrac`, `RealFloat` and `Storable` instances + for `Data.Ord.Down` + * `Functor`, `Applicative`, `Monad`, `Alternative`, and `MonadPlus` instances + for `Kleisli` + * `Functor`, `Applicative`, and `Monad` instances for + `(,,) a b` and `(,,,) a b c` + * `Data` instances for `WrappedArrow` and `WrappedMonad` + * `Data` and `IsList` instances for `ZipList` + * `TestEquality` instance for `Compose` + - Backport the `Typeable (() :: Constraint)` instance to be available on + GHC 7.8. + +## Changes in 0.8.1 [2019.03.25] + - Ensure that the test suite passes non-negative numbers to `Bits` methods + that require them, such as `bit`, `setBit`, `clearBit`, `complementBit`, + and `testBit`. + +## Changes in 0.8 [2018.07.02] + - Backported new instance from GHC 8.6/`base-4.12` + * Data types in `GHC.Generics`: + - `Applicative` instance for `K1` + - `Semigroup` instances for `U1`, `Par1`, `Rec1`, `K1`, `M1`, `(:*:)`, `(:.:)`, and `V1` + - `Monoid` instances for `U1`, `Par1`, `Rec1`, `K1`, `M1`, `(:*:)`, and `(:.:)` + * `Foldable` and `Traversable` instances for `Data.Monoid.Alt` + * `MonadFix`, `MonadZip`, `Data`, `Foldable`, `Traversable`, `Eq1`, `Ord1`, + `Read1`, and `Show1` instances for `Data.Ord.Down` + +## Changes in 0.7 [2018.03.08] + - Backported new instances from GHC 8.4/`base-4.11` + * `Alternative` instance for `ZipList` + * `Data` instance for `IntPtr` and `WordPtr` + * `Num`, `Functor`, `Applicative`, `Monad`, `Semigroup`, and `Monoid` + instances for `Data.Ord.Down` + * `MonadFail`, `Semigroup`, and `Monoid` instances for strict `ST` + +## Changes in 0.6 [2017.04.10] + - Backported new instances from GHC 8.2/`base-4.10` + (see https://github.com/haskell-compat/base-orphans/issues/39): + * `Data` instance for `Const` + * `Eq1`, `Ord1`, `Read1`, and `Show1` instances for `NonEmpty` + * `Semigroup` instances for `IO`, `Event`, and `Lifetime` + - Backported `Typeable` instances for `(:+:)`, `(:*:)`, `(:.:)`, `M1`, `Rec1`, + `ArrowMonad`, `Kleisli`, `WrappedArrow`, `WrappedMonad`, and `Any` on GHC + 7.6 and earlier + - Backported `Data` instances for `(:+:)`, `(:*:)`, `(:.:)`, `M1`, and `Rec1` + on GHC 7.6 and earlier + +## Changes in 0.5.4 + - Backported `Bits`, `FiniteBits`, `Floating`, `Fractional`, `Integral`, + `IsString`, `Num`, `Real`, `RealFloat`, and `RealFrac` instances for + `Identity` and `Const` (introduced in `base-4.9`) + +## Changes in 0.5.3 + - Backported `Alternative`, `MonadPlus` and `MonadZip` instances for `U1` and + `Proxy`, and made the `Functor`, `Foldable`, `Traversable`, `Alternative`, + and `Monad` instances for `U1` lazier to correspond with `base-4.9` + +## Changes in 0.5.2 + - Backported `Enum`, `Bounded`, `Ix`, `Functor`, `Applicative`, `Monad`, + `MonadFix`, `MonadPlus`, `MonadZip`, `Foldable`, `Traversable`, and + `Data` instances for datatypes in the `GHC.Generics` module (introduced in + `base-4.9`) + +## Changes in 0.5.1 + - The `Storable` instances for `Complex` and `Ratio` are now exactly as lazy + as their counterparts in `base` (see issue + [#36](https://github.com/haskell-compat/base-orphans/issues/36)) + +## Changes in 0.5.0 + - GHC 8.0 compatibility + - Backported instances introduced in GHC 8.0/`base-4.9` + (see https://github.com/haskell-compat/base-orphans/issues/32) + +## 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` diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015 Simon Hengel , João Cristóvão , Ryan Scott +Copyright (c) 2015-2017 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 diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,5 +1,20 @@ -# `base-orphans` [![Hackage version](https://img.shields.io/hackage/v/base-orphans.svg?style=flat)](http://hackage.haskell.org/package/base-orphans) [![Build Status](https://img.shields.io/travis/haskell-compat/base-orphans.svg?style=flat)](https://travis-ci.org/haskell-compat/base-orphans) +# `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 Status](https://github.com/haskell-compat/base-orphans/workflows/Haskell-CI/badge.svg)](https://github.com/haskell-compat/base-orphans/actions?query=workflow%3AHaskell-CI) +[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 @@ -7,52 +22,109 @@ 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 `Eq` and `Ord` instances for `Control.Exception.ErrorCall` - * Added `Eq`, `Ord`, `Read`, and `Show` instances for data types in `GHC.Generics` - * 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` + * `Alternative`, `MonadPlus`, and `MonadZip` instances for `Proxy` + * `Alternative`, `Applicative`, `Bounded`, `Data`, `Enum`, `Foldable`, `Functor`, `Ix`, `Monad`, `MonadFix`, `MonadPlus`, `MonadZip`, and `Traversable` instances for data types in `GHC.Generics` + * `Alternative`, `Eq`, `Ord`, `Read`, `Show`, `Foldable`, and `Traversable` instances for `ZipList` + * `Applicative` instance for `K1` from `GHC.Generics` + * `Applicative`, `Bits`, `Bounded`, `Data`, `Enum`, `Eq1`, `FiniteBits`, + `Floating`, `Foldable`, `Fractional`, `Functor`, `Ix`, `Ord1`, + `Monad`, `MonadFix`, `MonadZip`, `Monoid`, `Num`, `Read`, `Read1`, `Real`, + `RealFloat`, `RealFrac`, `Semigroup`, `Show`, `Show1`, `Storable`, and + `Traversable` instances for `Down` + * `Applicative` and `Alternative` instances for `ReadP` and `ReadPrec` * `Applicative` instance for strict and lazy `ST` + * `Applicative`, `Foldable`, `Functor`, `Monad`, and `Traversable` instances for `Complex`, + `Dual`, `First`, `Last`, `Product`, and `Sum` * `Bits` instance for `Bool` - * `Generic` instances for the data types in `GHC.Generics` - * `Generic` instance for `All`, `Any`, `Const`, `Dual`, `Endo`, `First`, `Last`, `Product`, `Sum`, `WrappedArrow`, `WrappedMonad`, and `ZipList` - * `Generic1` instance for `Const`, `Dual`, `First`, `Last`, `Product`, `Sum`, `WrappedArrow`, `WrappedMonad`, and `ZipList` + * `Bits`, `Bounded`, and `Integral` instances for `CDev` + * `Bits`, `Bounded`, `Enum`, `FiniteBits`, `Floating`, `Fractional`, `Integral`, `IsString`, `Ix`, `Num`, `Real`, `RealFloat`, `RealFrac`, and `Storable` instances for `Const` and `Identity` + * `Data` instances for `All`, `Any`, and `Const`, `IntPtr`, `WordPtr`, + `WrappedArrow` and `WrappedMonad` + * `Data`, `MonadFix` and `MonadZip` instances for `Alt`, `Dual`, `First`, `Last`, + `Product`, and `Sum` + * `Data` and `IsList` instances for `Version` and `ZipList` + * `Eq{1,2}`, `Ord{1,2}`, `Show{1,2}`, and `Read{1,2}` instances for `(,,)` and `(,,,)` + * `Eq` and `Ord` instances for `Control.Exception.ErrorCall` + * `Eq`, `Ord`, `Read`, and `Show` instances for data types in `GHC.Generics` + * `Eq`, `Ord`, `Bounded`, `Enum`, and `Ix` instances for `Solo` + * `Eq` and `Ord` instances for `Generically1` + * `Eq` and `Ord` instances for `SChar`, `SNat`, and `SSymbol` + * `Eq1`, `Read1`, and `Show1` instances for `Complex` + * `Eq1`, `Ord1`, `Read1`, and `Show1` instances for `NonEmpty` + * `Eq1`, `Ord1`, `Read1`, and `Show1` instances for basic `GHC.Generics` representation types + * `Enum`, `Bounded`, `Num`, `Real`, `Integral`, `Fractional`, `RealFrac`, `Floating`, and `RealFloat` instances for `Compose` * `Foldable` instance for `Either`, `(,)` and `Const` - * `Functor` instance for `ArgOrder`, `OptDescr`, and `ArgDescr` + * `Foldable` and `Traversable` instances for `Alt` from `Data.Monoid` + * `Functor`, `Applicative`, and `Monad` instances for + `(,,) a b` and `(,,,) a b c` + * `Functor` instances for `(,,,,) a b c d`, `(,,,,,) a b c d e`, and + `(,,,,,) a b c d e f` + * `Functor` instance for `Handler`, `ArgOrder`, `OptDescr`, and `ArgDescr` + * `Functor`, `Applicative`, `Alternative`, and `MonadPlus` instances for `ArrowMonad` + * `Functor`, `Applicative`, `Monad`, `Alternative`, and `MonadPlus` instances + for `Kleisli` + * `Ix` instances for tuples of size 6 through 15 + * `Ix` instances for integral types in `Foreign.C.Types`, `Foreign.Ptr`, and `System.Posix.Types` + * `Monad` instance for `(,)` + * `Monad` instance for `WrappedMonad` + * `MonadFail`, `Monoid`, and `Semigroup` instances for strict `ST` + * `MonadFix` instance for `(,) a` + * `MonadFix` and `MonadZip` instances for `Complex` + * `MonadZip` instance for `Maybe` + * `Monoid`, `Eq`, `Ord`, `Read`, and `Show` instances for `Const` + * `Monoid` instances for `Identity` and `IO` * `Num` instance for `Sum` and `Product` * `Read` instance for `Fixed` + * `Semigroup` instances for `IO`, `Event` and `Lifetime` + * `Semigroup` instances for `V1`, `U1`, `Par1`, `Rec1`, `K1`, `M1`, `(:*:)`, and `(:.:)` from `GHC.Generics`. + `Monoid` instances for the same types (except `V1`). + * `Semigroup` and `Monoid` instances for `Data.Functor.Product` and `Data.Functor.Compose` * `Show` instance for `Fingerprint` - * `Storable` instance for `Complex` and `Ratio` + * `Show` instance for `UAddr` + * `Storable` instance for `()`, `Complex`, and `Ratio` + * `TestEquality` instance for `Compose` * `Traversable` instance for `Either`, `(,)` and `Const` + * `Ord` instance for `TyCon` and `TypeRep`. * `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. +* The `Alternative IO` and `MonadPlus IO` instances. These can be found in the + [`Control.Monad.Trans.Error`](http://hackage.haskell.org/package/transformers-0.4.3.0/docs/src/Control-Monad-Trans-Error.html#line-69) + module of the [`transformers`](http://hackage.haskell.org/package/transformers) library. + ## 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` + * `ghc-9.12.*` / `base-4.21.*` + * `ghc-9.10.*` / `base-4.20.*` + * `ghc-9.8.*` / `base-4.19.*` + * `ghc-9.6.*` / `base-4.18.*` + * `ghc-9.4.*` / `base-4.17.*` + * `ghc-9.2.*` / `base-4.16.*` + * `ghc-9.0.*` / `base-4.15.*` + * `ghc-8.10.*` / `base-4.14.*` + * `ghc-8.8.*` / `base-4.13.*` + * `ghc-8.6.*` / `base-4.12.*` + * `ghc-8.4.*` / `base-4.11.*` + * `ghc-8.2.*` / `base-4.10.*` + * `ghc-8.0.*` / `base-4.9.*` + +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! diff --git a/base-orphans.cabal b/base-orphans.cabal --- a/base-orphans.cabal +++ b/base-orphans.cabal @@ -1,53 +1,77 @@ --- This file has been generated from package.yaml by hpack version 0.3.2. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack +-- +-- hash: 459819c97f970a9f10f930c19a33ad7c14c34c1056852f4b0c57fa8e8487e8ca name: base-orphans -version: 0.3.3 +version: 0.9.4 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 -license: MIT -license-file: LICENSE author: Simon Hengel , João Cristóvão , - Ryan Scott + 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 -category: Compatibility + Ryan Scott +copyright: (c) 2012-2017 Simon Hengel, + (c) 2014-2017 João Cristóvão, + (c) 2015-2017 Ryan Scott +license: MIT +license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 -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: - +tested-with: + GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.8 , GHC == 9.4.8 , GHC == 9.6.7 , GHC == 9.8.4 , GHC == 9.10.3 , GHC == 9.12.2 , GHC == 9.14.1 extra-source-files: - CHANGES.markdown - README.markdown + CHANGES.markdown + README.markdown source-repository head type: git location: https://github.com/haskell-compat/base-orphans library - hs-source-dirs: src + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + base >=4.9 && <5 exposed-modules: Data.Orphans - build-depends: - base >= 4.3 && < 5 - - , ghc-prim - ghc-options: -Wall + other-modules: + Data.Orphans.Prelude default-language: Haskell2010 + if impl(ghc >= 9.0) && !impl(ghc >= 9.2) + build-depends: + ghc-prim test-suite spec type: exitcode-stdio-1.0 - hs-source-dirs: test main-is: Spec.hs + hs-source-dirs: + test + ghc-options: -Wall + build-depends: + QuickCheck + , base >=4.9 && <5 + , base-orphans + , hspec ==2.* + build-tool-depends: hspec-discover:hspec-discover == 2.* other-modules: Control.Applicative.OrphansSpec Control.Exception.OrphansSpec @@ -58,10 +82,7 @@ Data.Version.OrphansSpec Foreign.Storable.OrphansSpec GHC.Fingerprint.OrphansSpec - build-depends: - base >= 4.3 && < 5 - - , base-orphans - , hspec == 2.* - ghc-options: -Wall + System.Posix.Types.IntWord + System.Posix.Types.OrphansSpec + Paths_base_orphans default-language: Haskell2010 diff --git a/src/Data/Orphans.hs b/src/Data/Orphans.hs --- a/src/Data/Orphans.hs +++ b/src/Data/Orphans.hs @@ -1,1686 +1,1523 @@ -{-# 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) && !(MIN_VERSION_base(4,7,0)) -import Data.Word (Word64) -import Numeric (showHex) -#endif - -#if !(MIN_VERSION_base(4,4,0)) -import Control.Concurrent.SampleVar -import Control.Monad.ST as Strict -import Data.List -#endif - -#if !(MIN_VERSION_base(4,4,0)) || (__GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710) -import Data.Fixed -#endif - -#if MIN_VERSION_base(4,4,0) && __GLASGOW_HASKELL__ < 710 -import GHC.Fingerprint -import GHC.IO.Encoding.Failure - -# if !defined(mingw32_HOST_OS) && !defined(__GHCJS__) -import GHC.Event -# endif -#endif - -#if __GLASGOW_HASKELL__ >= 701 && __GLASGOW_HASKELL__ < 710 -import GHC.Generics as Generics -# endif - -#if MIN_VERSION_base(4,5,0) && __GLASGOW_HASKELL__ < 710 -import GHC.Stack -import GHC.Stats -#endif - -#if MIN_VERSION_base(4,6,0) && __GLASGOW_HASKELL__ < 710 -import Data.Bits -import Data.Ord -import GHC.ForeignPtr -import GHC.GHCi -import GHC.TypeLits -import System.Posix.Internals -#endif - -#if !(MIN_VERSION_base(4,6,0)) -import Control.Monad (ap, mplus, mzero) -#endif - -#if MIN_VERSION_base(4,7,0) && __GLASGOW_HASKELL__ < 710 -import Control.Concurrent.QSem -import Data.Proxy -import Text.Read.Lex (Number) -# endif - -#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 -import Control.Arrow -import Control.Category hiding ((.)) -import Control.Monad -import Control.Monad.Fix -import Control.Monad.Zip -import Data.Ix -import Data.Type.Coercion -import Data.Type.Equality -import Data.Typeable.Internal -import GHC.Exts as Exts -import GHC.IO.BufferedIO -import GHC.IO.Device (IODevice, RawIO) -import GHC.IO.Handle -import GHC.IO.Handle.Types hiding (BufferList, HandleType) -import GHC.IP -import Text.Printf - -# if defined(mingw32_HOST_OS) -import GHC.ConsoleHandler as Console -# endif -#endif - -#if !(MIN_VERSION_base(4,8,0)) -import Data.Complex (Complex(..)) -import Data.Version -import Foreign.Ptr (castPtr) -import GHC.Real (Ratio(..), (%)) -#endif - -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative -import Control.Exception as Exception -import Control.Monad.ST.Lazy as Lazy -import Data.Char -import Data.Data as Data -import Data.Foldable -import Data.Monoid as Monoid -import Data.Traversable -import Foreign.C.Error -import Foreign.C.Types -import Foreign.Marshal.Pool -import Foreign.Storable -import GHC.Base -import GHC.Conc -import GHC.Desugar -import GHC.IO.Buffer -import GHC.IO.Device (IODeviceType(..)) -import GHC.IO.Encoding -import GHC.IO.Exception as Exception -import GHC.IO.Handle.Types (BufferList, HandleType) -import GHC.ST -import System.Console.GetOpt -import System.IO -import Text.ParserCombinators.ReadP -import Text.ParserCombinators.ReadPrec as ReadPrec -import Text.Read as Read - -# if defined(mingw32_HOST_OS) -import GHC.IO.Encoding.CodePage.Table -# endif -#endif - -------------------------------------------------------------------------------- - -#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 - -deriving instance Read a => Read (Down a) -deriving instance Show a => Show (Down a) -#endif - -#if !(MIN_VERSION_base(4,6,0)) -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 -#endif - -#if !(MIN_VERSION_base(4,7,0)) -deriving instance Foldable (Const m) -deriving instance Foldable (Either a) -deriving instance Traversable (Const m) -deriving instance Traversable (Either a) - -instance Foldable ((,) a) where - foldMap f (_, y) = f y - - foldr f z (_, y) = f y z - -instance Traversable ((,) a) where - traverse f (x, y) = (,) x <$> f y - -deriving instance Monoid a => Monoid (Const a b) -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)) ------ --- Although DeriveGeneric has been around since GHC 7.2, various bugs cause --- standalone Generic instances to fail to compile unless a fairly recent --- version of GHC is used. For this reason, we manually implement all Generic --- and Generic1 instances to maintain GHC 7.2 and 7.4 support. ------ - -instance Generic All where - type Rep All = D1 D1All (C1 C1_0All (S1 S1_0_0All (Rec0 Bool))) - from (All a) = M1 (M1 (M1 (K1 a))) - to (M1 (M1 (M1 (K1 a)))) = All a - -data D1All -data C1_0All -data S1_0_0All - -instance Datatype D1All where - datatypeName _ = "All" - moduleName _ = "Data.Monoid" - -instance Constructor C1_0All where - conName _ = "All" - conIsRecord _ = True - -instance Selector S1_0_0All where - selName _ = "getAll" - ------ - -instance Generic Monoid.Any where - type Rep Monoid.Any = D1 D1Any (C1 C1_0Any (S1 S1_0_0Any (Rec0 Bool))) - from (Any a) = M1 (M1 (M1 (K1 a))) - to (M1 (M1 (M1 (K1 a)))) = Any a - -data D1Any -data C1_0Any -data S1_0_0Any - -instance Datatype D1Any where - datatypeName _ = "Any" - moduleName _ = "Data.Monoid" - -instance Constructor C1_0Any where - conName _ = "Any" - conIsRecord _ = True - -instance Selector S1_0_0Any where - selName _ = "getAny" - ------ - -instance Generic Arity where - type Rep Arity = D1 D1Arity (C1 C1_0Arity U1 - :+: C1 C1_1Arity (S1 NoSelector (Rec0 Int))) - - from NoArity = M1 (L1 (M1 U1)) - from (Arity a) = M1 (R1 (M1 (M1 (K1 a)))) - - to (M1 (L1 (M1 U1))) = NoArity - to (M1 (R1 (M1 (M1 (K1 a))))) = Arity a - -data D1Arity -data C1_0Arity -data C1_1Arity - -instance Datatype D1Arity where - datatypeName _ = "Arity" - moduleName _ = "GHC.Generics" - -instance Constructor C1_0Arity where - conName _ = "NoArity" - -instance Constructor C1_1Arity where - conName _ = "Arity" - ------ - -instance Generic Associativity where - type Rep Associativity = D1 D1Associativity (C1 C1_0Associativity U1 - :+: (C1 C1_1Associativity U1 - :+: C1 C1_2Associativity U1)) - - from LeftAssociative = M1 (L1 (M1 U1)) - from RightAssociative = M1 (R1 (L1 (M1 U1))) - from NotAssociative = M1 (R1 (R1 (M1 U1))) - - to (M1 (L1 (M1 U1))) = LeftAssociative - to (M1 (R1 (L1 (M1 U1)))) = RightAssociative - to (M1 (R1 (R1 (M1 U1)))) = NotAssociative - -data D1Associativity -data C1_0Associativity -data C1_1Associativity -data C1_2Associativity - -instance Datatype D1Associativity where - datatypeName _ = "Associativity" - moduleName _ = "GHC.Generics" - -instance Constructor C1_0Associativity where - conName _ = "LeftAssociative" - -instance Constructor C1_1Associativity where - conName _ = "RightAssociative" - -instance Constructor C1_2Associativity where - conName _ = "NotAssociative" - ------ - -instance Generic (Const a b) where - type Rep (Const a b) = D1 D1Const (C1 C1_0Const (S1 S1_0_0Const (Rec0 a))) - from (Const a) = M1 (M1 (M1 (K1 a))) - to (M1 (M1 (M1 (K1 a)))) = Const a - -instance Generic1 (Const a) where - type Rep1 (Const a) = D1 D1Const (C1 C1_0Const (S1 S1_0_0Const (Rec0 a))) - from1 (Const a) = M1 (M1 (M1 (K1 a))) - to1 (M1 (M1 (M1 (K1 a)))) = Const a - -data D1Const -data C1_0Const -data S1_0_0Const - -instance Datatype D1Const where - datatypeName _ = "Const" - moduleName _ = "Control.Applicative" - -instance Constructor C1_0Const where - conName _ = "Const" - conIsRecord _ = True - -instance Selector S1_0_0Const where - selName _ = "getConst" - ------ - -instance Generic (Dual a) where - type Rep (Dual a) = D1 D1Dual (C1 C1_0Dual (S1 S1_0_0Dual (Rec0 a))) - from (Dual d) = M1 (M1 (M1 (K1 d))) - to (M1 (M1 (M1 (K1 d)))) = Dual d - -instance Generic1 Dual where - type Rep1 Dual = D1 D1Dual (C1 C1_0Dual (S1 S1_0_0Dual Par1)) - from1 (Dual d) = M1 (M1 (M1 (Par1 d))) - to1 (M1 (M1 (M1 (Par1 d)))) = Dual d - -data D1Dual -data C1_0Dual -data S1_0_0Dual - -instance Datatype D1Dual where - datatypeName _ = "Dual" - moduleName _ = "Data.Monoid" - -instance Constructor C1_0Dual where - conName _ = "Dual" - conIsRecord _ = True - -instance Selector S1_0_0Dual where - selName _ = "getDual" - ------ - -instance Generic (Endo a) where - type Rep (Endo a) = D1 D1Endo (C1 C1_0Endo (S1 S1_0_0Endo (Rec0 (a -> a)))) - from (Endo e) = M1 (M1 (M1 (K1 e))) - to (M1 (M1 (M1 (K1 e)))) = Endo e - -data D1Endo -data C1_0Endo -data S1_0_0Endo - -instance Datatype D1Endo where - datatypeName _ = "Endo" - moduleName _ = "Data.Monoid" - -instance Constructor C1_0Endo where - conName _ = "Endo" - conIsRecord _ = True - -instance Selector S1_0_0Endo where - selName _ = "appEndo" - ------ - -instance Generic (First a) where - type Rep (First a) = D1 D1First (C1 C1_0First (S1 S1_0_0First (Rec0 (Maybe a)))) - from (First f) = M1 (M1 (M1 (K1 f))) - to (M1 (M1 (M1 (K1 f)))) = First f - -instance Generic1 First where - type Rep1 First = D1 D1First (C1 C1_0First (S1 S1_0_0First (Rec1 Maybe))) - from1 (First f) = M1 (M1 (M1 (Rec1 f))) - to1 (M1 (M1 (M1 (Rec1 f)))) = First f - -data D1First -data C1_0First -data S1_0_0First - -instance Datatype D1First where - datatypeName _ = "First" - moduleName _ = "Data.Monoid" - -instance Constructor C1_0First where - conName _ = "First" - conIsRecord _ = True - -instance Selector S1_0_0First where - selName _ = "getFirst" - ------ - -instance Generic Generics.Fixity where - type Rep Generics.Fixity = D1 D1Fixity (C1 C1_0Fixity U1 - :+: C1 C1_1Fixity (S1 NoSelector (Rec0 Associativity) - :*: S1 NoSelector (Rec0 Int))) - - from Generics.Prefix = M1 (L1 (M1 U1)) - from (Generics.Infix a i) = M1 (R1 (M1 (M1 (K1 a) :*: M1 (K1 i)))) - - to (M1 (L1 (M1 U1))) = Generics.Prefix - to (M1 (R1 (M1 (M1 (K1 a) :*: M1 (K1 i))))) = Generics.Infix a i - -data D1Fixity -data C1_0Fixity -data C1_1Fixity - -instance Datatype D1Fixity where - datatypeName _ = "Fixity" - moduleName _ = "GHC.Generics" - -instance Constructor C1_0Fixity where - conName _ = "Prefix" - -instance Constructor C1_1Fixity where - conName _ = "Infix" - ------ - -instance Generic (Last a) where - type Rep (Last a) = D1 D1Last (C1 C1_0Last (S1 S1_0_0Last (Rec0 (Maybe a)))) - from (Last l) = M1 (M1 (M1 (K1 l))) - to (M1 (M1 (M1 (K1 l)))) = Last l - -instance Generic1 Last where - type Rep1 Last = D1 D1Last (C1 C1_0Last (S1 S1_0_0Last (Rec1 Maybe))) - from1 (Last l) = M1 (M1 (M1 (Rec1 l))) - to1 (M1 (M1 (M1 (Rec1 l)))) = Last l - -data D1Last -data C1_0Last -data S1_0_0Last - -instance Datatype D1Last where - datatypeName _ = "Last" - moduleName _ = "Data.Monoid" - -instance Constructor C1_0Last where - conName _ = "Last" - conIsRecord _ = True - -instance Selector S1_0_0Last where - selName _ = "getLast" - ------ - -instance Generic (Product a) where - type Rep (Product a) = D1 D1Product (C1 C1_0Product (S1 S1_0_0Product (Rec0 a))) - from (Product p) = M1 (M1 (M1 (K1 p))) - to (M1 (M1 (M1 (K1 p)))) = Product p - -instance Generic1 Product where - type Rep1 Product = D1 D1Product (C1 C1_0Product (S1 S1_0_0Product Par1)) - from1 (Product p) = M1 (M1 (M1 (Par1 p))) - to1 (M1 (M1 (M1 (Par1 p)))) = Product p - -data D1Product -data C1_0Product -data S1_0_0Product - -instance Datatype D1Product where - datatypeName _ = "Product" - moduleName _ = "Data.Monoid" - -instance Constructor C1_0Product where - conName _ = "Product" - conIsRecord _ = True - -instance Selector S1_0_0Product where - selName _ = "getProduct" - ------ - -instance Generic (Sum a) where - type Rep (Sum a) = D1 D1Sum (C1 C1_0Sum (S1 S1_0_0Sum (Rec0 a))) - from (Sum s) = M1 (M1 (M1 (K1 s))) - to (M1 (M1 (M1 (K1 s)))) = Sum s - -instance Generic1 Sum where - type Rep1 Sum = D1 D1Sum (C1 C1_0Sum (S1 S1_0_0Sum Par1)) - from1 (Sum s) = M1 (M1 (M1 (Par1 s))) - to1 (M1 (M1 (M1 (Par1 s)))) = Sum s - -data D1Sum -data C1_0Sum -data S1_0_0Sum - -instance Datatype D1Sum where - datatypeName _ = "Sum" - moduleName _ = "Data.Monoid" - -instance Constructor C1_0Sum where - conName _ = "Sum" - conIsRecord _ = True - -instance Selector S1_0_0Sum where - selName _ = "getSum" - ------ - -instance Generic (WrappedArrow a b c) where - type Rep (WrappedArrow a b c) - = D1 D1WrappedArrow (C1 C1_0WrappedArrow (S1 S1_0_0WrappedArrow (Rec0 (a b c)))) - from (WrapArrow a) = M1 (M1 (M1 (K1 a))) - to (M1 (M1 (M1 (K1 a)))) = WrapArrow a - -instance Generic1 (WrappedArrow a b) where - type Rep1 (WrappedArrow a b) - = D1 D1WrappedArrow (C1 C1_0WrappedArrow (S1 S1_0_0WrappedArrow (Rec1 (a b)))) - from1 (WrapArrow a) = M1 (M1 (M1 (Rec1 a))) - to1 (M1 (M1 (M1 (Rec1 a)))) = WrapArrow a - -data D1WrappedArrow -data C1_0WrappedArrow -data S1_0_0WrappedArrow - -instance Datatype D1WrappedArrow where - datatypeName _ = "WrappedArrow" - moduleName _ = "Control.Applicative" - -instance Constructor C1_0WrappedArrow where - conName _ = "WrapArrow" - conIsRecord _ = True - -instance Selector S1_0_0WrappedArrow where - selName _ = "unwrapArrow" - ------ - -instance Generic (WrappedMonad m a) where - type Rep (WrappedMonad m a) - = D1 D1WrappedMonad (C1 C1_0WrappedMonad (S1 S1_0_0WrappedMonad (Rec0 (m a)))) - from (WrapMonad m) = M1 (M1 (M1 (K1 m))) - to (M1 (M1 (M1 (K1 m)))) = WrapMonad m - -instance Generic1 (WrappedMonad m) where - type Rep1 (WrappedMonad m) - = D1 D1WrappedMonad (C1 C1_0WrappedMonad (S1 S1_0_0WrappedMonad (Rec1 m))) - from1 (WrapMonad m) = M1 (M1 (M1 (Rec1 m))) - to1 (M1 (M1 (M1 (Rec1 m)))) = WrapMonad m - -data D1WrappedMonad -data C1_0WrappedMonad -data S1_0_0WrappedMonad - -instance Datatype D1WrappedMonad where - datatypeName _ = "WrappedMonad" - moduleName _ = "Control.Applicative" - -instance Constructor C1_0WrappedMonad where - conName _ = "WrapMonad" - conIsRecord _ = True - -instance Selector S1_0_0WrappedMonad where - selName _ = "unwrapMonad" - ------ - -instance Generic (ZipList a) where - type Rep (ZipList a) = D1 D1ZipList (C1 C1_0ZipList (S1 S1_0_0ZipList (Rec0 [a]))) - from (ZipList z) = M1 (M1 (M1 (K1 z))) - to (M1 (M1 (M1 (K1 z)))) = ZipList z - -instance Generic1 ZipList where - type Rep1 ZipList = D1 D1ZipList (C1 C1_0ZipList (S1 S1_0_0ZipList (Rec1 []))) - from1 (ZipList z) = M1 (M1 (M1 (Rec1 z))) - to1 (M1 (M1 (M1 (Rec1 z)))) = ZipList z - -data D1ZipList -data C1_0ZipList -data S1_0_0ZipList - -instance Datatype D1ZipList where - datatypeName _ = "ZipList" - moduleName _ = "Control.Applicative" - -instance Constructor C1_0ZipList where - conName _ = "ZipList" - conIsRecord _ = True - -instance Selector S1_0_0ZipList where - selName _ = "getZipList" - ------ - -instance Generic (U1 p) where - type Rep (U1 p) = D1 D1U1 (C1 C1_0U1 U1) - from U1 = M1 (M1 U1) - to (M1 (M1 U1)) = U1 - -data D1U1 -data C1_0U1 - -instance Datatype D1U1 where - datatypeName _ = "U1" - moduleName _ = "GHC.Generics" - -instance Constructor C1_0U1 where - conName _ = "U1" - ------ - -instance Generic (Par1 p) where - type Rep (Par1 p) = D1 D1Par1 (C1 C1_0Par1 (S1 S1_0_0Par1 (Rec0 p))) - from (Par1 p) = M1 (M1 (M1 (K1 p))) - to (M1 (M1 (M1 (K1 p)))) = Par1 p - -data D1Par1 -data C1_0Par1 -data S1_0_0Par1 - -instance Datatype D1Par1 where - datatypeName _ = "Par1" - moduleName _ = "GHC.Generics" - -instance Constructor C1_0Par1 where - conName _ = "Par1" - conIsRecord _ = True - -instance Selector S1_0_0Par1 where - selName _ = "unPar1" - ------ - -instance Generic (Rec1 f p) where - type Rep (Rec1 f p) - = D1 D1Rec1 (C1 C1_0Rec1 (S1 S1_0_0Rec1 (Rec0 (f p)))) - from (Rec1 r) = M1 (M1 (M1 (K1 r))) - to (M1 (M1 (M1 (K1 r)))) = Rec1 r - -data D1Rec1 -data C1_0Rec1 -data S1_0_0Rec1 - -instance Datatype D1Rec1 where - datatypeName _ = "Rec1" - moduleName _ = "GHC.Generics" - -instance Constructor C1_0Rec1 where - conName _ = "Rec1" - conIsRecord _ = True - -instance Selector S1_0_0Rec1 where - selName _ = "unRec1" - ------ - -instance Generic (K1 i c p) where - type Rep (K1 i c p) = D1 D1K1 (C1 C1_0K1 (S1 S1_0_0K1 (Rec0 c))) - from (K1 c) = M1 (M1 (M1 (K1 c))) - to (M1 (M1 (M1 (K1 c)))) = K1 c - -data D1K1 -data C1_0K1 -data S1_0_0K1 - -instance Datatype D1K1 where - datatypeName _ = "K1" - moduleName _ = "GHC.Generics" - -instance Constructor C1_0K1 where - conName _ = "K1" - conIsRecord _ = True - -instance Selector S1_0_0K1 where - selName _ = "unK1" - ------ - -instance Generic (M1 i c f p) where - type Rep (M1 i c f p) = D1 D1M1 (C1 C1_0M1 (S1 S1_0_0M1 (Rec0 (f p)))) - from (M1 m) = M1 (M1 (M1 (K1 m))) - to (M1 (M1 (M1 (K1 m)))) = M1 m - -data D1M1 -data C1_0M1 -data S1_0_0M1 - -instance Datatype D1M1 where - datatypeName _ = "M1" - moduleName _ = "GHC.Generics" - -instance Constructor C1_0M1 where - conName _ = "M1" - conIsRecord _ = True - -instance Selector S1_0_0M1 where - selName _ = "unM1" - ------ - -instance Generic ((f :+: g) p) where - type Rep ((f :+: g) p) = D1 D1ConSum (C1 C1_0ConSum (S1 NoSelector (Rec0 (f p))) - :+: C1 C1_1ConSum (S1 NoSelector (Rec0 (g p)))) - - from (L1 l) = M1 (L1 (M1 (M1 (K1 l)))) - from (R1 r) = M1 (R1 (M1 (M1 (K1 r)))) - - to (M1 (L1 (M1 (M1 (K1 l))))) = L1 l - to (M1 (R1 (M1 (M1 (K1 r))))) = R1 r - -data D1ConSum -data C1_0ConSum -data C1_1ConSum - -instance Datatype D1ConSum where - datatypeName _ = ":+:" - moduleName _ = "GHC.Generics" - -instance Constructor C1_0ConSum where - conName _ = "L1" - -instance Constructor C1_1ConSum where - conName _ = "R1" - ------ - -instance Generic ((f :*: g) p) where - type Rep ((f :*: g) p) = - D1 D1ConProduct (C1 C1_ConProduct (S1 NoSelector (Rec0 (f p)) - :*: S1 NoSelector (Rec0 (g p)))) - from (f :*: g) = M1 (M1 (M1 (K1 f) :*: M1 (K1 g))) - to (M1 (M1 (M1 (K1 f) :*: M1 (K1 g)))) = f :*: g - -data D1ConProduct -data C1_ConProduct - -instance Datatype D1ConProduct where - datatypeName _ = ":*:" - moduleName _ = "GHC.Generics" - -instance Constructor C1_ConProduct where - conName _ = ":*:" - conFixity _ = Generics.Infix RightAssociative 6 - ------ - -instance Generic ((f :.: g) p) where - type Rep ((f :.: g) p) - = D1 D1ConCompose (C1 C1_0ConCompose (S1 S1_0_0ConCompose (Rec0 (f (g p))))) - from (Comp1 c) = M1 (M1 (M1 (K1 c))) - to (M1 (M1 (M1 (K1 c)))) = Comp1 c - -data D1ConCompose -data C1_0ConCompose -data S1_0_0ConCompose - -instance Datatype D1ConCompose where - datatypeName _ = ":.:" - moduleName _ = "GHC.Generics" - -instance Constructor C1_0ConCompose where - conName _ = "Comp1" - conIsRecord _ = True - -instance Selector S1_0_0ConCompose where - selName _ = "unComp1" - ------ - -# if !(MIN_VERSION_base(4,6,0)) -instance Generic1 [] where - type Rep1 [] = D1 D1List (C1 C1_0List U1 :+: - C1 C1_1List (S1 NoSelector Par1 - :*: S1 NoSelector (Rec1 []))) - - from1 [] = M1 (L1 (M1 U1)) - from1 (h:t) = M1 (R1 (M1 (M1 (Par1 h) :*: M1 (Rec1 t)))) - - to1 (M1 (L1 (M1 U1))) = [] - to1 (M1 (R1 (M1 (M1 (Par1 h) :*: M1 (Rec1 t))))) = h : t - -data D1List -data C1_0List -data C1_1List - -instance Datatype D1List where - datatypeName _ = "[]" - moduleName _ = "GHC.Types" - -instance Constructor C1_0List where - conName _ = "[]" - -instance Constructor C1_1List where - conName _ = ":" - conFixity _ = Generics.Infix RightAssociative 5 - ------ - -instance Generic1 (Either a) where - type Rep1 (Either a) = D1 D1Either (C1 C1_0Either (S1 NoSelector (Rec0 a)) - :+: C1 C1_1Either (S1 NoSelector Par1)) - - from1 (Left l) = M1 (L1 (M1 (M1 (K1 l)))) - from1 (Right r) = M1 (R1 (M1 (M1 (Par1 r)))) - - to1 (M1 (L1 (M1 (M1 (K1 l))))) = Left l - to1 (M1 (R1 (M1 (M1 (Par1 r))))) = Right r - -data D1Either -data C1_0Either -data C1_1Either - -instance Datatype D1Either where - datatypeName _ = "Either" - moduleName _ = "Data.Either" - -instance Constructor C1_0Either where - conName _ = "Left" - -instance Constructor C1_1Either where - conName _ = "Right" - ------ - -instance Generic1 Maybe where - type Rep1 Maybe = D1 D1Maybe (C1 C1_0Maybe U1 - :+: C1 C1_1Maybe (S1 NoSelector Par1)) - - from1 Nothing = M1 (L1 (M1 U1)) - from1 (Just j) = M1 (R1 (M1 (M1 (Par1 j)))) - - to1 (M1 (L1 (M1 U1))) = Nothing - to1 (M1 (R1 (M1 (M1 (Par1 j))))) = Just j - -data D1Maybe -data C1_0Maybe -data C1_1Maybe - -instance Datatype D1Maybe where - datatypeName _ = "Maybe" - -- As of base-4.7.0.0, Maybe is actually located in GHC.Base. - -- We don't need to worry about this for the versions of base - -- that this instance is defined for, however. - moduleName _ = "Data.Maybe" - -instance Constructor C1_0Maybe where - conName _ = "Nothing" - -instance Constructor C1_1Maybe where - conName _ = "Just" - ------ - -instance Generic1 ((,) a) where - type Rep1 ((,) a) = D1 D1Tuple2 (C1 C1_0Tuple2 (S1 NoSelector (Rec0 a) - :*: S1 NoSelector Par1)) - from1 (a, b) = M1 (M1 (M1 (K1 a) :*: M1 (Par1 b))) - to1 (M1 (M1 (M1 (K1 a) :*: M1 (Par1 b)))) = (a, b) - -data D1Tuple2 -data C1_0Tuple2 - -instance Datatype D1Tuple2 where - datatypeName _ = "(,)" - moduleName _ = "GHC.Tuple" - -instance Constructor C1_0Tuple2 where - conName _ = "(,)" - ------ - -instance Generic1 ((,,) a b) where - type Rep1 ((,,) a b) = D1 D1Tuple3 (C1 C1_0Tuple3 (S1 NoSelector (Rec0 a) - :*: (S1 NoSelector (Rec0 b) - :*: S1 NoSelector Par1))) - from1 (a, b, c) = M1 (M1 (M1 (K1 a) :*: (M1 (K1 b) :*: M1 (Par1 c)))) - to1 (M1 (M1 (M1 (K1 a) :*: (M1 (K1 b) :*: M1 (Par1 c))))) = (a, b, c) - -data D1Tuple3 -data C1_0Tuple3 - -instance Datatype D1Tuple3 where - datatypeName _ = "(,,)" - moduleName _ = "GHC.Tuple" - -instance Constructor C1_0Tuple3 where - conName _ = "(,,)" - ------ - -instance Generic1 ((,,,) a b c) where - type Rep1 ((,,,) a b c) = D1 D1Tuple4 (C1 C1_0Tuple4 ((S1 NoSelector (Rec0 a) - :*: S1 NoSelector (Rec0 b)) - :*: (S1 NoSelector (Rec0 c) - :*: S1 NoSelector Par1))) - - from1 (a, b, c, d) = M1 (M1 ((M1 (K1 a) :*: M1 (K1 b)) - :*: (M1 (K1 c) :*: M1 (Par1 d)))) - - to1 (M1 (M1 ((M1 (K1 a) :*: M1 (K1 b)) - :*: (M1 (K1 c) :*: M1 (Par1 d))))) - = (a, b, c, d) - -data D1Tuple4 -data C1_0Tuple4 - -instance Datatype D1Tuple4 where - datatypeName _ = "(,,,)" - moduleName _ = "GHC.Tuple" - -instance Constructor C1_0Tuple4 where - conName _ = "(,,,)" - ------ - -instance Generic1 ((,,,,) a b c d) where - type Rep1 ((,,,,) a b c d) = D1 D1Tuple5 (C1 C1_0Tuple5 ((S1 NoSelector (Rec0 a) - :*: S1 NoSelector (Rec0 b)) - :*: (S1 NoSelector (Rec0 c) - :*: (S1 NoSelector (Rec0 d) - :*: S1 NoSelector Par1)))) - - from1 (a, b, c, d, e) = M1 (M1 ((M1 (K1 a) :*: M1 (K1 b)) - :*: (M1 (K1 c) :*: (M1 (K1 d) :*: M1 (Par1 e))))) - - to1 (M1 (M1 ((M1 (K1 a) :*: M1 (K1 b)) - :*: (M1 (K1 c) :*: (M1 (K1 d) :*: M1 (Par1 e)))))) - = (a, b, c, d, e) - -data D1Tuple5 -data C1_0Tuple5 - -instance Datatype D1Tuple5 where - datatypeName _ = "(,,,,)" - moduleName _ = "GHC.Tuple" - -instance Constructor C1_0Tuple5 where - conName _ = "(,,,,)" - ------ - -instance Generic1 ((,,,,,) a b c d e) where - type Rep1 ((,,,,,) a b c d e) - = D1 D1Tuple6 (C1 C1_0Tuple6 ((S1 NoSelector (Rec0 a) - :*: (S1 NoSelector (Rec0 b) - :*: S1 NoSelector (Rec0 c))) - :*: (S1 NoSelector (Rec0 d) - :*: (S1 NoSelector (Rec0 e) - :*: S1 NoSelector Par1)))) - - from1 (a, b, c, d, e, f) = M1 (M1 ((M1 (K1 a) :*: (M1 (K1 b) :*: M1 (K1 c))) - :*: (M1 (K1 d) :*: (M1 (K1 e) :*: M1 (Par1 f))))) - - to1 (M1 (M1 ((M1 (K1 a) :*: (M1 (K1 b) :*: M1 (K1 c))) - :*: (M1 (K1 d) :*: (M1 (K1 e) :*: M1 (Par1 f)))))) - = (a, b, c, d, e, f) - -data D1Tuple6 -data C1_0Tuple6 - -instance Datatype D1Tuple6 where - datatypeName _ = "(,,,,,)" - moduleName _ = "GHC.Tuple" - -instance Constructor C1_0Tuple6 where - conName _ = "(,,,,,)" - ------ - -instance Generic1 ((,,,,,,) a b c d e f) where - type Rep1 ((,,,,,,) a b c d e f) - = D1 D1Tuple7 (C1 C1_0Tuple7 ((S1 NoSelector (Rec0 a) - :*: (S1 NoSelector (Rec0 b) - :*: S1 NoSelector (Rec0 c))) - :*: ((S1 NoSelector (Rec0 d) - :*: S1 NoSelector (Rec0 e)) - :*: (S1 NoSelector (Rec0 f) - :*: S1 NoSelector Par1)))) - - from1 (a, b, c, d, e, f, g) = M1 (M1 ((M1 (K1 a) :*: (M1 (K1 b) :*: M1 (K1 c))) - :*: ((M1 (K1 d) :*: M1 (K1 e)) :*: (M1 (K1 f) :*: M1 (Par1 g))))) - - to1 (M1 (M1 ((M1 (K1 a) :*: (M1 (K1 b) :*: M1 (K1 c))) - :*: ((M1 (K1 d) :*: M1 (K1 e)) :*: (M1 (K1 f) :*: M1 (Par1 g)))))) - = (a, b, c, d, e, f, g) - -data D1Tuple7 -data C1_0Tuple7 - -instance Datatype D1Tuple7 where - datatypeName _ = "(,,,,,,)" - moduleName _ = "GHC.Tuple" - -instance Constructor C1_0Tuple7 where - conName _ = "(,,,,,,)" -# endif - ------ - -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 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 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 - +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +#if __GLASGOW_HASKELL__ < 806 +{-# LANGUAGE TypeInType #-} +#endif + +{-# OPTIONS_GHC -Wno-deprecations #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-| +Exports orphan instances that mimic instances available in later versions of @base@. +To use them, simply @import Data.Orphans ()@. +-} +module Data.Orphans () where + +#ifdef __GLASGOW_HASKELL__ +# if !(MIN_VERSION_base(4,11,0)) +import qualified Control.Monad.Fail as Fail (MonadFail(..)) +# endif + +# if !(MIN_VERSION_base(4,16,0)) +import qualified Data.Functor.Product as Functor +# endif + +# if !(MIN_VERSION_base(4,10,0)) +import Data.Data as Data +# endif + +# if !(MIN_VERSION_base(4,11,0)) +import Control.Monad.ST as Strict +# endif + +# if MIN_VERSION_base(4,11,0) && !(MIN_VERSION_base(4,21,0)) +import GHC.Read (readField) +# endif + +# if !(MIN_VERSION_base(4,12,0)) +import qualified Data.Foldable as F (Foldable(..)) +import qualified Data.Traversable as T (Traversable(..)) +# endif + +# if MIN_VERSION_base(4,15,0) && !(MIN_VERSION_base(4,16,0)) +import GHC.Tuple (Solo(..)) +# endif + +# if !(MIN_VERSION_base(4,21,0)) +import Data.Orphans.Prelude +import GHC.Generics as Generics hiding (prec) +# endif + +#include "HsBaseConfig.h" + +------------------------------------------------------------------------------- + +# if !(MIN_VERSION_base(4,10,0)) +deriving instance (Typeable k, Data a, Typeable (b :: k)) => Data (Const a b) + +instance Eq1 NonEmpty where + liftEq eq (a :| as) (b :| bs) = eq a b && liftEq eq as bs + +instance Ord1 NonEmpty where + liftCompare cmp (a :| as) (b :| bs) = cmp a b <> liftCompare cmp as bs + +instance Read1 NonEmpty where + liftReadsPrec rdP rdL p s = readParen (p > 5) (\s' -> do + (a, s'') <- rdP 6 s' + (":|", s''') <- lex s'' + (as, s'''') <- rdL s''' + return (a :| as, s'''')) s + +instance Show1 NonEmpty where + liftShowsPrec shwP shwL p (a :| as) = showParen (p > 5) $ + shwP 6 a . showString " :| " . shwL as + +instance Semigroup a => Semigroup (IO a) where + (<>) = liftA2 (<>) + +# if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) +instance Semigroup Event where + (<>) = mappend + stimes = stimesMonoid + +instance Semigroup Lifetime where + (<>) = mappend + stimes = stimesMonoid +# endif +# endif + +# if !(MIN_VERSION_base(4,11,0)) +instance Alternative ZipList where + empty = ZipList [] + ZipList xs <|> ZipList ys = ZipList (xs ++ drop (length xs) ys) + +deriving instance Monoid a => Monoid (Down a) +deriving instance Num a => Num (Down a) + +instance Functor Down where + fmap = coerce + +instance Applicative Down where + pure = Down + (<*>) = coerce + +instance Monad Down where + return = Down + Down a >>= k = k a + +instance Monoid a => Monoid (Strict.ST s a) where + mempty = pure mempty + mappend = liftA2 mappend + +instance Fail.MonadFail (Strict.ST s) where + fail s = errorWithoutStackTrace s + +deriving instance Semigroup a => Semigroup (Down a) + +instance Semigroup a => Semigroup (Strict.ST s a) where + (<>) = liftA2 (<>) + +# if MIN_VERSION_base(4,10,0) +deriving instance Data IntPtr +deriving instance Data WordPtr +# else +-- The constructors for IntPtr and WordPtr aren't exposed on older versions +-- of base, so we're forced to hand-roll the Data instances here +instance Data IntPtr where + gfoldl k z iptr = z intPtr `k` unIntPtr iptr + gunfold k z _ = k (z intPtr) + toConstr !_ = cIntPtr + dataTypeOf _ = tIntPtr + +intPtr :: Int -> IntPtr +intPtr = unsafeCoerce + +unIntPtr :: IntPtr -> Int +unIntPtr = unsafeCoerce + +tIntPtr :: DataType +tIntPtr = mkDataType "IntPtr" [cIntPtr] + +cIntPtr :: Constr +cIntPtr = mkConstr tIntPtr "IntPtr" [] Data.Prefix + +instance Data WordPtr where + gfoldl k z wptr = z wordPtr `k` unWordPtr wptr + gunfold k z _ = k (z wordPtr) + toConstr !_ = cWordPtr + dataTypeOf _ = tWordPtr + +wordPtr :: Word -> WordPtr +wordPtr = unsafeCoerce + +unWordPtr :: WordPtr -> Word +unWordPtr = unsafeCoerce + +tWordPtr :: DataType +tWordPtr = mkDataType "WordPtr" [cWordPtr] + +cWordPtr :: Constr +cWordPtr = mkConstr tWordPtr "WordPtr" [] Data.Prefix +# endif +# endif + +# if !(MIN_VERSION_base(4,12,0)) +instance MonadFix Down where + mfix f = Down (fix (getDown . f)) + where getDown (Down x) = x +deriving instance Data a => Data (Down a) +deriving instance F.Foldable Down +deriving instance T.Traversable Down +instance MonadZip Down where + mzipWith = liftM2 +instance Eq1 Down where + liftEq eq (Down x) (Down y) = eq x y +instance Ord1 Down where + liftCompare comp (Down x) (Down y) = case comp x y of + LT -> GT + EQ -> EQ + GT -> LT +instance Read1 Down where + liftReadsPrec rp _ = readsData $ + readsUnaryWith rp "Down" Down +instance Show1 Down where + liftShowsPrec sp _ d (Down x) = showsUnaryWith sp "Down" d x + +instance Monoid c => Applicative (K1 i c) where + pure _ = K1 mempty + (<*>) = coerce (mappend :: c -> c -> c) +# if MIN_VERSION_base(4,10,0) + liftA2 = \_ -> coerce (mappend :: c -> c -> c) +# endif + +instance Monoid (U1 p) where + mempty = U1 +# if !(MIN_VERSION_base(4,11,0)) + _ `mappend` _ = U1 +# endif +deriving instance Monoid p => Monoid (Par1 p) +deriving instance Monoid (f p) => Monoid (Rec1 f p) +deriving instance Monoid c => Monoid (K1 i c p) +deriving instance Monoid (f p) => Monoid (M1 i c f p) +instance (Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) where + mempty = mempty :*: mempty +# if !(MIN_VERSION_base(4,11,0)) + (x1 :*: y1) `mappend` (x2 :*: y2) = (x1 `mappend` x2) :*: (y1 `mappend` y2) +# endif +deriving instance Monoid (f (g p)) => Monoid ((f :.: g) p) + +instance Semigroup (V1 p) where + v <> _ = v +instance Semigroup (U1 p) where + _ <> _ = U1 +deriving instance Semigroup p => Semigroup (Par1 p) +deriving instance Semigroup (f p) => Semigroup (Rec1 f p) +deriving instance Semigroup c => Semigroup (K1 i c p) +deriving instance Semigroup (f p) => Semigroup (M1 i c f p) +instance (Semigroup (f p), Semigroup (g p)) => Semigroup ((f :*: g) p) where + (x1 :*: y1) <> (x2 :*: y2) = (x1 <> x2) :*: (y1 <> y2) +deriving instance Semigroup (f (g p)) => Semigroup ((f :.: g) p) + +deriving instance Foldable f => Foldable (Alt f) +deriving instance Traversable f => Traversable (Alt f) +# endif + +# if !(MIN_VERSION_base(4,14,0)) +instance Functor ((,,) a b) where + fmap f (a, b, c) = (a, b, f c) + +instance (Monoid a, Monoid b) => Applicative ((,,) a b) where + pure x = (mempty, mempty, x) + (a, b, f) <*> (a', b', x) = (a `mappend` a', b `mappend` b', f x) + +instance (Monoid a, Monoid b) => Monad ((,,) a b) where + (u, v, a) >>= k = + case k a of + (u', v', b) -> + (u `mappend` u', v `mappend` v', b) + +instance Functor ((,,,) a b c) where + fmap f (a, b, c, d) = (a, b, c, f d) + +instance (Monoid a, Monoid b, Monoid c) => Applicative ((,,,) a b c) where + pure x = (mempty, mempty, mempty, x) + (a, b, c, f) <*> (a', b', c', x) = + (a `mappend` a', b `mappend` b', c `mappend` c', f x) + +instance (Monoid a, Monoid b, Monoid c) => Monad ((,,,) a b c) where + (u, v, w, a) >>= k = + case k a of + (u', v', w', b) -> + (u `mappend` u', v `mappend` v', w `mappend` w', b) + +deriving instance Functor m => Functor (Kleisli m a) + +instance Applicative m => Applicative (Kleisli m a) where + pure = Kleisli . const . pure + {-# INLINE pure #-} + Kleisli f <*> Kleisli g = Kleisli $ \x -> f x <*> g x + {-# INLINE (<*>) #-} + Kleisli f *> Kleisli g = Kleisli $ \x -> f x *> g x + {-# INLINE (*>) #-} + Kleisli f <* Kleisli g = Kleisli $ \x -> f x <* g x + {-# INLINE (<*) #-} + +instance Alternative m => Alternative (Kleisli m a) where + empty = Kleisli $ const empty + {-# INLINE empty #-} + Kleisli f <|> Kleisli g = Kleisli $ \x -> f x <|> g x + {-# INLINE (<|>) #-} + +instance Monad m => Monad (Kleisli m a) where + Kleisli f >>= k = Kleisli $ \x -> f x >>= \a -> runKleisli (k a) x + {-# INLINE (>>=) #-} + +instance MonadPlus m => MonadPlus (Kleisli m a) where + mzero = Kleisli $ const mzero + {-# INLINE mzero #-} + Kleisli f `mplus` Kleisli g = Kleisli $ \x -> f x `mplus` g x + {-# INLINE mplus #-} + +-- | Swaps @'minBound'@ and @'maxBound'@ of the underlying type. +instance Bounded a => Bounded (Down a) where + minBound = Down maxBound + maxBound = Down minBound + +deriving instance Bits a => Bits (Down a) +deriving instance Floating a => Floating (Down a) +deriving instance Fractional a => Fractional (Down a) +deriving instance Ix a => Ix (Down a) +deriving instance Real a => Real (Down a) +deriving instance RealFrac a => RealFrac (Down a) +deriving instance RealFloat a => RealFloat (Down a) +deriving instance Storable a => Storable (Down a) +deriving instance FiniteBits a => FiniteBits (Down a) + +deriving instance (Typeable2 a, Typeable b, Typeable c, Data (a b c)) + => Data (WrappedArrow a b c) +deriving instance (Typeable1 m, Typeable a, Data (m a)) + => Data (WrappedMonad m a) +deriving instance Data a => Data (ZipList a) + +instance IsList (ZipList a) where + type Item (ZipList a) = a + fromList = ZipList + toList = getZipList + +instance (TestEquality f) => TestEquality (Compose f g) where + testEquality (Compose x) (Compose y) = + case testEquality x y of -- :: Maybe (g x :~: g y) + Just Refl -> Just Refl -- :: Maybe (x :~: y) + Nothing -> Nothing +# endif + +# if !(MIN_VERSION_base(4,15,0)) +instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6) => + Ix (a1,a2,a3,a4,a5,a6) where + range ((l1,l2,l3,l4,l5,l6),(u1,u2,u3,u4,u5,u6)) = + [(i1,i2,i3,i4,i5,i6) | i1 <- range (l1,u1), + i2 <- range (l2,u2), + i3 <- range (l3,u3), + i4 <- range (l4,u4), + i5 <- range (l5,u5), + i6 <- range (l6,u6)] + + unsafeIndex ((l1,l2,l3,l4,l5,l6),(u1,u2,u3,u4,u5,u6)) (i1,i2,i3,i4,i5,i6) = + unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * ( + unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( + unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( + unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( + unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( + unsafeIndex (l1,u1) i1))))) + + inRange ((l1,l2,l3,l4,l5,l6),(u1,u2,u3,u4,u5,u6)) (i1,i2,i3,i4,i5,i6) = + inRange (l1,u1) i1 && inRange (l2,u2) i2 && + inRange (l3,u3) i3 && inRange (l4,u4) i4 && + inRange (l5,u5) i5 && inRange (l6,u6) i6 + + -- Default method for index + +instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7) => + Ix (a1,a2,a3,a4,a5,a6,a7) where + range ((l1,l2,l3,l4,l5,l6,l7),(u1,u2,u3,u4,u5,u6,u7)) = + [(i1,i2,i3,i4,i5,i6,i7) | i1 <- range (l1,u1), + i2 <- range (l2,u2), + i3 <- range (l3,u3), + i4 <- range (l4,u4), + i5 <- range (l5,u5), + i6 <- range (l6,u6), + i7 <- range (l7,u7)] + + unsafeIndex ((l1,l2,l3,l4,l5,l6,l7),(u1,u2,u3,u4,u5,u6,u7)) + (i1,i2,i3,i4,i5,i6,i7) = + unsafeIndex (l7,u7) i7 + unsafeRangeSize (l7,u7) * ( + unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * ( + unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( + unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( + unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( + unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( + unsafeIndex (l1,u1) i1)))))) + + inRange ((l1,l2,l3,l4,l5,l6,l7),(u1,u2,u3,u4,u5,u6,u7)) + (i1,i2,i3,i4,i5,i6,i7) = + inRange (l1,u1) i1 && inRange (l2,u2) i2 && + inRange (l3,u3) i3 && inRange (l4,u4) i4 && + inRange (l5,u5) i5 && inRange (l6,u6) i6 && + inRange (l7,u7) i7 + + -- Default method for index + +instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8) => + Ix (a1,a2,a3,a4,a5,a6,a7,a8) where + range ((l1,l2,l3,l4,l5,l6,l7,l8),(u1,u2,u3,u4,u5,u6,u7,u8)) = + [(i1,i2,i3,i4,i5,i6,i7,i8) | i1 <- range (l1,u1), + i2 <- range (l2,u2), + i3 <- range (l3,u3), + i4 <- range (l4,u4), + i5 <- range (l5,u5), + i6 <- range (l6,u6), + i7 <- range (l7,u7), + i8 <- range (l8,u8)] + + unsafeIndex ((l1,l2,l3,l4,l5,l6,l7,l8),(u1,u2,u3,u4,u5,u6,u7,u8)) + (i1,i2,i3,i4,i5,i6,i7,i8) = + unsafeIndex (l8,u8) i8 + unsafeRangeSize (l8,u8) * ( + unsafeIndex (l7,u7) i7 + unsafeRangeSize (l7,u7) * ( + unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * ( + unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( + unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( + unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( + unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( + unsafeIndex (l1,u1) i1))))))) + + inRange ((l1,l2,l3,l4,l5,l6,l7,l8),(u1,u2,u3,u4,u5,u6,u7,u8)) + (i1,i2,i3,i4,i5,i6,i7,i8) = + inRange (l1,u1) i1 && inRange (l2,u2) i2 && + inRange (l3,u3) i3 && inRange (l4,u4) i4 && + inRange (l5,u5) i5 && inRange (l6,u6) i6 && + inRange (l7,u7) i7 && inRange (l8,u8) i8 + + -- Default method for index + +instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9) => + Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9) where + range ((l1,l2,l3,l4,l5,l6,l7,l8,l9),(u1,u2,u3,u4,u5,u6,u7,u8,u9)) = + [(i1,i2,i3,i4,i5,i6,i7,i8,i9) | i1 <- range (l1,u1), + i2 <- range (l2,u2), + i3 <- range (l3,u3), + i4 <- range (l4,u4), + i5 <- range (l5,u5), + i6 <- range (l6,u6), + i7 <- range (l7,u7), + i8 <- range (l8,u8), + i9 <- range (l9,u9)] + + unsafeIndex ((l1,l2,l3,l4,l5,l6,l7,l8,l9),(u1,u2,u3,u4,u5,u6,u7,u8,u9)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9) = + unsafeIndex (l9,u9) i9 + unsafeRangeSize (l9,u9) * ( + unsafeIndex (l8,u8) i8 + unsafeRangeSize (l8,u8) * ( + unsafeIndex (l7,u7) i7 + unsafeRangeSize (l7,u7) * ( + unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * ( + unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( + unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( + unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( + unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( + unsafeIndex (l1,u1) i1)))))))) + + inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9),(u1,u2,u3,u4,u5,u6,u7,u8,u9)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9) = + inRange (l1,u1) i1 && inRange (l2,u2) i2 && + inRange (l3,u3) i3 && inRange (l4,u4) i4 && + inRange (l5,u5) i5 && inRange (l6,u6) i6 && + inRange (l7,u7) i7 && inRange (l8,u8) i8 && + inRange (l9,u9) i9 + + -- Default method for index + +instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9, + Ix aA) => + Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,aA) where + range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA),(u1,u2,u3,u4,u5,u6,u7,u8,u9,uA)) = + [(i1,i2,i3,i4,i5,i6,i7,i8,i9,iA) | i1 <- range (l1,u1), + i2 <- range (l2,u2), + i3 <- range (l3,u3), + i4 <- range (l4,u4), + i5 <- range (l5,u5), + i6 <- range (l6,u6), + i7 <- range (l7,u7), + i8 <- range (l8,u8), + i9 <- range (l9,u9), + iA <- range (lA,uA)] + + unsafeIndex ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA) = + unsafeIndex (lA,uA) iA + unsafeRangeSize (lA,uA) * ( + unsafeIndex (l9,u9) i9 + unsafeRangeSize (l9,u9) * ( + unsafeIndex (l8,u8) i8 + unsafeRangeSize (l8,u8) * ( + unsafeIndex (l7,u7) i7 + unsafeRangeSize (l7,u7) * ( + unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * ( + unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( + unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( + unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( + unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( + unsafeIndex (l1,u1) i1))))))))) + + inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA),(u1,u2,u3,u4,u5,u6,u7,u8,u9,uA)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA) = + inRange (l1,u1) i1 && inRange (l2,u2) i2 && + inRange (l3,u3) i3 && inRange (l4,u4) i4 && + inRange (l5,u5) i5 && inRange (l6,u6) i6 && + inRange (l7,u7) i7 && inRange (l8,u8) i8 && + inRange (l9,u9) i9 && inRange (lA,uA) iA + + -- Default method for index + +instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9, + Ix aA, Ix aB) => + Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,aA,aB) where + range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB)) = + [(i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB) | i1 <- range (l1,u1), + i2 <- range (l2,u2), + i3 <- range (l3,u3), + i4 <- range (l4,u4), + i5 <- range (l5,u5), + i6 <- range (l6,u6), + i7 <- range (l7,u7), + i8 <- range (l8,u8), + i9 <- range (l9,u9), + iA <- range (lA,uA), + iB <- range (lB,uB)] + + unsafeIndex ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB) = + unsafeIndex (lB,uB) iB + unsafeRangeSize (lB,uB) * ( + unsafeIndex (lA,uA) iA + unsafeRangeSize (lA,uA) * ( + unsafeIndex (l9,u9) i9 + unsafeRangeSize (l9,u9) * ( + unsafeIndex (l8,u8) i8 + unsafeRangeSize (l8,u8) * ( + unsafeIndex (l7,u7) i7 + unsafeRangeSize (l7,u7) * ( + unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * ( + unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( + unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( + unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( + unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( + unsafeIndex (l1,u1) i1)))))))))) + + inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB) = + inRange (l1,u1) i1 && inRange (l2,u2) i2 && + inRange (l3,u3) i3 && inRange (l4,u4) i4 && + inRange (l5,u5) i5 && inRange (l6,u6) i6 && + inRange (l7,u7) i7 && inRange (l8,u8) i8 && + inRange (l9,u9) i9 && inRange (lA,uA) iA && + inRange (lB,uB) iB + + -- Default method for index + +instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9, + Ix aA, Ix aB, Ix aC) => + Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,aA,aB,aC) where + range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC)) = + [(i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC) | i1 <- range (l1,u1), + i2 <- range (l2,u2), + i3 <- range (l3,u3), + i4 <- range (l4,u4), + i5 <- range (l5,u5), + i6 <- range (l6,u6), + i7 <- range (l7,u7), + i8 <- range (l8,u8), + i9 <- range (l9,u9), + iA <- range (lA,uA), + iB <- range (lB,uB), + iC <- range (lC,uC)] + + unsafeIndex ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC) = + unsafeIndex (lC,uC) iC + unsafeRangeSize (lC,uC) * ( + unsafeIndex (lB,uB) iB + unsafeRangeSize (lB,uB) * ( + unsafeIndex (lA,uA) iA + unsafeRangeSize (lA,uA) * ( + unsafeIndex (l9,u9) i9 + unsafeRangeSize (l9,u9) * ( + unsafeIndex (l8,u8) i8 + unsafeRangeSize (l8,u8) * ( + unsafeIndex (l7,u7) i7 + unsafeRangeSize (l7,u7) * ( + unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * ( + unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( + unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( + unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( + unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( + unsafeIndex (l1,u1) i1))))))))))) + + inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC) = + inRange (l1,u1) i1 && inRange (l2,u2) i2 && + inRange (l3,u3) i3 && inRange (l4,u4) i4 && + inRange (l5,u5) i5 && inRange (l6,u6) i6 && + inRange (l7,u7) i7 && inRange (l8,u8) i8 && + inRange (l9,u9) i9 && inRange (lA,uA) iA && + inRange (lB,uB) iB && inRange (lC,uC) iC + + -- Default method for index + +instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9, + Ix aA, Ix aB, Ix aC, Ix aD) => + Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,aA,aB,aC,aD) where + range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC,lD), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC,uD)) = + [(i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC,iD) | i1 <- range (l1,u1), + i2 <- range (l2,u2), + i3 <- range (l3,u3), + i4 <- range (l4,u4), + i5 <- range (l5,u5), + i6 <- range (l6,u6), + i7 <- range (l7,u7), + i8 <- range (l8,u8), + i9 <- range (l9,u9), + iA <- range (lA,uA), + iB <- range (lB,uB), + iC <- range (lC,uC), + iD <- range (lD,uD)] + + unsafeIndex ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC,lD), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC,uD)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC,iD) = + unsafeIndex (lD,uD) iD + unsafeRangeSize (lD,uD) * ( + unsafeIndex (lC,uC) iC + unsafeRangeSize (lC,uC) * ( + unsafeIndex (lB,uB) iB + unsafeRangeSize (lB,uB) * ( + unsafeIndex (lA,uA) iA + unsafeRangeSize (lA,uA) * ( + unsafeIndex (l9,u9) i9 + unsafeRangeSize (l9,u9) * ( + unsafeIndex (l8,u8) i8 + unsafeRangeSize (l8,u8) * ( + unsafeIndex (l7,u7) i7 + unsafeRangeSize (l7,u7) * ( + unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * ( + unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( + unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( + unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( + unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( + unsafeIndex (l1,u1) i1)))))))))))) + + inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC,lD), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC,uD)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC,iD) = + inRange (l1,u1) i1 && inRange (l2,u2) i2 && + inRange (l3,u3) i3 && inRange (l4,u4) i4 && + inRange (l5,u5) i5 && inRange (l6,u6) i6 && + inRange (l7,u7) i7 && inRange (l8,u8) i8 && + inRange (l9,u9) i9 && inRange (lA,uA) iA && + inRange (lB,uB) iB && inRange (lC,uC) iC && + inRange (lD,uD) iD + + -- Default method for index + +instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9, + Ix aA, Ix aB, Ix aC, Ix aD, Ix aE) => + Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,aA,aB,aC,aD,aE) where + range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC,lD,lE), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC,uD,uE)) = + [(i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC,iD,iE) | i1 <- range (l1,u1), + i2 <- range (l2,u2), + i3 <- range (l3,u3), + i4 <- range (l4,u4), + i5 <- range (l5,u5), + i6 <- range (l6,u6), + i7 <- range (l7,u7), + i8 <- range (l8,u8), + i9 <- range (l9,u9), + iA <- range (lA,uA), + iB <- range (lB,uB), + iC <- range (lC,uC), + iD <- range (lD,uD), + iE <- range (lE,uE)] + + unsafeIndex ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC,lD,lE), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC,uD,uE)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC,iD,iE) = + unsafeIndex (lE,uE) iE + unsafeRangeSize (lE,uE) * ( + unsafeIndex (lD,uD) iD + unsafeRangeSize (lD,uD) * ( + unsafeIndex (lC,uC) iC + unsafeRangeSize (lC,uC) * ( + unsafeIndex (lB,uB) iB + unsafeRangeSize (lB,uB) * ( + unsafeIndex (lA,uA) iA + unsafeRangeSize (lA,uA) * ( + unsafeIndex (l9,u9) i9 + unsafeRangeSize (l9,u9) * ( + unsafeIndex (l8,u8) i8 + unsafeRangeSize (l8,u8) * ( + unsafeIndex (l7,u7) i7 + unsafeRangeSize (l7,u7) * ( + unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * ( + unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( + unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( + unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( + unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( + unsafeIndex (l1,u1) i1))))))))))))) + + inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC,lD,lE), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC,uD,uE)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC,iD,iE) = + inRange (l1,u1) i1 && inRange (l2,u2) i2 && + inRange (l3,u3) i3 && inRange (l4,u4) i4 && + inRange (l5,u5) i5 && inRange (l6,u6) i6 && + inRange (l7,u7) i7 && inRange (l8,u8) i8 && + inRange (l9,u9) i9 && inRange (lA,uA) iA && + inRange (lB,uB) iB && inRange (lC,uC) iC && + inRange (lD,uD) iD && inRange (lE,uE) iE + + -- Default method for index + +instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5, Ix a6, Ix a7, Ix a8, Ix a9, + Ix aA, Ix aB, Ix aC, Ix aD, Ix aE, Ix aF) => + Ix (a1,a2,a3,a4,a5,a6,a7,a8,a9,aA,aB,aC,aD,aE,aF) where + range ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC,lD,lE,lF), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC,uD,uE,uF)) = + [(i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC,iD,iE,iF) | i1 <- range (l1,u1), + i2 <- range (l2,u2), + i3 <- range (l3,u3), + i4 <- range (l4,u4), + i5 <- range (l5,u5), + i6 <- range (l6,u6), + i7 <- range (l7,u7), + i8 <- range (l8,u8), + i9 <- range (l9,u9), + iA <- range (lA,uA), + iB <- range (lB,uB), + iC <- range (lC,uC), + iD <- range (lD,uD), + iE <- range (lE,uE), + iF <- range (lF,uF)] + + unsafeIndex ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC,lD,lE,lF), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC,uD,uE,uF)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC,iD,iE,iF) = + unsafeIndex (lF,uF) iF + unsafeRangeSize (lF,uF) * ( + unsafeIndex (lE,uE) iE + unsafeRangeSize (lE,uE) * ( + unsafeIndex (lD,uD) iD + unsafeRangeSize (lD,uD) * ( + unsafeIndex (lC,uC) iC + unsafeRangeSize (lC,uC) * ( + unsafeIndex (lB,uB) iB + unsafeRangeSize (lB,uB) * ( + unsafeIndex (lA,uA) iA + unsafeRangeSize (lA,uA) * ( + unsafeIndex (l9,u9) i9 + unsafeRangeSize (l9,u9) * ( + unsafeIndex (l8,u8) i8 + unsafeRangeSize (l8,u8) * ( + unsafeIndex (l7,u7) i7 + unsafeRangeSize (l7,u7) * ( + unsafeIndex (l6,u6) i6 + unsafeRangeSize (l6,u6) * ( + unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * ( + unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * ( + unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * ( + unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * ( + unsafeIndex (l1,u1) i1)))))))))))))) + + inRange ((l1,l2,l3,l4,l5,l6,l7,l8,l9,lA,lB,lC,lD,lE,lF), + (u1,u2,u3,u4,u5,u6,u7,u8,u9,uA,uB,uC,uD,uE,uF)) + (i1,i2,i3,i4,i5,i6,i7,i8,i9,iA,iB,iC,iD,iE,iF) = + inRange (l1,u1) i1 && inRange (l2,u2) i2 && + inRange (l3,u3) i3 && inRange (l4,u4) i4 && + inRange (l5,u5) i5 && inRange (l6,u6) i6 && + inRange (l7,u7) i7 && inRange (l8,u8) i8 && + inRange (l9,u9) i9 && inRange (lA,uA) iA && + inRange (lB,uB) iB && inRange (lC,uC) iC && + inRange (lD,uD) iD && inRange (lE,uE) iE && + inRange (lF,uF) iF + + -- Default method for index + +instance MonadZip Complex where + mzipWith = liftA2 + +instance MonadFix Complex where + mfix f = (let a :+ _ = f a in a) :+ (let _ :+ a = f a in a) +# endif + +# if !(MIN_VERSION_base(4,16,0)) +instance Eq1 Complex where + liftEq eq (x :+ y) (u :+ v) = eq x u && eq y v + +instance Read1 Complex where +# if MIN_VERSION_base(4,10,0) + liftReadPrec rp _ = parens $ prec complexPrec $ do + x <- step rp + expectP (Symbol ":+") + y <- step rp + return (x :+ y) + where + complexPrec = 6 + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec rdP _ p s = readParen (p > complexPrec) (\s' -> do + (x, s'') <- rdP (complexPrec+1) s' + (":+", s''') <- lex s'' + (y, s'''') <- rdP (complexPrec+1) s''' + return (x :+ y, s'''')) s + where + complexPrec = 6 +# endif + +instance Show1 Complex where + liftShowsPrec sp _ d (x :+ y) = showParen (d > complexPrec) $ + sp (complexPrec+1) x . showString " :+ " . sp (complexPrec+1) y + where + complexPrec = 6 + +instance Eq a => Eq2 ((,,) a) where + liftEq2 e1 e2 (u1, x1, y1) (v1, x2, y2) = + u1 == v1 && + e1 x1 x2 && e2 y1 y2 + +instance Ord a => Ord2 ((,,) a) where + liftCompare2 comp1 comp2 (u1, x1, y1) (v1, x2, y2) = + compare u1 v1 `mappend` + comp1 x1 x2 `mappend` comp2 y1 y2 + +instance Read a => Read2 ((,,) a) where +# if MIN_VERSION_base(4,10,0) + liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do + x1 <- readPrec + expectP (Punc ",") + y1 <- rp1 + expectP (Punc ",") + y2 <- rp2 + return (x1,y1,y2) + + liftReadListPrec2 = liftReadListPrec2Default + liftReadList2 = liftReadList2Default +# else + liftReadsPrec2 rp1 _ rp2 _ _ = readParen False $ \ r -> + [((e1,e2,e3), y) | ("(",s) <- lex r, + (e1,t) <- readsPrec 0 s, + (",",u) <- lex t, + (e2,v) <- rp1 0 u, + (",",w) <- lex v, + (e3,x) <- rp2 0 w, + (")",y) <- lex x] +# endif + +instance Show a => Show2 ((,,) a) where + liftShowsPrec2 sp1 _ sp2 _ _ (x1,y1,y2) + = showChar '(' . showsPrec 0 x1 + . showChar ',' . sp1 0 y1 + . showChar ',' . sp2 0 y2 + . showChar ')' + +instance (Eq a, Eq b) => Eq1 ((,,) a b) where + liftEq = liftEq2 (==) + +instance (Ord a, Ord b) => Ord1 ((,,) a b) where + liftCompare = liftCompare2 compare + +instance (Read a, Read b) => Read1 ((,,) a b) where +# if MIN_VERSION_base(4,10,0) + liftReadPrec = liftReadPrec2 readPrec readListPrec + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec = liftReadsPrec2 readsPrec readList +# endif + +instance (Show a, Show b) => Show1 ((,,) a b) where + liftShowsPrec = liftShowsPrec2 showsPrec showList + +instance (Eq a, Eq b) => Eq2 ((,,,) a b) where + liftEq2 e1 e2 (u1, u2, x1, y1) (v1, v2, x2, y2) = + u1 == v1 && + u2 == v2 && + e1 x1 x2 && e2 y1 y2 + +instance (Ord a, Ord b) => Ord2 ((,,,) a b) where + liftCompare2 comp1 comp2 (u1, u2, x1, y1) (v1, v2, x2, y2) = + compare u1 v1 `mappend` + compare u2 v2 `mappend` + comp1 x1 x2 `mappend` comp2 y1 y2 + +instance (Read a, Read b) => Read2 ((,,,) a b) where +# if MIN_VERSION_base(4,10,0) + liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do + x1 <- readPrec + expectP (Punc ",") + x2 <- readPrec + expectP (Punc ",") + y1 <- rp1 + expectP (Punc ",") + y2 <- rp2 + return (x1,x2,y1,y2) + + liftReadListPrec2 = liftReadListPrec2Default + liftReadList2 = liftReadList2Default +# else + liftReadsPrec2 rp1 _ rp2 _ _ = readParen False $ \ r -> + [((e1,e2,e3,e4), s9) | ("(",s1) <- lex r, + (e1,s2) <- readsPrec 0 s1, + (",",s3) <- lex s2, + (e2,s4) <- readsPrec 0 s3, + (",",s5) <- lex s4, + (e3,s6) <- rp1 0 s5, + (",",s7) <- lex s6, + (e4,s8) <- rp2 0 s7, + (")",s9) <- lex s8] +# endif + +instance (Show a, Show b) => Show2 ((,,,) a b) where + liftShowsPrec2 sp1 _ sp2 _ _ (x1,x2,y1,y2) + = showChar '(' . showsPrec 0 x1 + . showChar ',' . showsPrec 0 x2 + . showChar ',' . sp1 0 y1 + . showChar ',' . sp2 0 y2 + . showChar ')' + +instance (Eq a, Eq b, Eq c) => Eq1 ((,,,) a b c) where + liftEq = liftEq2 (==) + +instance (Ord a, Ord b, Ord c) => Ord1 ((,,,) a b c) where + liftCompare = liftCompare2 compare + +instance (Read a, Read b, Read c) => Read1 ((,,,) a b c) where +# if MIN_VERSION_base(4,10,0) + liftReadPrec = liftReadPrec2 readPrec readListPrec + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec = liftReadsPrec2 readsPrec readList +# endif + +instance (Show a, Show b, Show c) => Show1 ((,,,) a b c) where + liftShowsPrec = liftShowsPrec2 showsPrec showList + +deriving instance Semigroup (f (g a)) => Semigroup (Compose f g a) +deriving instance Monoid (f (g a)) => Monoid (Compose f g a) + +instance (Semigroup (f a), Semigroup (g a)) => Semigroup (Functor.Product f g a) where + Functor.Pair x1 y1 <> Functor.Pair x2 y2 = Functor.Pair (x1 <> x2) (y1 <> y2) + +instance (Monoid (f a), Monoid (g a)) => Monoid (Functor.Product f g a) where + mempty = Functor.Pair mempty mempty +# if !(MIN_VERSION_base(4,11,0)) + Functor.Pair x1 y1 `mappend` Functor.Pair x2 y2 = Functor.Pair (x1 `mappend` x2) (y1 `mappend` y2) +# endif + +# if MIN_VERSION_base(4,15,0) +instance Enum a => Enum (Solo a) where + succ (Solo a) = Solo (succ a) + pred (Solo a) = Solo (pred a) + + toEnum x = Solo (toEnum x) + + fromEnum (Solo x) = fromEnum x + enumFrom (Solo x) = [Solo a | a <- enumFrom x] + enumFromThen (Solo x) (Solo y) = + [Solo a | a <- enumFromThen x y] + enumFromTo (Solo x) (Solo y) = + [Solo a | a <- enumFromTo x y] + enumFromThenTo (Solo x) (Solo y) (Solo z) = + [Solo a | a <- enumFromThenTo x y z] + +deriving instance Eq a => Eq (Solo a) +deriving instance Ord a => Ord (Solo a) +deriving instance Bounded a => Bounded (Solo a) + +instance Ix a => Ix (Solo a) where -- as derived + {-# SPECIALISE instance Ix (Solo Int) #-} + + {-# INLINE range #-} + range (Solo l, Solo u) = + [ Solo i | i <- range (l,u) ] + + {-# INLINE unsafeIndex #-} + unsafeIndex (Solo l, Solo u) (Solo i) = + unsafeIndex (l,u) i + + {-# INLINE inRange #-} + inRange (Solo l, Solo u) (Solo i) = + inRange (l, u) i + + -- Default method for index +# endif +# endif + +# if !(MIN_VERSION_base(4,16,1)) +deriving instance Ix CChar +deriving instance Ix CSChar +deriving instance Ix CUChar +deriving instance Ix CShort +deriving instance Ix CUShort +deriving instance Ix CInt +deriving instance Ix CUInt +deriving instance Ix CLong +deriving instance Ix CULong +deriving instance Ix CLLong +deriving instance Ix CULLong +deriving instance Ix CPtrdiff +deriving instance Ix CSize +deriving instance Ix CWchar +deriving instance Ix CSigAtomic +deriving instance Ix CIntPtr +deriving instance Ix CUIntPtr +deriving instance Ix CIntMax +deriving instance Ix CUIntMax +# if MIN_VERSION_base(4,10,0) +deriving instance Ix CBool +# endif + +# if MIN_VERSION_base(4,10,0) +-- These are guarded on base-4.10.0 because that was the first version which +-- exported their constructors, which is necessary to use +-- GeneralizedNewtypeDeriving. See +-- https://gitlab.haskell.org/ghc/ghc/-/issues/11983. +deriving instance Ix WordPtr +deriving instance Ix IntPtr +# endif + +# if defined(HTYPE_DEV_T) +deriving instance Ix CDev +# endif +# if defined(HTYPE_INO_T) +deriving instance Ix CIno +# endif +# if defined(HTYPE_MODE_T) +deriving instance Ix CMode +# endif +# if defined(HTYPE_OFF_T) +deriving instance Ix COff +# endif +# if defined(HTYPE_PID_T) +deriving instance Ix CPid +# endif +# if defined(HTYPE_SSIZE_T) +deriving instance Ix CSsize +# endif +# if defined(HTYPE_GID_T) +deriving instance Ix CGid +# endif +# if defined(HTYPE_NLINK_T) +deriving instance Ix CNlink +# endif +# if defined(HTYPE_UID_T) +deriving instance Ix CUid +# endif +# if defined(HTYPE_CC_T) +deriving instance Ix CCc +# endif +# if defined(HTYPE_SPEED_T) +deriving instance Ix CSpeed +# endif +# if defined(HTYPE_TCFLAG_T) +deriving instance Ix CTcflag +# endif +# if defined(HTYPE_RLIM_T) +deriving instance Ix CRLim +# endif +deriving instance Ix Fd + +# if MIN_VERSION_base(4,10,0) +# if defined(HTYPE_BLKSIZE_T) +deriving instance Ix CBlkSize +# endif +# if defined(HTYPE_BLKCNT_T) +deriving instance Ix CBlkCnt +# endif +# if defined(HTYPE_CLOCKID_T) +deriving instance Ix CClockId +# endif +# if defined(HTYPE_FSBLKCNT_T) +deriving instance Ix CFsBlkCnt +# endif +# if defined(HTYPE_FSFILCNT_T) +deriving instance Ix CFsFilCnt +# endif +# if defined(HTYPE_ID_T) +deriving instance Ix CId +# endif +# if defined(HTYPE_KEY_T) +deriving instance Ix CKey +# endif +# if defined(HTYPE_SOCKLEN_T) +deriving instance Ix CSocklen +# endif +# if defined(HTYPE_NFDS_T) +deriving instance Ix CNfds +# endif +# endif +# endif + +# if !(MIN_VERSION_base(4,18,0)) +instance Functor ((,,,,) a b c d) where + fmap f (a, b, c, d, e) = (a, b, c, d, f e) +instance Functor ((,,,,,) a b c d e) where + fmap fun (a, b, c, d, e, f) = (a, b, c, d, e, fun f) +instance Functor ((,,,,,,) a b c d e f) where + fmap fun (a, b, c, d, e, f, g) = (a, b, c, d, e, f, fun g) + +# if !(MIN_VERSION_base(4,14,0)) || MIN_VERSION_base(4,15,0) +-- | Swaps @'succ'@ and @'pred'@ of the underlying type. +instance (Enum a, Bounded a, Eq a) => Enum (Down a) where + succ = fmap pred + pred = fmap succ + + -- Here we use the fact that 'comparing (complement @Int)' behaves + -- as an order-swapping `compare @Int`. + fromEnum (Down x) = complement $ fromEnum x + toEnum = Down . toEnum . complement + + enumFrom (Down x) + | x == minBound + = [Down x] -- We can't rely on 'enumFromThen _ (pred @a minBound)` behaving nicely, + -- since 'enumFromThen _' might be strict and 'pred minBound' might throw + | otherwise + = coerce $ enumFromThen x (pred x) + enumFromThen (Down x) (Down y) = coerce $ enumFromThen x y +# endif + +# if MIN_VERSION_base(4,17,0) +instance (Generic1 f, Eq (Rep1 f a)) => Eq (Generically1 f a) where + Generically1 x == Generically1 y = from1 x == from1 y + Generically1 x /= Generically1 y = from1 x /= from1 y + +instance (Generic1 f, Ord (Rep1 f a)) => Ord (Generically1 f a) where + Generically1 x `compare` Generically1 y = from1 x `compare` from1 y +# endif +# endif + +# if !(MIN_VERSION_base(4,19,0)) +deriving instance Enum (f (g a)) => Enum (Compose f g a) +deriving instance Bounded (f (g a)) => Bounded (Compose f g a) +deriving instance Num (f (g a)) => Num (Compose f g a) + +-- In base-4.18.0.0, the Ord instance for Compose was simplified to: +-- +-- instance Ord (f (g a)) => Ord (Compose f g a) +-- +-- Before that, the Ord instance was defined as: +-- +-- instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) +-- +-- This makes deriving Real and Integral instances slightly more complicated for +-- these older versions of base, as there are no Real1 or Integral1 classes. We +-- opt for making the instance contexts more complicated instead. +# if MIN_VERSION_base(4,18,0) +deriving instance Real (f (g a)) => Real (Compose f g a) +deriving instance Integral (f (g a)) => Integral (Compose f g a) +# else +deriving instance (Real (f (g a)), Ord1 f, Ord1 g, Ord a) => Real (Compose f g a) +deriving instance (Integral (f (g a)), Ord1 f, Ord1 g, Ord a) => Integral (Compose f g a) +# endif + +# if MIN_VERSION_base(4,18,0) +instance Eq (SChar c) where + _ == _ = True +instance Ord (SChar c) where + compare _ _ = EQ + +instance Eq (SNat n) where + _ == _ = True +instance Ord (SNat n) where + compare _ _ = EQ + +instance Eq (SSymbol s) where + _ == _ = True +instance Ord (SSymbol s) where + compare _ _ = EQ +# endif +# endif + +# if !(MIN_VERSION_base(4,20,0)) +deriving instance Fractional (f (g a)) => Fractional (Compose f g a) +deriving instance Floating (f (g a)) => Floating (Compose f g a) + +-- RealFrac and RealFloat both have Ord as a superclass. For the reasons stated +-- above (near the Real/Integral instances for Compose), these +-- RealFrace/RealFloat instances are slightly more complicated for older +-- versions of base. +# if MIN_VERSION_base(4,18,0) +deriving instance RealFrac (f (g a)) => RealFrac (Compose f g a) +deriving instance RealFloat (f (g a)) => RealFloat (Compose f g a) +# else +deriving instance (RealFrac (f (g a)), Ord1 f, Ord1 g, Ord a) => RealFrac (Compose f g a) +deriving instance (RealFloat (f (g a)), Ord1 f, Ord1 g, Ord a) => RealFloat (Compose f g a) +# endif +# endif + +# if !(MIN_VERSION_base(4,21,0)) +instance Monoid a => MonadFix ((,) a) where + -- See the CLC proposal thread for discussion and proofs of the laws: https://github.com/haskell/core-libraries-committee/issues/238 + mfix f = let a = f (snd a) in a + +instance Eq1 V1 where + liftEq _ = \_ _ -> True + +instance Ord1 V1 where + liftCompare _ = \_ _ -> EQ + +instance Show1 V1 where + liftShowsPrec _ _ _ = \_ -> showString "V1" + +instance Read1 V1 where + liftReadsPrec _ _ = readPrec_to_S pfail + +# if MIN_VERSION_base(4,10,0) + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# endif + +instance Eq1 U1 where + liftEq _ = \_ _ -> True + +instance Ord1 U1 where + liftCompare _ = \_ _ -> EQ + +instance Show1 U1 where + liftShowsPrec _ _ _ = \U1 -> showString "U1" + +instance Read1 U1 where +# if MIN_VERSION_base(4,10,0) + liftReadPrec _ _ = + parens (expectP (Ident "U1") *> pure U1) + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec _ _ = + readPrec_to_S $ + parens (expectP (Ident "U1") *> pure U1) +# endif + +instance Eq1 Par1 where + liftEq eq = \(Par1 a) (Par1 a') -> eq a a' + +instance Ord1 Par1 where + liftCompare cmp = \(Par1 a) (Par1 a') -> cmp a a' + +instance Show1 Par1 where + liftShowsPrec sp _ d = \(Par1 { unPar1 = a }) -> + showsSingleFieldRecordWith sp "Par1" "unPar1" d a + +instance Read1 Par1 where +# if MIN_VERSION_base(4,10,0) + liftReadPrec rp _ = + readSingleFieldRecordWith rp "Par1" "unPar1" Par1 + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec rp _ = + readPrec_to_S $ + readSingleFieldRecordWith (readS_to_Prec rp) "Par1" "unPar1" Par1 +# endif + +instance Eq1 f => Eq1 (Rec1 f) where + liftEq eq = \(Rec1 a) (Rec1 a') -> liftEq eq a a' + +instance Ord1 f => Ord1 (Rec1 f) where + liftCompare cmp = \(Rec1 a) (Rec1 a') -> liftCompare cmp a a' + +instance Show1 f => Show1 (Rec1 f) where + liftShowsPrec sp sl d = \(Rec1 { unRec1 = a }) -> + showsSingleFieldRecordWith (liftShowsPrec sp sl) "Rec1" "unRec1" d a + +instance Read1 f => Read1 (Rec1 f) where +# if MIN_VERSION_base(4,10,0) + liftReadPrec rp rl = + readSingleFieldRecordWith (liftReadPrec rp rl) "Rec1" "unRec1" Rec1 + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec rp rl = + readPrec_to_S $ + readSingleFieldRecordWith + (readS_to_Prec (liftReadsPrec rp rl)) + "Rec1" + "unRec1" + Rec1 +# endif + +instance Eq c => Eq1 (K1 i c) where + liftEq _ = \(K1 a) (K1 a') -> a == a' + +instance Ord c => Ord1 (K1 i c) where + liftCompare _ = \(K1 a) (K1 a') -> compare a a' + +instance Show c => Show1 (K1 i c) where + liftShowsPrec _ _ d = \(K1 { unK1 = a }) -> + showsSingleFieldRecordWith showsPrec "K1" "unK1" d a + +instance Read c => Read1 (K1 i c) where +# if MIN_VERSION_base(4,10,0) + liftReadPrec _ _ = readData $ + readSingleFieldRecordWith readPrec "K1" "unK1" K1 + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec _ _ = + readPrec_to_S $ + readData $ + readSingleFieldRecordWith readPrec "K1" "unK1" K1 +# endif + +instance Eq1 f => Eq1 (M1 i c f) where + liftEq eq = \(M1 a) (M1 a') -> liftEq eq a a' + +instance Ord1 f => Ord1 (M1 i c f) where + liftCompare cmp = \(M1 a) (M1 a') -> liftCompare cmp a a' + +instance Show1 f => Show1 (M1 i c f) where + liftShowsPrec sp sl d = \(M1 { unM1 = a }) -> + showsSingleFieldRecordWith (liftShowsPrec sp sl) "M1" "unM1" d a + +instance Read1 f => Read1 (M1 i c f) where +# if MIN_VERSION_base(4,10,0) + liftReadPrec rp rl = readData $ + readSingleFieldRecordWith (liftReadPrec rp rl) "M1" "unM1" M1 + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec rp rl = + readPrec_to_S $ + readData $ + readSingleFieldRecordWith + (readS_to_Prec (liftReadsPrec rp rl)) + "M1" + "unM1" + M1 +# endif + +instance (Eq1 f, Eq1 g) => Eq1 (f :+: g) where + liftEq eq = \lhs rhs -> case (lhs, rhs) of + (L1 a, L1 a') -> liftEq eq a a' + (R1 b, R1 b') -> liftEq eq b b' + _ -> False + +instance (Ord1 f, Ord1 g) => Ord1 (f :+: g) where + liftCompare cmp = \lhs rhs -> case (lhs, rhs) of + (L1 _, R1 _) -> LT + (R1 _, L1 _) -> GT + (L1 a, L1 a') -> liftCompare cmp a a' + (R1 b, R1 b') -> liftCompare cmp b b' + +instance (Show1 f, Show1 g) => Show1 (f :+: g) where + liftShowsPrec sp sl d = \x -> case x of + L1 a -> showsUnaryWith (liftShowsPrec sp sl) "L1" d a + R1 b -> showsUnaryWith (liftShowsPrec sp sl) "R1" d b + +instance (Read1 f, Read1 g) => Read1 (f :+: g) where +# if MIN_VERSION_base(4,10,0) + liftReadPrec rp rl = readData $ + readUnaryWith (liftReadPrec rp rl) "L1" L1 <|> + readUnaryWith (liftReadPrec rp rl) "R1" R1 + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec rp rl = + readPrec_to_S $ + readData $ + readUnaryWith (readS_to_Prec (liftReadsPrec rp rl)) "L1" L1 <|> + readUnaryWith (readS_to_Prec (liftReadsPrec rp rl)) "R1" R1 +# endif + +instance (Eq1 f, Eq1 g) => Eq1 (f :*: g) where + liftEq eq = \(f :*: g) (f' :*: g') -> liftEq eq f f' && liftEq eq g g' + +instance (Ord1 f, Ord1 g) => Ord1 (f :*: g) where + liftCompare cmp = \(f :*: g) (f' :*: g') -> liftCompare cmp f f' <> liftCompare cmp g g' + +instance (Show1 f, Show1 g) => Show1 (f :*: g) where + liftShowsPrec sp sl d = \(a :*: b) -> + showsBinaryOpWith + (liftShowsPrec sp sl) + (liftShowsPrec sp sl) + 7 + ":*:" + d + a + b + +instance (Read1 f, Read1 g) => Read1 (f :*: g) where +# if MIN_VERSION_base(4,10,0) + liftReadPrec rp rl = parens $ prec 6 $ + readBinaryOpWith (liftReadPrec rp rl) (liftReadPrec rp rl) ":*:" (:*:) + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec rp rl = + readPrec_to_S $ + parens $ prec 6 $ + readBinaryOpWith + (readS_to_Prec (liftReadsPrec rp rl)) + (readS_to_Prec (liftReadsPrec rp rl)) + ":*:" + (:*:) +# endif + +instance (Eq1 f, Eq1 g) => Eq1 (f :.: g) where + liftEq eq = \(Comp1 a) (Comp1 a') -> liftEq (liftEq eq) a a' + +instance (Ord1 f, Ord1 g) => Ord1 (f :.: g) where + liftCompare cmp = \(Comp1 a) (Comp1 a') -> liftCompare (liftCompare cmp) a a' + +instance (Show1 f, Show1 g) => Show1 (f :.: g) where + liftShowsPrec sp sl d = \(Comp1 { unComp1 = a }) -> + showsSingleFieldRecordWith + (liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl)) + "Comp1" + "unComp1" + d + a + +instance (Read1 f, Read1 g) => Read1 (f :.: g) where +# if MIN_VERSION_base(4,10,0) + liftReadPrec rp rl = readData $ + readSingleFieldRecordWith + (liftReadPrec (liftReadPrec rp rl) (liftReadListPrec rp rl)) + "Comp1" + "unComp1" + Comp1 + + liftReadListPrec = liftReadListPrecDefault + liftReadList = liftReadListDefault +# else + liftReadsPrec rp rl = + readPrec_to_S $ + readData $ + readSingleFieldRecordWith + (readS_to_Prec (liftReadsPrec (liftReadsPrec rp rl) (liftReadList rp rl))) + "Comp1" + "unComp1" + Comp1 +# endif + +instance Eq1 UAddr where + -- NB cannot use eqAddr# because its module isn't safe + liftEq _ = \(UAddr a) (UAddr b) -> UAddr a == UAddr b + +instance Ord1 UAddr where + liftCompare _ = \(UAddr a) (UAddr b) -> compare (UAddr a) (UAddr b) + +instance Show1 UAddr where + liftShowsPrec _ _ = showsPrec + +-- NB no Read1 for URec (Ptr ()) because there's no Read for Ptr. + +instance Eq1 UChar where + liftEq _ = \(UChar a) (UChar b) -> UChar a == UChar b + +instance Ord1 UChar where + liftCompare _ = \(UChar a) (UChar b) -> compare (UChar a) (UChar b) + +instance Show1 UChar where + liftShowsPrec _ _ = showsPrec + +instance Eq1 UDouble where + liftEq _ = \(UDouble a) (UDouble b) -> UDouble a == UDouble b + +instance Ord1 UDouble where + liftCompare _ = \(UDouble a) (UDouble b) -> compare (UDouble a) (UDouble b) + +instance Show1 UDouble where + liftShowsPrec _ _ = showsPrec + +instance Eq1 UFloat where + liftEq _ = \(UFloat a) (UFloat b) -> UFloat a == UFloat b + +instance Ord1 UFloat where + liftCompare _ = \(UFloat a) (UFloat b) -> compare (UFloat a) (UFloat b) + +instance Show1 UFloat where + liftShowsPrec _ _ = showsPrec + +instance Eq1 UInt where + liftEq _ = \(UInt a) (UInt b) -> UInt a == UInt b + +instance Ord1 UInt where + liftCompare _ = \(UInt a) (UInt b) -> compare (UInt a) (UInt b) + +instance Show1 UInt where + liftShowsPrec _ _ = showsPrec + +instance Eq1 UWord where + liftEq _ = \(UWord a) (UWord b) -> UWord a == UWord b + +instance Ord1 UWord where + liftCompare _ = \(UWord a) (UWord b) -> compare (UWord a) (UWord b) + +instance Show1 UWord where + liftShowsPrec _ _ = showsPrec + +readSingleFieldRecordWith :: ReadPrec a -> String -> String -> (a -> t) -> ReadPrec t +readSingleFieldRecordWith rp name field cons = parens $ prec 11 $ do + expectP $ Ident name + expectP $ Punc "{" + x <- readField field $ reset rp + expectP $ Punc "}" + pure $ cons x + +readBinaryOpWith + :: ReadPrec a + -> ReadPrec b + -> String + -> (a -> b -> t) + -> ReadPrec t +readBinaryOpWith rp1 rp2 name cons = + cons <$> step rp1 <* expectP (Symbol name) <*> step rp2 + +# if !(MIN_VERSION_base(4,10,0)) +readData :: ReadPrec a -> ReadPrec a +readData reader = parens $ prec 10 reader + +readUnaryWith :: ReadPrec a -> String -> (a -> t) -> ReadPrec t +readUnaryWith rp name cons = do + expectP $ Ident name + x <- step rp + return $ cons x +# endif + +# if !(MIN_VERSION_base(4,11,0)) +readField :: String -> ReadPrec a -> ReadPrec a +readField fieldName readVal = do + expectP (Ident fieldName) + expectP (Punc "=") + readVal +{-# NOINLINE readField #-} +# endif + +showsSingleFieldRecordWith :: (Int -> a -> ShowS) -> String -> String -> Int -> a -> ShowS +showsSingleFieldRecordWith sp name field d x = + showParen (d > appPrec) $ + showString name . showString " {" . showString field . showString " = " . sp 0 x . showChar '}' + +showsBinaryOpWith + :: (Int -> a -> ShowS) + -> (Int -> b -> ShowS) + -> Int + -> String + -> Int + -> a + -> b + -> ShowS +showsBinaryOpWith sp1 sp2 opPrec name d x y = showParen (d >= opPrec) $ + sp1 opPrec x . showChar ' ' . showString name . showChar ' ' . sp2 opPrec y + +instance Show (UAddr p) where + -- This Show instance would be equivalent to what deriving Show would generate, + -- but because deriving Show doesn't support Addr# fields we define it manually. + showsPrec d (UAddr x) = + showParen (d > appPrec) + (\y -> showString "UAddr {uAddr# = " (showsPrec 0 (Ptr x) (showChar '}' y))) +# endif #endif diff --git a/src/Data/Orphans/Prelude.hs b/src/Data/Orphans/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/Data/Orphans/Prelude.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ExplicitNamespaces #-} + +#if __GLASGOW_HASKELL__ >= 806 +{-# LANGUAGE NoStarIsType #-} +#endif + +{-# OPTIONS_GHC -Wno-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 !defined(__GLASGOW_HASKELL__) || MIN_VERSION_base(4,21,0) + () where +#else + ( module OrphansPrelude + , realPart + , imagPart + , Typeable1 + , Typeable2 + , Typeable3 + , Typeable4 + , Typeable5 + , Typeable6 + , Typeable7 + ) where + +import Control.Applicative as OrphansPrelude +import Control.Arrow as OrphansPrelude hiding ((+++), first, loop, second) +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 Control.Monad.Zip as OrphansPrelude + +import Data.Bifunctor as OrphansPrelude +import Data.Bits as OrphansPrelude +import Data.Char as OrphansPrelude +import Data.Complex as OrphansPrelude (Complex(..)) +import Data.Data as OrphansPrelude (Data(..), Constr, DataType, mkConstr, mkDataType) +import Data.Fixed as OrphansPrelude +import Data.Functor.Classes as OrphansPrelude +import Data.Functor.Compose as OrphansPrelude +import Data.Functor.Identity as OrphansPrelude +import Data.Int as OrphansPrelude +import Data.List as OrphansPrelude (genericLength) +import Data.Monoid as OrphansPrelude hiding (Any(..), (<>)) +import Data.Ord as OrphansPrelude (Down(..)) +import Data.Proxy as OrphansPrelude +import Data.Semigroup as OrphansPrelude (stimesMonoid) +import Data.String as OrphansPrelude (IsString) +import Data.Type.Coercion as OrphansPrelude (Coercion, TestCoercion) +import Data.Type.Equality as OrphansPrelude ((:~:)(..), TestEquality(..)) +import Data.Typeable as OrphansPrelude (Typeable) +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 +import Foreign.Storable as OrphansPrelude + +import GHC.Arr as OrphansPrelude (Ix(..)) +import GHC.Base as OrphansPrelude +import GHC.Conc as OrphansPrelude +import GHC.Desugar as OrphansPrelude (AnnotationWrapper) +import GHC.Exts as OrphansPrelude (IsList(..), Ptr(..)) +import GHC.Fingerprint as OrphansPrelude +import GHC.ForeignPtr as OrphansPrelude +import GHC.GHCi 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.Encoding.Failure as OrphansPrelude +import GHC.IO.Handle as OrphansPrelude +import GHC.IO.Handle.Types as OrphansPrelude +import GHC.Read as OrphansPrelude (expectP, paren) +import GHC.Real as OrphansPrelude (Ratio(..), (%)) +import GHC.ST as OrphansPrelude +import GHC.Show as OrphansPrelude (appPrec) +import GHC.Stack as OrphansPrelude +import GHC.Stats as OrphansPrelude +import GHC.TypeLits as OrphansPrelude hiding (type (*)) + +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 Text.Read as OrphansPrelude +import Text.Read.Lex as OrphansPrelude (Number) + +import Unsafe.Coerce as OrphansPrelude (unsafeCoerce) + +# if defined(mingw32_HOST_OS) +import GHC.IO.Encoding.CodePage.Table as OrphansPrelude +# endif + +# if !defined(mingw32_HOST_OS) && !defined(__GHCJS__) +import GHC.Event as OrphansPrelude +# endif + +# if !(MIN_VERSION_base(4,12,0)) +import Data.List.NonEmpty as OrphansPrelude (NonEmpty(..)) +import Data.Semigroup as OrphansPrelude (Semigroup(..)) +# endif + +# if !(MIN_VERSION_base(4,11,0)) +import Data.Typeable ( Typeable1, Typeable2, Typeable3, Typeable4 + , Typeable5, Typeable6, Typeable7 ) +# endif + +# if MIN_VERSION_base(4,17,0) && !(MIN_VERSION_base(4,18,0)) +import GHC.Generics as OrphansPrelude ( Generic(..), Generic1(..) + , Generically(..), Generically1(..) ) +# endif + +realPart, imagPart :: Complex a -> a +realPart (x :+ _) = x +imagPart (_ :+ y) = y + +# if MIN_VERSION_base(4,11,0) +type Typeable1 (a :: Type -> Type) = Typeable a +type Typeable2 (a :: Type -> Type -> Type) = Typeable a +type Typeable3 (a :: Type -> Type -> Type -> Type) = Typeable a +type Typeable4 (a :: Type -> Type -> Type -> Type -> Type) = Typeable a +type Typeable5 (a :: Type -> Type -> Type -> Type -> Type -> Type) = Typeable a +type Typeable6 (a :: Type -> Type -> Type -> Type -> Type -> Type -> Type) = Typeable a +type Typeable7 (a :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type) = Typeable a +# endif +#endif diff --git a/test/Control/Applicative/OrphansSpec.hs b/test/Control/Applicative/OrphansSpec.hs --- a/test/Control/Applicative/OrphansSpec.hs +++ b/test/Control/Applicative/OrphansSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Control.Applicative.OrphansSpec (main, spec) where import Test.Hspec @@ -17,7 +18,9 @@ Identity f <*> x = f <$> x instance Monad Identity where +#if !(MIN_VERSION_base(4,11,0)) return = Identity +#endif m >>= k = k (runIdentity m) main :: IO () diff --git a/test/Data/Bits/OrphansSpec.hs b/test/Data/Bits/OrphansSpec.hs --- a/test/Data/Bits/OrphansSpec.hs +++ b/test/Data/Bits/OrphansSpec.hs @@ -1,25 +1,18 @@ -{-# 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 diff --git a/test/Data/Version/OrphansSpec.hs b/test/Data/Version/OrphansSpec.hs --- a/test/Data/Version/OrphansSpec.hs +++ b/test/Data/Version/OrphansSpec.hs @@ -1,7 +1,5 @@ {-# LANGUAGE CPP #-} -#if MIN_VERSION_base(4,7,0) {-# LANGUAGE OverloadedLists #-} -#endif module Data.Version.OrphansSpec (main, spec) where import Test.Hspec @@ -17,10 +15,21 @@ spec = do describe "Data Version instance" $ it "allows obtaining a Version constructor" $ - dataTypeName (dataTypeOf (Version [1,2,3] [])) `shouldBe` "Data.Version.Version" + dataTypeName (dataTypeOf (Version [1,2,3] [])) `shouldBe` +#if __GLASGOW_HASKELL__ >= 801 && __GLASGOW_HASKELL__ < 903 + -- Some old versions of GHC incorrectly return "Version" due to + -- https://gitlab.haskell.org/ghc/ghc/-/issues/20371. + "Version" +#elif __GLASGOW_HASKELL__ >= 910 + -- In GHC 9.10 and later, Version is defined in + -- GHC.Internal.Data.Version (in the ghc-internal library). + "GHC.Internal.Data.Version.Version" +#else + -- In older versions of GHC, Version is defined in Data.Version (in the + -- base library). + "Data.Version.Version" +#endif -#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 diff --git a/test/Foreign/Storable/OrphansSpec.hs b/test/Foreign/Storable/OrphansSpec.hs --- a/test/Foreign/Storable/OrphansSpec.hs +++ b/test/Foreign/Storable/OrphansSpec.hs @@ -13,12 +13,12 @@ spec = do describe "Storable Complex instance" $ do it "has twice the sizeOf its realPart" $ do - sizeOf ((1 :: Double) :+ 2) `shouldBe` 2*sizeOf (1 :: Double) + sizeOf (undefined :: Complex Double) `shouldBe` 2*sizeOf (1 :: Double) it "has the alignment of its realPart" $ do - alignment ((1 :: Double) :+ 2) `shouldBe` alignment (1 :: Double) + alignment (undefined :: Complex Double) `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) + sizeOf (undefined :: Ratio Int) `shouldBe` 2*sizeOf (1 :: Int) it "has the alignment of its parameterized type" $ do - alignment ((1 :: Int) % 2) `shouldBe` alignment (1 :: Int) + alignment (undefined :: Ratio Int) `shouldBe` alignment (1 :: Int) diff --git a/test/GHC/Fingerprint/OrphansSpec.hs b/test/GHC/Fingerprint/OrphansSpec.hs --- a/test/GHC/Fingerprint/OrphansSpec.hs +++ b/test/GHC/Fingerprint/OrphansSpec.hs @@ -1,29 +1,22 @@ -{-# 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 diff --git a/test/System/Posix/Types/IntWord.hs b/test/System/Posix/Types/IntWord.hs new file mode 100644 --- /dev/null +++ b/test/System/Posix/Types/IntWord.hs @@ -0,0 +1,4 @@ +module System.Posix.Types.IntWord (module IntWord) where + +import Data.Int as IntWord +import Data.Word as IntWord diff --git a/test/System/Posix/Types/OrphansSpec.hs b/test/System/Posix/Types/OrphansSpec.hs new file mode 100644 --- /dev/null +++ b/test/System/Posix/Types/OrphansSpec.hs @@ -0,0 +1,154 @@ +{-# 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 qualified Control.Applicative as App (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 (NonNegative(..), 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" $ + pred2NonNegIntHDev setBit setBit + prop "implements clearBit" $ + pred2NonNegIntHDev clearBit clearBit + prop "implements complementBit" $ + pred2NonNegIntHDev complementBit complementBit + prop "implements testBit" $ + pred2NonNegIntEq testBit testBit + prop "implements complement" $ + pred1HDevHDev complement complement + prop "implements bit" $ + pred1NonNegIntHDev 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 = App.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 + +pred1NonNegIntHDev :: (Int -> CDev) -> (Int -> HDev) -> NonNegative Int -> Bool +pred1NonNegIntHDev f g (NonNegative x) = pred1Common eqCDevHDev f g x + +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 + +pred2NonNegIntHDev :: (CDev -> Int -> CDev) + -> (HDev -> Int -> HDev) + -> HDev -> NonNegative Int -> Bool +pred2NonNegIntHDev f g hDev (NonNegative x) = pred2Int eqCDevHDev f g hDev x + +pred2NonNegIntEq :: Eq a + => (CDev -> Int -> a) + -> (HDev -> Int -> a) + -> HDev -> NonNegative Int -> Bool +pred2NonNegIntEq f g hDev (NonNegative x) = pred2Int (==) f g hDev x +#else +spec :: Spec +spec = return () +#endif