{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
#if __GLASGOW_HASKELL__ > 702
#define DEFAULT_SIGNATURES
{-# LANGUAGE DefaultSignatures #-}
#endif
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
module Prelude.Extras
(
Eq1(..), (/=#)
, Ord1(..), (<#), (<=#), (>=#), (>#), max1, min1
, Show1(..), show1, shows1
, Read1(..), read1, reads1
#ifdef __GLASGOW_HASKELL__
, readPrec1
, readListPrec1
, readList1Default
, readListPrec1Default
#endif
, Lift1(..)
, Eq2(..), (/=##)
, Ord2(..), (<##), (<=##), (>=##), (>##), max2, min2
, Show2(..), show2, shows2
, Read2(..), read2, reads2
#ifdef __GLASGOW_HASKELL__
, readPrec2
, readListPrec2
, readList2Default
, readListPrec2Default
#endif
, Lift2(..)
) where
import Control.Applicative
import Data.Fixed
import Data.IORef (IORef)
import Data.Monoid
#if MIN_VERSION_base(4,4,0)
import Data.Complex (Complex)
import Data.Ratio (Ratio)
import Control.Concurrent (Chan, MVar)
#else
import Control.Concurrent (MVar)
#endif
import Foreign.ForeignPtr (ForeignPtr)
import Foreign.Ptr (Ptr, FunPtr)
import Foreign.StablePtr (StablePtr)
import GHC.Conc (TVar)
import Text.Read
import qualified Text.ParserCombinators.ReadP as P
import qualified Text.Read.Lex as L
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity
#else
import Data.Foldable
import Data.Traversable
#endif
#if MIN_VERSION_base(4,7,0)
import Data.Proxy
#endif
#if MIN_VERSION_base(4,6,0)
import Data.Ord (Down(..))
#endif
infixr 4 ==#, /=#, <#, <=#, >=#, >#
infixr 4 ==##, /=##, <##, <=##, >=##, >##
class Eq1 f where
(==#) :: Eq a => f a -> f a -> Bool
#ifdef DEFAULT_SIGNATURES
default (==#) :: Eq (f a) => f a -> f a -> Bool
(==#) = f a -> f a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#endif
(/=#) :: (Eq1 f, Eq a) => f a -> f a -> Bool
f a
a /=# :: forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
/=# f a
b = Bool -> Bool
not (f a
a f a -> f a -> Bool
forall a. Eq a => f a -> f a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
==# f a
b)
instance Eq1 Maybe where
==# :: forall a. Eq a => Maybe a -> Maybe a -> Bool
(==#) = Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq a => Eq1 (Either a) where
==# :: forall a. Eq a => Either a a -> Either a a -> Bool
(==#) = Either a a -> Either a a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 [] where
==# :: forall a. Eq a => [a] -> [a] -> Bool
(==#) = [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#if MIN_VERSION_base(4,8,0)
instance Eq1 Identity where ==# :: forall a. Eq a => Identity a -> Identity a -> Bool
(==#) = Identity a -> Identity a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
deriving instance Eq1 f => Eq1 (Alt f)
#endif
#if MIN_VERSION_base(4,7,0)
instance Eq1 Proxy where ==# :: forall a. Eq a => Proxy a -> Proxy a -> Bool
(==#) = Proxy a -> Proxy a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 ZipList where ==# :: forall a. Eq a => ZipList a -> ZipList a -> Bool
(==#) = ZipList a -> ZipList a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#else
instance Eq1 ZipList where ZipList xs ==# ZipList ys = xs == ys
#endif
#if MIN_VERSION_base(4,6,0)
instance Eq1 Down where ==# :: forall a. Eq a => Down a -> Down a -> Bool
(==#) = Down a -> Down a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#endif
#if MIN_VERSION_base(4,8,0)
instance Eq a => Eq1 (Const a) where ==# :: forall a. Eq a => Const a a -> Const a a -> Bool
(==#) = Const a a -> Const a a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#else
instance Eq a => Eq1 (Const a) where
Const a ==# Const b = a == b
#endif
instance Eq1 Dual where ==# :: forall a. Eq a => Dual a -> Dual a -> Bool
(==#) = Dual a -> Dual a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 Sum where ==# :: forall a. Eq a => Sum a -> Sum a -> Bool
(==#) = Sum a -> Sum a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 Product where ==# :: forall a. Eq a => Product a -> Product a -> Bool
(==#) = Product a -> Product a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 First where ==# :: forall a. Eq a => First a -> First a -> Bool
(==#) = First a -> First a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 Last where ==# :: forall a. Eq a => Last a -> Last a -> Bool
(==#) = Last a -> Last a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 Ptr where ==# :: forall a. Eq a => Ptr a -> Ptr a -> Bool
(==#) = Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 FunPtr where ==# :: forall a. Eq a => FunPtr a -> FunPtr a -> Bool
(==#) = FunPtr a -> FunPtr a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 MVar where ==# :: forall a. Eq a => MVar a -> MVar a -> Bool
(==#) = MVar a -> MVar a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 IORef where ==# :: forall a. Eq a => IORef a -> IORef a -> Bool
(==#) = IORef a -> IORef a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 ForeignPtr where ==# :: forall a. Eq a => ForeignPtr a -> ForeignPtr a -> Bool
(==#) = ForeignPtr a -> ForeignPtr a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 TVar where ==# :: forall a. Eq a => TVar a -> TVar a -> Bool
(==#) = TVar a -> TVar a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 Fixed where ==# :: forall a. Eq a => Fixed a -> Fixed a -> Bool
(==#) = Fixed a -> Fixed a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 StablePtr where ==# :: forall a. Eq a => StablePtr a -> StablePtr a -> Bool
(==#) = StablePtr a -> StablePtr a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#if MIN_VERSION_base(4,4,0)
instance Eq1 Ratio where ==# :: forall a. Eq a => Ratio a -> Ratio a -> Bool
(==#) = Ratio a -> Ratio a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 Complex where ==# :: forall a. Eq a => Complex a -> Complex a -> Bool
(==#) = Complex a -> Complex a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq1 Chan where ==# :: forall a. Eq a => Chan a -> Chan a -> Bool
(==#) = Chan a -> Chan a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#endif
instance Eq a => Eq1 ((,) a) where ==# :: forall a. Eq a => (a, a) -> (a, a) -> Bool
(==#) = (a, a) -> (a, a) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b) => Eq1 ((,,) a b) where ==# :: forall a. Eq a => (a, b, a) -> (a, b, a) -> Bool
(==#) = (a, b, a) -> (a, b, a) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c) => Eq1 ((,,,) a b c) where ==# :: forall a. Eq a => (a, b, c, a) -> (a, b, c, a) -> Bool
(==#) = (a, b, c, a) -> (a, b, c, a) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d) => Eq1 ((,,,,) a b c d) where ==# :: forall a. Eq a => (a, b, c, d, a) -> (a, b, c, d, a) -> Bool
(==#) = (a, b, c, d, a) -> (a, b, c, d, a) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq1 ((,,,,,) a b c d e) where ==# :: forall a. Eq a => (a, b, c, d, e, a) -> (a, b, c, d, e, a) -> Bool
(==#) = (a, b, c, d, e, a) -> (a, b, c, d, e, a) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f) => Eq1 ((,,,,,,) a b c d e f) where ==# :: forall a.
Eq a =>
(a, b, c, d, e, f, a) -> (a, b, c, d, e, f, a) -> Bool
(==#) = (a, b, c, d, e, f, a) -> (a, b, c, d, e, f, a) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) => Eq1 ((,,,,,,,) a b c d e f g) where ==# :: forall a.
Eq a =>
(a, b, c, d, e, f, g, a) -> (a, b, c, d, e, f, g, a) -> Bool
(==#) = (a, b, c, d, e, f, g, a) -> (a, b, c, d, e, f, g, a) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h) => Eq1 ((,,,,,,,,) a b c d e f g h) where ==# :: forall a.
Eq a =>
(a, b, c, d, e, f, g, h, a) -> (a, b, c, d, e, f, g, h, a) -> Bool
(==#) = (a, b, c, d, e, f, g, h, a) -> (a, b, c, d, e, f, g, h, a) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i) => Eq1 ((,,,,,,,,,) a b c d e f g h i) where ==# :: forall a.
Eq a =>
(a, b, c, d, e, f, g, h, i, a)
-> (a, b, c, d, e, f, g, h, i, a) -> Bool
(==#) = (a, b, c, d, e, f, g, h, i, a)
-> (a, b, c, d, e, f, g, h, i, a) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
class Eq2 f where
(==##) :: (Eq a, Eq b) => f a b -> f a b -> Bool
#ifdef DEFAULT_SIGNATURES
default (==##) :: Eq (f a b) => f a b -> f a b -> Bool
(==##) = f a b -> f a b -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#endif
(/=##) :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool
f a b
a /=## :: forall (f :: * -> * -> *) a b.
(Eq2 f, Eq a, Eq b) =>
f a b -> f a b -> Bool
/=## f a b
b = Bool -> Bool
not (f a b
a f a b -> f a b -> Bool
forall a b. (Eq a, Eq b) => f a b -> f a b -> Bool
forall (f :: * -> * -> *) a b.
(Eq2 f, Eq a, Eq b) =>
f a b -> f a b -> Bool
==## f a b
b)
instance Eq2 Either where ==## :: forall a b. (Eq a, Eq b) => Either a b -> Either a b -> Bool
(==##) = Either a b -> Either a b -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#if MIN_VERSION_base(4,8,0)
instance Eq2 Const where ==## :: forall a b. (Eq a, Eq b) => Const a b -> Const a b -> Bool
(==##) = Const a b -> Const a b -> Bool
forall a. Eq a => a -> a -> Bool
(==)
#else
instance Eq2 Const where Const x ==## Const y = x == y
#endif
instance Eq2 (,) where ==## :: forall a b. (Eq a, Eq b) => (a, b) -> (a, b) -> Bool
(==##) = (a, b) -> (a, b) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Eq a => Eq2 ((,,) a) where ==## :: forall a b. (Eq a, Eq b) => (a, a, b) -> (a, a, b) -> Bool
(==##) = (a, a, b) -> (a, a, b) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b) => Eq2 ((,,,) a b) where ==## :: forall a b. (Eq a, Eq b) => (a, b, a, b) -> (a, b, a, b) -> Bool
(==##) = (a, b, a, b) -> (a, b, a, b) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c) => Eq2 ((,,,,) a b c) where ==## :: forall a b.
(Eq a, Eq b) =>
(a, b, c, a, b) -> (a, b, c, a, b) -> Bool
(==##) = (a, b, c, a, b) -> (a, b, c, a, b) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d) => Eq2 ((,,,,,) a b c d) where ==## :: forall a b.
(Eq a, Eq b) =>
(a, b, c, d, a, b) -> (a, b, c, d, a, b) -> Bool
(==##) = (a, b, c, d, a, b) -> (a, b, c, d, a, b) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq2 ((,,,,,,) a b c d e) where ==## :: forall a b.
(Eq a, Eq b) =>
(a, b, c, d, e, a, b) -> (a, b, c, d, e, a, b) -> Bool
(==##) = (a, b, c, d, e, a, b) -> (a, b, c, d, e, a, b) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f) => Eq2 ((,,,,,,,) a b c d e f) where ==## :: forall a b.
(Eq a, Eq b) =>
(a, b, c, d, e, f, a, b) -> (a, b, c, d, e, f, a, b) -> Bool
(==##) = (a, b, c, d, e, f, a, b) -> (a, b, c, d, e, f, a, b) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) => Eq2 ((,,,,,,,,) a b c d e f g) where ==## :: forall a b.
(Eq a, Eq b) =>
(a, b, c, d, e, f, g, a, b) -> (a, b, c, d, e, f, g, a, b) -> Bool
(==##) = (a, b, c, d, e, f, g, a, b) -> (a, b, c, d, e, f, g, a, b) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h) => Eq2 ((,,,,,,,,,) a b c d e f g h) where ==## :: forall a b.
(Eq a, Eq b) =>
(a, b, c, d, e, f, g, h, a, b)
-> (a, b, c, d, e, f, g, h, a, b) -> Bool
(==##) = (a, b, c, d, e, f, g, h, a, b)
-> (a, b, c, d, e, f, g, h, a, b) -> Bool
forall a. Eq a => a -> a -> Bool
(==)
class Eq1 f => Ord1 f where
compare1 :: Ord a => f a -> f a -> Ordering
#ifdef DEFAULT_SIGNATURES
default compare1 :: Ord (f a) => f a -> f a -> Ordering
compare1 = f a -> f a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
#endif
(<#), (<=#), (>=#), (>#) :: (Ord1 f, Ord a) => f a -> f a -> Bool
max1, min1 :: (Ord1 f, Ord a) => f a -> f a -> f a
f a
x <=# :: forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Bool
<=# f a
y = f a -> f a -> Ordering
forall a. Ord a => f a -> f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 f a
x f a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT
f a
x <# :: forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Bool
<# f a
y = f a -> f a -> Ordering
forall a. Ord a => f a -> f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 f a
x f a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
f a
x >=# :: forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Bool
>=# f a
y = f a -> f a -> Ordering
forall a. Ord a => f a -> f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 f a
x f a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT
f a
x ># :: forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Bool
># f a
y = f a -> f a -> Ordering
forall a. Ord a => f a -> f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 f a
x f a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
max1 :: forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> f a
max1 f a
x f a
y
| f a
x f a -> f a -> Bool
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Bool
>=# f a
y = f a
x
| Bool
otherwise = f a
y
min1 :: forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> f a
min1 f a
x f a
y
| f a
x f a -> f a -> Bool
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Bool
<# f a
y = f a
x
| Bool
otherwise = f a
y
instance Ord1 Maybe where compare1 :: forall a. Ord a => Maybe a -> Maybe a -> Ordering
compare1 = Maybe a -> Maybe a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord a => Ord1 (Either a) where compare1 :: forall a. Ord a => Either a a -> Either a a -> Ordering
compare1 = Either a a -> Either a a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord1 [] where compare1 :: forall a. Ord a => [a] -> [a] -> Ordering
compare1 = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
#if MIN_VERSION_base(4,8,0)
instance Ord1 Identity where compare1 :: forall a. Ord a => Identity a -> Identity a -> Ordering
compare1 = Identity a -> Identity a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
deriving instance Ord1 f => Ord1 (Alt f)
#endif
#if MIN_VERSION_base(4,7,0)
instance Ord1 Proxy where compare1 :: forall a. Ord a => Proxy a -> Proxy a -> Ordering
compare1 = Proxy a -> Proxy a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord1 ZipList where compare1 :: forall a. Ord a => ZipList a -> ZipList a -> Ordering
compare1 = ZipList a -> ZipList a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
#else
instance Ord1 ZipList where compare1 (ZipList xs) (ZipList ys) = compare xs ys
#endif
#if MIN_VERSION_base(4,6,0)
instance Ord1 Down where compare1 :: forall a. Ord a => Down a -> Down a -> Ordering
compare1 = Down a -> Down a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
#endif
#if MIN_VERSION_base(4,8,0)
instance Ord a => Ord1 (Const a) where compare1 :: forall a. Ord a => Const a a -> Const a a -> Ordering
compare1 = Const a a -> Const a a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
#else
instance Ord a => Ord1 (Const a) where
compare1 (Const x) (Const y) = compare x y
#endif
instance Ord1 Dual where compare1 :: forall a. Ord a => Dual a -> Dual a -> Ordering
compare1 = Dual a -> Dual a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord1 Sum where compare1 :: forall a. Ord a => Sum a -> Sum a -> Ordering
compare1 = Sum a -> Sum a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord1 Product where compare1 :: forall a. Ord a => Product a -> Product a -> Ordering
compare1 = Product a -> Product a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord1 First where compare1 :: forall a. Ord a => First a -> First a -> Ordering
compare1 = First a -> First a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord1 Last where compare1 :: forall a. Ord a => Last a -> Last a -> Ordering
compare1 = Last a -> Last a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord1 Ptr where compare1 :: forall a. Ord a => Ptr a -> Ptr a -> Ordering
compare1 = Ptr a -> Ptr a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord1 FunPtr where compare1 :: forall a. Ord a => FunPtr a -> FunPtr a -> Ordering
compare1 = FunPtr a -> FunPtr a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord1 ForeignPtr where compare1 :: forall a. Ord a => ForeignPtr a -> ForeignPtr a -> Ordering
compare1 = ForeignPtr a -> ForeignPtr a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord1 Fixed where compare1 :: forall a. Ord a => Fixed a -> Fixed a -> Ordering
compare1 = Fixed a -> Fixed a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord a => Ord1 ((,) a) where compare1 :: forall a. Ord a => (a, a) -> (a, a) -> Ordering
compare1 = (a, a) -> (a, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b) => Ord1 ((,,) a b) where compare1 :: forall a. Ord a => (a, b, a) -> (a, b, a) -> Ordering
compare1 = (a, b, a) -> (a, b, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c) => Ord1 ((,,,) a b c) where compare1 :: forall a. Ord a => (a, b, c, a) -> (a, b, c, a) -> Ordering
compare1 = (a, b, c, a) -> (a, b, c, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d) => Ord1 ((,,,,) a b c d) where compare1 :: forall a. Ord a => (a, b, c, d, a) -> (a, b, c, d, a) -> Ordering
compare1 = (a, b, c, d, a) -> (a, b, c, d, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord1 ((,,,,,) a b c d e) where compare1 :: forall a.
Ord a =>
(a, b, c, d, e, a) -> (a, b, c, d, e, a) -> Ordering
compare1 = (a, b, c, d, e, a) -> (a, b, c, d, e, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) => Ord1 ((,,,,,,) a b c d e f) where compare1 :: forall a.
Ord a =>
(a, b, c, d, e, f, a) -> (a, b, c, d, e, f, a) -> Ordering
compare1 = (a, b, c, d, e, f, a) -> (a, b, c, d, e, f, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) => Ord1 ((,,,,,,,) a b c d e f g) where compare1 :: forall a.
Ord a =>
(a, b, c, d, e, f, g, a) -> (a, b, c, d, e, f, g, a) -> Ordering
compare1 = (a, b, c, d, e, f, g, a) -> (a, b, c, d, e, f, g, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) => Ord1 ((,,,,,,,,) a b c d e f g h) where compare1 :: forall a.
Ord a =>
(a, b, c, d, e, f, g, h, a)
-> (a, b, c, d, e, f, g, h, a) -> Ordering
compare1 = (a, b, c, d, e, f, g, h, a)
-> (a, b, c, d, e, f, g, h, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) => Ord1 ((,,,,,,,,,) a b c d e f g h i) where compare1 :: forall a.
Ord a =>
(a, b, c, d, e, f, g, h, i, a)
-> (a, b, c, d, e, f, g, h, i, a) -> Ordering
compare1 = (a, b, c, d, e, f, g, h, i, a)
-> (a, b, c, d, e, f, g, h, i, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
class Eq2 f => Ord2 f where
compare2 :: (Ord a, Ord b) => f a b -> f a b -> Ordering
#ifdef DEFAULT_SIGNATURES
default compare2 :: Ord (f a b) => f a b -> f a b -> Ordering
compare2 = f a b -> f a b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
#endif
(<##) :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Bool
f a b
x <=## :: forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Bool
<=## f a b
y = f a b -> f a b -> Ordering
forall a b. (Ord a, Ord b) => f a b -> f a b -> Ordering
forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Ordering
compare2 f a b
x f a b
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT
(<=##) :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Bool
f a b
x <## :: forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Bool
<## f a b
y = f a b -> f a b -> Ordering
forall a b. (Ord a, Ord b) => f a b -> f a b -> Ordering
forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Ordering
compare2 f a b
x f a b
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
(>=##) :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Bool
f a b
x >=## :: forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Bool
>=## f a b
y = f a b -> f a b -> Ordering
forall a b. (Ord a, Ord b) => f a b -> f a b -> Ordering
forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Ordering
compare2 f a b
x f a b
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT
(>##) :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Bool
f a b
x >## :: forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Bool
>## f a b
y = f a b -> f a b -> Ordering
forall a b. (Ord a, Ord b) => f a b -> f a b -> Ordering
forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Ordering
compare2 f a b
x f a b
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
max2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> f a b
max2 :: forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> f a b
max2 f a b
x f a b
y
| f a b
x f a b -> f a b -> Bool
forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Bool
>=## f a b
y = f a b
x
| Bool
otherwise = f a b
y
min2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> f a b
min2 :: forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> f a b
min2 f a b
x f a b
y
| f a b
x f a b -> f a b -> Bool
forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Bool
<## f a b
y = f a b
x
| Bool
otherwise = f a b
y
instance Ord2 Either where compare2 :: forall a b. (Ord a, Ord b) => Either a b -> Either a b -> Ordering
compare2 = Either a b -> Either a b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
#if MIN_VERSION_base(4,8,0)
instance Ord2 Const where compare2 :: forall a b. (Ord a, Ord b) => Const a b -> Const a b -> Ordering
compare2 = Const a b -> Const a b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
#else
instance Ord2 Const where Const x `compare2` Const y = compare x y
#endif
instance Ord2 (,) where compare2 :: forall a b. (Ord a, Ord b) => (a, b) -> (a, b) -> Ordering
compare2 = (a, b) -> (a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance Ord a => Ord2 ((,,) a) where compare2 :: forall a b. (Ord a, Ord b) => (a, a, b) -> (a, a, b) -> Ordering
compare2 = (a, a, b) -> (a, a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b) => Ord2 ((,,,) a b) where compare2 :: forall a b.
(Ord a, Ord b) =>
(a, b, a, b) -> (a, b, a, b) -> Ordering
compare2 = (a, b, a, b) -> (a, b, a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c) => Ord2 ((,,,,) a b c) where compare2 :: forall a b.
(Ord a, Ord b) =>
(a, b, c, a, b) -> (a, b, c, a, b) -> Ordering
compare2 = (a, b, c, a, b) -> (a, b, c, a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d) => Ord2 ((,,,,,) a b c d) where compare2 :: forall a b.
(Ord a, Ord b) =>
(a, b, c, d, a, b) -> (a, b, c, d, a, b) -> Ordering
compare2 = (a, b, c, d, a, b) -> (a, b, c, d, a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord2 ((,,,,,,) a b c d e) where compare2 :: forall a b.
(Ord a, Ord b) =>
(a, b, c, d, e, a, b) -> (a, b, c, d, e, a, b) -> Ordering
compare2 = (a, b, c, d, e, a, b) -> (a, b, c, d, e, a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) => Ord2 ((,,,,,,,) a b c d e f) where compare2 :: forall a b.
(Ord a, Ord b) =>
(a, b, c, d, e, f, a, b) -> (a, b, c, d, e, f, a, b) -> Ordering
compare2 = (a, b, c, d, e, f, a, b) -> (a, b, c, d, e, f, a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) => Ord2 ((,,,,,,,,) a b c d e f g) where compare2 :: forall a b.
(Ord a, Ord b) =>
(a, b, c, d, e, f, g, a, b)
-> (a, b, c, d, e, f, g, a, b) -> Ordering
compare2 = (a, b, c, d, e, f, g, a, b)
-> (a, b, c, d, e, f, g, a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) => Ord2 ((,,,,,,,,,) a b c d e f g h) where compare2 :: forall a b.
(Ord a, Ord b) =>
(a, b, c, d, e, f, g, h, a, b)
-> (a, b, c, d, e, f, g, h, a, b) -> Ordering
compare2 = (a, b, c, d, e, f, g, h, a, b)
-> (a, b, c, d, e, f, g, h, a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
class Show1 f where
showsPrec1 :: Show a => Int -> f a -> ShowS
#ifdef DEFAULT_SIGNATURES
default showsPrec1 :: Show (f a) => Int -> f a -> ShowS
showsPrec1 = Int -> f a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
#endif
showList1 :: (Show a) => [f a] -> ShowS
showList1 [f a]
ls String
s = (f a -> ShowS) -> [f a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showList__ f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => f a -> ShowS
shows1 [f a]
ls String
s
show1 :: (Show1 f, Show a) => f a -> String
show1 :: forall (f :: * -> *) a. (Show1 f, Show a) => f a -> String
show1 f a
x = f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => f a -> ShowS
shows1 f a
x String
""
shows1 :: (Show1 f, Show a) => f a -> ShowS
shows1 :: forall (f :: * -> *) a. (Show1 f, Show a) => f a -> ShowS
shows1 = Int -> f a -> ShowS
forall a. Show a => Int -> f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
0
instance Show1 Maybe where showsPrec1 :: forall a. Show a => Int -> Maybe a -> ShowS
showsPrec1 = Int -> Maybe a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show1 [] where showsPrec1 :: forall a. Show a => Int -> [a] -> ShowS
showsPrec1 = Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show a => Show1 (Either a) where showsPrec1 :: forall a. Show a => Int -> Either a a -> ShowS
showsPrec1 = Int -> Either a a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
#if MIN_VERSION_base(4,8,0)
instance Show1 Identity where showsPrec1 :: forall a. Show a => Int -> Identity a -> ShowS
showsPrec1 = Int -> Identity a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
#endif
#if MIN_VERSION_base(4,7,0)
instance Show1 Proxy where showsPrec1 :: forall a. Show a => Int -> Proxy a -> ShowS
showsPrec1 = Int -> Proxy a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show1 ZipList where showsPrec1 :: forall a. Show a => Int -> ZipList a -> ShowS
showsPrec1 = Int -> ZipList a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
#else
instance Show1 ZipList where
showsPrec1 p (ZipList xs)
= showString "ZipList {getZipList = "
. showList xs
. showString "}"
#endif
#if MIN_VERSION_base(4,8,0)
instance Show1 Down where showsPrec1 :: forall a. Show a => Int -> Down a -> ShowS
showsPrec1 = Int -> Down a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show1 f => Show1 (Alt f) where
showsPrec1 :: forall a. Show a => Int -> Alt f a -> ShowS
showsPrec1 Int
p (Alt f a
x)
= Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
(ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Alt "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f a -> ShowS
forall a. Show a => Int -> f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
11 f a
x
#endif
#if MIN_VERSION_base(4,8,0)
instance Show a => Show1 (Const a) where showsPrec1 :: forall a. Show a => Int -> Const a a -> ShowS
showsPrec1 = Int -> Const a a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
#else
instance Show a => Show1 (Const a) where
showsPrec1 p (Const x)
= showParen (p > 10)
$ showString "Const "
. showsPrec 11 x
#endif
instance Show1 Dual where showsPrec1 :: forall a. Show a => Int -> Dual a -> ShowS
showsPrec1 = Int -> Dual a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show1 Sum where showsPrec1 :: forall a. Show a => Int -> Sum a -> ShowS
showsPrec1 = Int -> Sum a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show1 Product where showsPrec1 :: forall a. Show a => Int -> Product a -> ShowS
showsPrec1 = Int -> Product a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show1 First where showsPrec1 :: forall a. Show a => Int -> First a -> ShowS
showsPrec1 = Int -> First a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show1 Last where showsPrec1 :: forall a. Show a => Int -> Last a -> ShowS
showsPrec1 = Int -> Last a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show1 Ptr where showsPrec1 :: forall a. Show a => Int -> Ptr a -> ShowS
showsPrec1 = Int -> Ptr a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show1 FunPtr where showsPrec1 :: forall a. Show a => Int -> FunPtr a -> ShowS
showsPrec1 = Int -> FunPtr a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show1 ForeignPtr where showsPrec1 :: forall a. Show a => Int -> ForeignPtr a -> ShowS
showsPrec1 = Int -> ForeignPtr a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
#if MIN_VERSION_base(4,4,0)
instance Show1 Complex where showsPrec1 :: forall a. Show a => Int -> Complex a -> ShowS
showsPrec1 = Int -> Complex a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
#endif
instance Show a => Show1 ((,) a) where showsPrec1 :: forall a. Show a => Int -> (a, a) -> ShowS
showsPrec1 = Int -> (a, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b) => Show1 ((,,) a b) where showsPrec1 :: forall a. Show a => Int -> (a, b, a) -> ShowS
showsPrec1 = Int -> (a, b, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c) => Show1 ((,,,) a b c) where showsPrec1 :: forall a. Show a => Int -> (a, b, c, a) -> ShowS
showsPrec1 = Int -> (a, b, c, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d) => Show1 ((,,,,) a b c d) where showsPrec1 :: forall a. Show a => Int -> (a, b, c, d, a) -> ShowS
showsPrec1 = Int -> (a, b, c, d, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d, Show e) => Show1 ((,,,,,) a b c d e) where showsPrec1 :: forall a. Show a => Int -> (a, b, c, d, e, a) -> ShowS
showsPrec1 = Int -> (a, b, c, d, e, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show1 ((,,,,,,) a b c d e f) where showsPrec1 :: forall a. Show a => Int -> (a, b, c, d, e, f, a) -> ShowS
showsPrec1 = Int -> (a, b, c, d, e, f, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) => Show1 ((,,,,,,,) a b c d e f g) where showsPrec1 :: forall a. Show a => Int -> (a, b, c, d, e, f, g, a) -> ShowS
showsPrec1 = Int -> (a, b, c, d, e, f, g, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) => Show1 ((,,,,,,,,) a b c d e f g h) where showsPrec1 :: forall a. Show a => Int -> (a, b, c, d, e, f, g, h, a) -> ShowS
showsPrec1 = Int -> (a, b, c, d, e, f, g, h, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i) => Show1 ((,,,,,,,,,) a b c d e f g h i) where showsPrec1 :: forall a. Show a => Int -> (a, b, c, d, e, f, g, h, i, a) -> ShowS
showsPrec1 = Int -> (a, b, c, d, e, f, g, h, i, a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
class Show2 f where
showsPrec2 :: (Show a, Show b) => Int -> f a b -> ShowS
#ifdef DEFAULT_SIGNATURES
default showsPrec2 :: Show (f a b) => Int -> f a b -> ShowS
showsPrec2 = Int -> f a b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
#endif
showList2 :: (Show a, Show b) => [f a b] -> ShowS
showList2 [f a b]
ls String
s = (f a b -> ShowS) -> [f a b] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showList__ f a b -> ShowS
forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
f a b -> ShowS
shows2 [f a b]
ls String
s
show2 :: (Show2 f, Show a, Show b) => f a b -> String
show2 :: forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
f a b -> String
show2 f a b
x = f a b -> ShowS
forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
f a b -> ShowS
shows2 f a b
x String
""
shows2 :: (Show2 f, Show a, Show b) => f a b -> ShowS
shows2 :: forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
f a b -> ShowS
shows2 = Int -> f a b -> ShowS
forall a b. (Show a, Show b) => Int -> f a b -> ShowS
forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> f a b -> ShowS
showsPrec2 Int
0
instance Show2 Either where showsPrec2 :: forall a b. (Show a, Show b) => Int -> Either a b -> ShowS
showsPrec2 = Int -> Either a b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
#if MIN_VERSION_base(4,8,0)
instance Show2 Const where showsPrec2 :: forall a b. (Show a, Show b) => Int -> Const a b -> ShowS
showsPrec2 = Int -> Const a b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
#else
instance Show2 Const where showsPrec2 = showsPrec1
#endif
instance Show2 (,) where showsPrec2 :: forall a b. (Show a, Show b) => Int -> (a, b) -> ShowS
showsPrec2 = Int -> (a, b) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance Show a => Show2 ((,,) a) where showsPrec2 :: forall a b. (Show a, Show b) => Int -> (a, a, b) -> ShowS
showsPrec2 = Int -> (a, a, b) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b) => Show2 ((,,,) a b) where showsPrec2 :: forall a b. (Show a, Show b) => Int -> (a, b, a, b) -> ShowS
showsPrec2 = Int -> (a, b, a, b) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c) => Show2 ((,,,,) a b c) where showsPrec2 :: forall a b. (Show a, Show b) => Int -> (a, b, c, a, b) -> ShowS
showsPrec2 = Int -> (a, b, c, a, b) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d) => Show2 ((,,,,,) a b c d) where showsPrec2 :: forall a b. (Show a, Show b) => Int -> (a, b, c, d, a, b) -> ShowS
showsPrec2 = Int -> (a, b, c, d, a, b) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d, Show e) => Show2 ((,,,,,,) a b c d e) where showsPrec2 :: forall a b.
(Show a, Show b) =>
Int -> (a, b, c, d, e, a, b) -> ShowS
showsPrec2 = Int -> (a, b, c, d, e, a, b) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show2 ((,,,,,,,) a b c d e f) where showsPrec2 :: forall a b.
(Show a, Show b) =>
Int -> (a, b, c, d, e, f, a, b) -> ShowS
showsPrec2 = Int -> (a, b, c, d, e, f, a, b) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) => Show2 ((,,,,,,,,) a b c d e f g) where showsPrec2 :: forall a b.
(Show a, Show b) =>
Int -> (a, b, c, d, e, f, g, a, b) -> ShowS
showsPrec2 = Int -> (a, b, c, d, e, f, g, a, b) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) => Show2 ((,,,,,,,,,) a b c d e f g h) where showsPrec2 :: forall a b.
(Show a, Show b) =>
Int -> (a, b, c, d, e, f, g, h, a, b) -> ShowS
showsPrec2 = Int -> (a, b, c, d, e, f, g, h, a, b) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
showList__ :: (a -> ShowS) -> [a] -> ShowS
showList__ :: forall a. (a -> ShowS) -> [a] -> ShowS
showList__ a -> ShowS
_ [] String
s = String
"[]" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
showList__ a -> ShowS
showx (a
x:[a]
xs) String
s = Char
'[' Char -> ShowS
forall a. a -> [a] -> [a]
: a -> ShowS
showx a
x ([a] -> String
showl [a]
xs)
where
showl :: [a] -> String
showl [] = Char
']' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
showl (a
y:[a]
ys) = Char
',' Char -> ShowS
forall a. a -> [a] -> [a]
: a -> ShowS
showx a
y ([a] -> String
showl [a]
ys)
class Read1 f where
readsPrec1 :: Read a => Int -> ReadS (f a)
#ifdef DEFAULT_SIGNATURES
default readsPrec1 :: Read (f a) => Int -> ReadS (f a)
readsPrec1 = Int -> ReadS (f a)
forall a. Read a => Int -> ReadS a
readsPrec
#endif
readList1 :: (Read a) => ReadS [f a]
readList1 = ReadPrec [f a] -> Int -> ReadS [f a]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S (ReadPrec (f a) -> ReadPrec [f a]
forall a. ReadPrec a -> ReadPrec [a]
list ReadPrec (f a)
forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec (f a)
readPrec1) Int
0
#ifdef __GLASGOW_HASKELL__
readPrec1 :: (Read1 f, Read a) => ReadPrec (f a)
readPrec1 :: forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec (f a)
readPrec1 = (Int -> ReadS (f a)) -> ReadPrec (f a)
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS (f a)
forall a. Read a => Int -> ReadS (f a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1
readListPrec1 :: (Read1 f, Read a) => ReadPrec [f a]
readListPrec1 :: forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec [f a]
readListPrec1 = (Int -> ReadS [f a]) -> ReadPrec [f a]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (\Int
_ -> ReadS [f a]
forall a. Read a => ReadS [f a]
forall (f :: * -> *) a. (Read1 f, Read a) => ReadS [f a]
readList1)
#endif
read1 :: (Read1 f, Read a) => String -> f a
read1 :: forall (f :: * -> *) a. (Read1 f, Read a) => String -> f a
read1 String
s = (String -> f a) -> (f a -> f a) -> Either String (f a) -> f a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> f a
forall a. HasCallStack => String -> a
error f a -> f a
forall a. a -> a
id (String -> Either String (f a)
forall (f :: * -> *) a.
(Read1 f, Read a) =>
String -> Either String (f a)
readEither1 String
s)
reads1 :: (Read1 f, Read a) => ReadS (f a)
reads1 :: forall (f :: * -> *) a. (Read1 f, Read a) => ReadS (f a)
reads1 = Int -> ReadS (f a)
forall a. Read a => Int -> ReadS (f a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1 Int
minPrec
readEither1 :: (Read1 f, Read a) => String -> Either String (f a)
readEither1 :: forall (f :: * -> *) a.
(Read1 f, Read a) =>
String -> Either String (f a)
readEither1 String
s =
case [ f a
x | (f a
x,String
"") <- ReadPrec (f a) -> Int -> ReadS (f a)
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec (f a)
read' Int
minPrec String
s ] of
[f a
x] -> f a -> Either String (f a)
forall a b. b -> Either a b
Right f a
x
[] -> String -> Either String (f a)
forall a b. a -> Either a b
Left String
"Prelude.read: no parse"
[f a]
_ -> String -> Either String (f a)
forall a b. a -> Either a b
Left String
"Prelude.read: ambiguous parse"
where
read' :: ReadPrec (f a)
read' =
do f a
x <- ReadPrec (f a)
forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec (f a)
readPrec1
ReadP () -> ReadPrec ()
forall a. ReadP a -> ReadPrec a
lift ReadP ()
P.skipSpaces
f a -> ReadPrec (f a)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return f a
x
#ifdef __GLASGOW_HASKELL__
readList1Default :: (Read1 f, Read a) => ReadS [f a]
readList1Default :: forall (f :: * -> *) a. (Read1 f, Read a) => ReadS [f a]
readList1Default = ReadPrec [f a] -> Int -> ReadS [f a]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec [f a]
forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec [f a]
readListPrec1 Int
0
readListPrec1Default :: (Read1 f, Read a) => ReadPrec [f a]
readListPrec1Default :: forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec [f a]
readListPrec1Default = ReadPrec (f a) -> ReadPrec [f a]
forall a. ReadPrec a -> ReadPrec [a]
list ReadPrec (f a)
forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec (f a)
readPrec1
#endif
instance Read1 [] where
readsPrec1 :: forall a. Read a => Int -> ReadS [a]
readsPrec1 = Int -> ReadS [a]
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [[a]]
readList1 = ReadS [[a]]
forall a. Read a => ReadS [a]
readList
instance Read1 Maybe where
readsPrec1 :: forall a. Read a => Int -> ReadS (Maybe a)
readsPrec1 = Int -> ReadS (Maybe a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Maybe a]
readList1 = ReadS [Maybe a]
forall a. Read a => ReadS [a]
readList
instance Read a => Read1 (Either a) where
readsPrec1 :: forall a. Read a => Int -> ReadS (Either a a)
readsPrec1 = Int -> ReadS (Either a a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Either a a]
readList1 = ReadS [Either a a]
forall a. Read a => ReadS [a]
readList
#if MIN_VERSION_base(4,8,0)
instance Read1 Identity where
readsPrec1 :: forall a. Read a => Int -> ReadS (Identity a)
readsPrec1 = Int -> ReadS (Identity a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Identity a]
readList1 = ReadS [Identity a]
forall a. Read a => ReadS [a]
readList
instance Read1 f => Read1 (Alt f) where
readsPrec1 :: forall a. Read a => Int -> ReadS (Alt f a)
readsPrec1 Int
p
= Bool -> ReadS (Alt f a) -> ReadS (Alt f a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Alt f a) -> ReadS (Alt f a))
-> ReadS (Alt f a) -> ReadS (Alt f a)
forall a b. (a -> b) -> a -> b
$ \String
s ->
do (String
"Alt",String
s1) <- ReadS String
lex String
s
(f a
x,String
s2) <- Int -> ReadS (f a)
forall a. Read a => Int -> ReadS (f a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1 Int
11 String
s1
(Alt f a, String) -> [(Alt f a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (f a -> Alt f a
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt f a
x, String
s2)
#endif
#if MIN_VERSION_base(4,7,0)
instance Read1 Proxy where
readsPrec1 :: forall a. Read a => Int -> ReadS (Proxy a)
readsPrec1 = Int -> ReadS (Proxy a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Proxy a]
readList1 = ReadS [Proxy a]
forall a. Read a => ReadS [a]
readList
instance Read1 ZipList where
readsPrec1 :: forall a. Read a => Int -> ReadS (ZipList a)
readsPrec1 = Int -> ReadS (ZipList a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [ZipList a]
readList1 = ReadS [ZipList a]
forall a. Read a => ReadS [a]
readList
#else
instance Read1 ZipList where
readsPrec1 _
= readParen False $ \s ->
do ("ZipList" , s1) <- lex s
("{" , s2) <- lex s1
("getZipList", s3) <- lex s2
("=" , s4) <- lex s3
(xs , s5) <- readList s4
("}" , s6) <- lex s5
return (ZipList xs, s6)
#endif
#if MIN_VERSION_base(4,7,0)
instance Read1 Down where
readsPrec1 :: forall a. Read a => Int -> ReadS (Down a)
readsPrec1 = Int -> ReadS (Down a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Down a]
readList1 = ReadS [Down a]
forall a. Read a => ReadS [a]
readList
#elif MIN_VERSION_base(4,6,0)
instance Read1 Down where
readsPrec1 p = readParen (p > 10) $ \s ->
do ("Down",s1) <- lex s
(x ,s2) <- readsPrec 11 s1
return (Down x, s2)
#endif
#if MIN_VERSION_base(4,8,0)
instance Read a => Read1 (Const a) where
readsPrec1 :: forall a. Read a => Int -> ReadS (Const a a)
readsPrec1 = Int -> ReadS (Const a a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Const a a]
readList1 = ReadS [Const a a]
forall a. Read a => ReadS [a]
readList
#else
instance Read a => Read1 (Const a) where
readsPrec1 p = readParen (p > 10) $ \s ->
do ("Const",s1) <- lex s
(x ,s2) <- readsPrec 11 s1
return (Const x, s2)
#endif
instance Read1 Dual where
readsPrec1 :: forall a. Read a => Int -> ReadS (Dual a)
readsPrec1 = Int -> ReadS (Dual a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Dual a]
readList1 = ReadS [Dual a]
forall a. Read a => ReadS [a]
readList
instance Read1 Sum where
readsPrec1 :: forall a. Read a => Int -> ReadS (Sum a)
readsPrec1 = Int -> ReadS (Sum a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Sum a]
readList1 = ReadS [Sum a]
forall a. Read a => ReadS [a]
readList
instance Read1 Product where
readsPrec1 :: forall a. Read a => Int -> ReadS (Product a)
readsPrec1 = Int -> ReadS (Product a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Product a]
readList1 = ReadS [Product a]
forall a. Read a => ReadS [a]
readList
instance Read1 First where
readsPrec1 :: forall a. Read a => Int -> ReadS (First a)
readsPrec1 = Int -> ReadS (First a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [First a]
readList1 = ReadS [First a]
forall a. Read a => ReadS [a]
readList
instance Read1 Last where
readsPrec1 :: forall a. Read a => Int -> ReadS (Last a)
readsPrec1 = Int -> ReadS (Last a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Last a]
readList1 = ReadS [Last a]
forall a. Read a => ReadS [a]
readList
#if MIN_VERSION_base(4,4,0)
instance Read1 Complex where
readsPrec1 :: forall a. Read a => Int -> ReadS (Complex a)
readsPrec1 = Int -> ReadS (Complex a)
forall a. Read a => Int -> ReadS a
readsPrec
readList1 :: forall a. Read a => ReadS [Complex a]
readList1 = ReadS [Complex a]
forall a. Read a => ReadS [a]
readList
#endif
instance Read a => Read1 ((,) a) where readsPrec1 :: forall a. Read a => Int -> ReadS (a, a)
readsPrec1 = Int -> ReadS (a, a)
forall a. Read a => Int -> ReadS a
readsPrec; readList1 :: forall a. Read a => ReadS [(a, a)]
readList1 = ReadS [(a, a)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b) => Read1 ((,,) a b) where readsPrec1 :: forall a. Read a => Int -> ReadS (a, b, a)
readsPrec1 = Int -> ReadS (a, b, a)
forall a. Read a => Int -> ReadS a
readsPrec; readList1 :: forall a. Read a => ReadS [(a, b, a)]
readList1 = ReadS [(a, b, a)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c) => Read1 ((,,,) a b c) where readsPrec1 :: forall a. Read a => Int -> ReadS (a, b, c, a)
readsPrec1 = Int -> ReadS (a, b, c, a)
forall a. Read a => Int -> ReadS a
readsPrec; readList1 :: forall a. Read a => ReadS [(a, b, c, a)]
readList1 = ReadS [(a, b, c, a)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d) => Read1 ((,,,,) a b c d) where readsPrec1 :: forall a. Read a => Int -> ReadS (a, b, c, d, a)
readsPrec1 = Int -> ReadS (a, b, c, d, a)
forall a. Read a => Int -> ReadS a
readsPrec; readList1 :: forall a. Read a => ReadS [(a, b, c, d, a)]
readList1 = ReadS [(a, b, c, d, a)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d, Read e) => Read1 ((,,,,,) a b c d e) where readsPrec1 :: forall a. Read a => Int -> ReadS (a, b, c, d, e, a)
readsPrec1 = Int -> ReadS (a, b, c, d, e, a)
forall a. Read a => Int -> ReadS a
readsPrec; readList1 :: forall a. Read a => ReadS [(a, b, c, d, e, a)]
readList1 = ReadS [(a, b, c, d, e, a)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d, Read e, Read f) => Read1 ((,,,,,,) a b c d e f) where readsPrec1 :: forall a. Read a => Int -> ReadS (a, b, c, d, e, f, a)
readsPrec1 = Int -> ReadS (a, b, c, d, e, f, a)
forall a. Read a => Int -> ReadS a
readsPrec; readList1 :: forall a. Read a => ReadS [(a, b, c, d, e, f, a)]
readList1 = ReadS [(a, b, c, d, e, f, a)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g) => Read1 ((,,,,,,,) a b c d e f g) where readsPrec1 :: forall a. Read a => Int -> ReadS (a, b, c, d, e, f, g, a)
readsPrec1 = Int -> ReadS (a, b, c, d, e, f, g, a)
forall a. Read a => Int -> ReadS a
readsPrec; readList1 :: forall a. Read a => ReadS [(a, b, c, d, e, f, g, a)]
readList1 = ReadS [(a, b, c, d, e, f, g, a)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) => Read1 ((,,,,,,,,) a b c d e f g h) where readsPrec1 :: forall a. Read a => Int -> ReadS (a, b, c, d, e, f, g, h, a)
readsPrec1 = Int -> ReadS (a, b, c, d, e, f, g, h, a)
forall a. Read a => Int -> ReadS a
readsPrec; readList1 :: forall a. Read a => ReadS [(a, b, c, d, e, f, g, h, a)]
readList1 = ReadS [(a, b, c, d, e, f, g, h, a)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i) => Read1 ((,,,,,,,,,) a b c d e f g h i) where readsPrec1 :: forall a. Read a => Int -> ReadS (a, b, c, d, e, f, g, h, i, a)
readsPrec1 = Int -> ReadS (a, b, c, d, e, f, g, h, i, a)
forall a. Read a => Int -> ReadS a
readsPrec; readList1 :: forall a. Read a => ReadS [(a, b, c, d, e, f, g, h, i, a)]
readList1 = ReadS [(a, b, c, d, e, f, g, h, i, a)]
forall a. Read a => ReadS [a]
readList
class Read2 f where
readsPrec2 :: (Read a, Read b) => Int -> ReadS (f a b)
#ifdef DEFAULT_SIGNATURES
default readsPrec2 :: Read (f a b) => Int -> ReadS (f a b)
readsPrec2 = Int -> ReadS (f a b)
forall a. Read a => Int -> ReadS a
readsPrec
#endif
readList2 :: (Read a, Read b) => ReadS [f a b]
readList2 = ReadPrec [f a b] -> Int -> ReadS [f a b]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S (ReadPrec (f a b) -> ReadPrec [f a b]
forall a. ReadPrec a -> ReadPrec [a]
list ReadPrec (f a b)
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadPrec (f a b)
readPrec2) Int
0
#ifdef __GLASGOW_HASKELL__
readPrec2 :: (Read2 f, Read a, Read b) => ReadPrec (f a b)
readPrec2 :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadPrec (f a b)
readPrec2 = (Int -> ReadS (f a b)) -> ReadPrec (f a b)
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec Int -> ReadS (f a b)
forall a b. (Read a, Read b) => Int -> ReadS (f a b)
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
Int -> ReadS (f a b)
readsPrec2
readListPrec2 :: (Read2 f, Read a, Read b) => ReadPrec [f a b]
readListPrec2 :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadPrec [f a b]
readListPrec2 = (Int -> ReadS [f a b]) -> ReadPrec [f a b]
forall a. (Int -> ReadS a) -> ReadPrec a
readS_to_Prec (\Int
_ -> ReadS [f a b]
forall a b. (Read a, Read b) => ReadS [f a b]
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadS [f a b]
readList2)
#endif
instance Read2 Either where
readsPrec2 :: forall a b. (Read a, Read b) => Int -> ReadS (Either a b)
readsPrec2 = Int -> ReadS (Either a b)
forall a. Read a => Int -> ReadS a
readsPrec
readList2 :: forall a b. (Read a, Read b) => ReadS [Either a b]
readList2 = ReadS [Either a b]
forall a. Read a => ReadS [a]
readList
#if MIN_VERSION_base(4,8,0)
instance Read2 Const where
readsPrec2 :: forall a b. (Read a, Read b) => Int -> ReadS (Const a b)
readsPrec2 = Int -> ReadS (Const a b)
forall a. Read a => Int -> ReadS a
readsPrec
readList2 :: forall a b. (Read a, Read b) => ReadS [Const a b]
readList2 = ReadS [Const a b]
forall a. Read a => ReadS [a]
readList
#else
instance Read2 Const where
readsPrec2 = readsPrec1
readList2 = readList1
#endif
instance Read2 (,) where readsPrec2 :: forall a b. (Read a, Read b) => Int -> ReadS (a, b)
readsPrec2 = Int -> ReadS (a, b)
forall a. Read a => Int -> ReadS a
readsPrec; readList2 :: forall a b. (Read a, Read b) => ReadS [(a, b)]
readList2 = ReadS [(a, b)]
forall a. Read a => ReadS [a]
readList
instance Read a => Read2 ((,,) a) where readsPrec2 :: forall a b. (Read a, Read b) => Int -> ReadS (a, a, b)
readsPrec2 = Int -> ReadS (a, a, b)
forall a. Read a => Int -> ReadS a
readsPrec; readList2 :: forall a b. (Read a, Read b) => ReadS [(a, a, b)]
readList2 = ReadS [(a, a, b)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b) => Read2 ((,,,) a b) where readsPrec2 :: forall a b. (Read a, Read b) => Int -> ReadS (a, b, a, b)
readsPrec2 = Int -> ReadS (a, b, a, b)
forall a. Read a => Int -> ReadS a
readsPrec; readList2 :: forall a b. (Read a, Read b) => ReadS [(a, b, a, b)]
readList2 = ReadS [(a, b, a, b)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c) => Read2 ((,,,,) a b c) where readsPrec2 :: forall a b. (Read a, Read b) => Int -> ReadS (a, b, c, a, b)
readsPrec2 = Int -> ReadS (a, b, c, a, b)
forall a. Read a => Int -> ReadS a
readsPrec; readList2 :: forall a b. (Read a, Read b) => ReadS [(a, b, c, a, b)]
readList2 = ReadS [(a, b, c, a, b)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d) => Read2 ((,,,,,) a b c d) where readsPrec2 :: forall a b. (Read a, Read b) => Int -> ReadS (a, b, c, d, a, b)
readsPrec2 = Int -> ReadS (a, b, c, d, a, b)
forall a. Read a => Int -> ReadS a
readsPrec; readList2 :: forall a b. (Read a, Read b) => ReadS [(a, b, c, d, a, b)]
readList2 = ReadS [(a, b, c, d, a, b)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d, Read e) => Read2 ((,,,,,,) a b c d e) where readsPrec2 :: forall a b. (Read a, Read b) => Int -> ReadS (a, b, c, d, e, a, b)
readsPrec2 = Int -> ReadS (a, b, c, d, e, a, b)
forall a. Read a => Int -> ReadS a
readsPrec; readList2 :: forall a b. (Read a, Read b) => ReadS [(a, b, c, d, e, a, b)]
readList2 = ReadS [(a, b, c, d, e, a, b)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d, Read e, Read f) => Read2 ((,,,,,,,) a b c d e f) where readsPrec2 :: forall a b.
(Read a, Read b) =>
Int -> ReadS (a, b, c, d, e, f, a, b)
readsPrec2 = Int -> ReadS (a, b, c, d, e, f, a, b)
forall a. Read a => Int -> ReadS a
readsPrec; readList2 :: forall a b. (Read a, Read b) => ReadS [(a, b, c, d, e, f, a, b)]
readList2 = ReadS [(a, b, c, d, e, f, a, b)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g) => Read2 ((,,,,,,,,) a b c d e f g) where readsPrec2 :: forall a b.
(Read a, Read b) =>
Int -> ReadS (a, b, c, d, e, f, g, a, b)
readsPrec2 = Int -> ReadS (a, b, c, d, e, f, g, a, b)
forall a. Read a => Int -> ReadS a
readsPrec; readList2 :: forall a b. (Read a, Read b) => ReadS [(a, b, c, d, e, f, g, a, b)]
readList2 = ReadS [(a, b, c, d, e, f, g, a, b)]
forall a. Read a => ReadS [a]
readList
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) => Read2 ((,,,,,,,,,) a b c d e f g h) where readsPrec2 :: forall a b.
(Read a, Read b) =>
Int -> ReadS (a, b, c, d, e, f, g, h, a, b)
readsPrec2 = Int -> ReadS (a, b, c, d, e, f, g, h, a, b)
forall a. Read a => Int -> ReadS a
readsPrec; readList2 :: forall a b.
(Read a, Read b) =>
ReadS [(a, b, c, d, e, f, g, h, a, b)]
readList2 = ReadS [(a, b, c, d, e, f, g, h, a, b)]
forall a. Read a => ReadS [a]
readList
read2 :: (Read2 f, Read a, Read b) => String -> f a b
read2 :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
String -> f a b
read2 String
s = (String -> f a b)
-> (f a b -> f a b) -> Either String (f a b) -> f a b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> f a b
forall a. HasCallStack => String -> a
error f a b -> f a b
forall a. a -> a
id (String -> Either String (f a b)
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
String -> Either String (f a b)
readEither2 String
s)
reads2 :: (Read2 f, Read a, Read b) => ReadS (f a b)
reads2 :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadS (f a b)
reads2 = Int -> ReadS (f a b)
forall a b. (Read a, Read b) => Int -> ReadS (f a b)
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
Int -> ReadS (f a b)
readsPrec2 Int
minPrec
readEither2 :: (Read2 f, Read a, Read b) => String -> Either String (f a b)
readEither2 :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
String -> Either String (f a b)
readEither2 String
s =
case [ f a b
x | (f a b
x,String
"") <- ReadPrec (f a b) -> Int -> ReadS (f a b)
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec (f a b)
read' Int
minPrec String
s ] of
[f a b
x] -> f a b -> Either String (f a b)
forall a b. b -> Either a b
Right f a b
x
[] -> String -> Either String (f a b)
forall a b. a -> Either a b
Left String
"Prelude.read: no parse"
[f a b]
_ -> String -> Either String (f a b)
forall a b. a -> Either a b
Left String
"Prelude.read: ambiguous parse"
where
read' :: ReadPrec (f a b)
read' =
do f a b
x <- ReadPrec (f a b)
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadPrec (f a b)
readPrec2
ReadP () -> ReadPrec ()
forall a. ReadP a -> ReadPrec a
lift ReadP ()
P.skipSpaces
f a b -> ReadPrec (f a b)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return f a b
x
#ifdef __GLASGOW_HASKELL__
readList2Default :: (Read2 f, Read a, Read b) => ReadS [f a b]
readList2Default :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadS [f a b]
readList2Default = ReadPrec [f a b] -> Int -> ReadS [f a b]
forall a. ReadPrec a -> Int -> ReadS a
readPrec_to_S ReadPrec [f a b]
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadPrec [f a b]
readListPrec2 Int
0
readListPrec2Default :: (Read2 f, Read a, Read b) => ReadPrec [f a b]
readListPrec2Default :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadPrec [f a b]
readListPrec2Default = ReadPrec (f a b) -> ReadPrec [f a b]
forall a. ReadPrec a -> ReadPrec [a]
list ReadPrec (f a b)
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadPrec (f a b)
readPrec2
#endif
list :: ReadPrec a -> ReadPrec [a]
list :: forall a. ReadPrec a -> ReadPrec [a]
list ReadPrec a
readx =
ReadPrec [a] -> ReadPrec [a]
forall a. ReadPrec a -> ReadPrec a
parens
( do L.Punc String
"[" <- ReadPrec Lexeme
lexP
(Bool -> ReadPrec [a]
listRest Bool
False ReadPrec [a] -> ReadPrec [a] -> ReadPrec [a]
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec [a]
listNext)
)
where
listRest :: Bool -> ReadPrec [a]
listRest Bool
started =
do L.Punc String
c <- ReadPrec Lexeme
lexP
case String
c of
String
"]" -> [a] -> ReadPrec [a]
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return []
String
"," | Bool
started -> ReadPrec [a]
listNext
String
_ -> ReadPrec [a]
forall a. ReadPrec a
pfail
listNext :: ReadPrec [a]
listNext =
do a
x <- ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
reset ReadPrec a
readx
[a]
xs <- Bool -> ReadPrec [a]
listRest Bool
True
[a] -> ReadPrec [a]
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
newtype Lift1 f a = Lift1 { forall (f :: * -> *) a. Lift1 f a -> f a
lower1 :: f a }
deriving ((forall a b. (a -> b) -> Lift1 f a -> Lift1 f b)
-> (forall a b. a -> Lift1 f b -> Lift1 f a) -> Functor (Lift1 f)
forall a b. a -> Lift1 f b -> Lift1 f a
forall a b. (a -> b) -> Lift1 f a -> Lift1 f b
forall (f :: * -> *) a b. Functor f => a -> Lift1 f b -> Lift1 f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Lift1 f a -> Lift1 f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Lift1 f a -> Lift1 f b
fmap :: forall a b. (a -> b) -> Lift1 f a -> Lift1 f b
$c<$ :: forall (f :: * -> *) a b. Functor f => a -> Lift1 f b -> Lift1 f a
<$ :: forall a b. a -> Lift1 f b -> Lift1 f a
Functor, (forall m. Monoid m => Lift1 f m -> m)
-> (forall m a. Monoid m => (a -> m) -> Lift1 f a -> m)
-> (forall m a. Monoid m => (a -> m) -> Lift1 f a -> m)
-> (forall a b. (a -> b -> b) -> b -> Lift1 f a -> b)
-> (forall a b. (a -> b -> b) -> b -> Lift1 f a -> b)
-> (forall b a. (b -> a -> b) -> b -> Lift1 f a -> b)
-> (forall b a. (b -> a -> b) -> b -> Lift1 f a -> b)
-> (forall a. (a -> a -> a) -> Lift1 f a -> a)
-> (forall a. (a -> a -> a) -> Lift1 f a -> a)
-> (forall a. Lift1 f a -> [a])
-> (forall a. Lift1 f a -> Bool)
-> (forall a. Lift1 f a -> Int)
-> (forall a. Eq a => a -> Lift1 f a -> Bool)
-> (forall a. Ord a => Lift1 f a -> a)
-> (forall a. Ord a => Lift1 f a -> a)
-> (forall a. Num a => Lift1 f a -> a)
-> (forall a. Num a => Lift1 f a -> a)
-> Foldable (Lift1 f)
forall a. Eq a => a -> Lift1 f a -> Bool
forall a. Num a => Lift1 f a -> a
forall a. Ord a => Lift1 f a -> a
forall m. Monoid m => Lift1 f m -> m
forall a. Lift1 f a -> Bool
forall a. Lift1 f a -> Int
forall a. Lift1 f a -> [a]
forall a. (a -> a -> a) -> Lift1 f a -> a
forall m a. Monoid m => (a -> m) -> Lift1 f a -> m
forall b a. (b -> a -> b) -> b -> Lift1 f a -> b
forall a b. (a -> b -> b) -> b -> Lift1 f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> Lift1 f a -> Bool
forall (f :: * -> *) a. (Foldable f, Num a) => Lift1 f a -> a
forall (f :: * -> *) a. (Foldable f, Ord a) => Lift1 f a -> a
forall (f :: * -> *) m. (Foldable f, Monoid m) => Lift1 f m -> m
forall (f :: * -> *) a. Foldable f => Lift1 f a -> Bool
forall (f :: * -> *) a. Foldable f => Lift1 f a -> Int
forall (f :: * -> *) a. Foldable f => Lift1 f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> Lift1 f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> Lift1 f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> Lift1 f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> Lift1 f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall (f :: * -> *) m. (Foldable f, Monoid m) => Lift1 f m -> m
fold :: forall m. Monoid m => Lift1 f m -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> Lift1 f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Lift1 f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> Lift1 f a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Lift1 f a -> m
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> Lift1 f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Lift1 f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> Lift1 f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Lift1 f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> Lift1 f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Lift1 f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> Lift1 f a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Lift1 f a -> b
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> Lift1 f a -> a
foldr1 :: forall a. (a -> a -> a) -> Lift1 f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> Lift1 f a -> a
foldl1 :: forall a. (a -> a -> a) -> Lift1 f a -> a
$ctoList :: forall (f :: * -> *) a. Foldable f => Lift1 f a -> [a]
toList :: forall a. Lift1 f a -> [a]
$cnull :: forall (f :: * -> *) a. Foldable f => Lift1 f a -> Bool
null :: forall a. Lift1 f a -> Bool
$clength :: forall (f :: * -> *) a. Foldable f => Lift1 f a -> Int
length :: forall a. Lift1 f a -> Int
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> Lift1 f a -> Bool
elem :: forall a. Eq a => a -> Lift1 f a -> Bool
$cmaximum :: forall (f :: * -> *) a. (Foldable f, Ord a) => Lift1 f a -> a
maximum :: forall a. Ord a => Lift1 f a -> a
$cminimum :: forall (f :: * -> *) a. (Foldable f, Ord a) => Lift1 f a -> a
minimum :: forall a. Ord a => Lift1 f a -> a
$csum :: forall (f :: * -> *) a. (Foldable f, Num a) => Lift1 f a -> a
sum :: forall a. Num a => Lift1 f a -> a
$cproduct :: forall (f :: * -> *) a. (Foldable f, Num a) => Lift1 f a -> a
product :: forall a. Num a => Lift1 f a -> a
Foldable, Functor (Lift1 f)
Foldable (Lift1 f)
Functor (Lift1 f)
-> Foldable (Lift1 f)
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Lift1 f a -> f (Lift1 f b))
-> (forall (f :: * -> *) a.
Applicative f =>
Lift1 f (f a) -> f (Lift1 f a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Lift1 f a -> m (Lift1 f b))
-> (forall (m :: * -> *) a.
Monad m =>
Lift1 f (m a) -> m (Lift1 f a))
-> Traversable (Lift1 f)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall {f :: * -> *}. Traversable f => Functor (Lift1 f)
forall {f :: * -> *}. Traversable f => Foldable (Lift1 f)
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
Lift1 f (m a) -> m (Lift1 f a)
forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
Lift1 f (f a) -> f (Lift1 f a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> Lift1 f a -> m (Lift1 f b)
forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> Lift1 f a -> f (Lift1 f b)
forall (m :: * -> *) a. Monad m => Lift1 f (m a) -> m (Lift1 f a)
forall (f :: * -> *) a.
Applicative f =>
Lift1 f (f a) -> f (Lift1 f a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Lift1 f a -> m (Lift1 f b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Lift1 f a -> f (Lift1 f b)
$ctraverse :: forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> Lift1 f a -> f (Lift1 f b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Lift1 f a -> f (Lift1 f b)
$csequenceA :: forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
Lift1 f (f a) -> f (Lift1 f a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Lift1 f (f a) -> f (Lift1 f a)
$cmapM :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> Lift1 f a -> m (Lift1 f b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Lift1 f a -> m (Lift1 f b)
$csequence :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
Lift1 f (m a) -> m (Lift1 f a)
sequence :: forall (m :: * -> *) a. Monad m => Lift1 f (m a) -> m (Lift1 f a)
Traversable, (forall a. Eq a => Lift1 f a -> Lift1 f a -> Bool) -> Eq1 (Lift1 f)
forall a. Eq a => Lift1 f a -> Lift1 f a -> Bool
forall (f :: * -> *) a.
(Eq1 f, Eq a) =>
Lift1 f a -> Lift1 f a -> Bool
forall (f :: * -> *).
(forall a. Eq a => f a -> f a -> Bool) -> Eq1 f
$c==# :: forall (f :: * -> *) a.
(Eq1 f, Eq a) =>
Lift1 f a -> Lift1 f a -> Bool
==# :: forall a. Eq a => Lift1 f a -> Lift1 f a -> Bool
Eq1, Eq1 (Lift1 f)
Eq1 (Lift1 f)
-> (forall a. Ord a => Lift1 f a -> Lift1 f a -> Ordering)
-> Ord1 (Lift1 f)
forall a. Ord a => Lift1 f a -> Lift1 f a -> Ordering
forall {f :: * -> *}. Ord1 f => Eq1 (Lift1 f)
forall (f :: * -> *) a.
(Ord1 f, Ord a) =>
Lift1 f a -> Lift1 f a -> Ordering
forall (f :: * -> *).
Eq1 f -> (forall a. Ord a => f a -> f a -> Ordering) -> Ord1 f
$ccompare1 :: forall (f :: * -> *) a.
(Ord1 f, Ord a) =>
Lift1 f a -> Lift1 f a -> Ordering
compare1 :: forall a. Ord a => Lift1 f a -> Lift1 f a -> Ordering
Ord1, (forall a. Show a => Int -> Lift1 f a -> ShowS)
-> (forall a. Show a => [Lift1 f a] -> ShowS) -> Show1 (Lift1 f)
forall a. Show a => Int -> Lift1 f a -> ShowS
forall a. Show a => [Lift1 f a] -> ShowS
forall (f :: * -> *) a.
(Show1 f, Show a) =>
Int -> Lift1 f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => [Lift1 f a] -> ShowS
forall (f :: * -> *).
(forall a. Show a => Int -> f a -> ShowS)
-> (forall a. Show a => [f a] -> ShowS) -> Show1 f
$cshowsPrec1 :: forall (f :: * -> *) a.
(Show1 f, Show a) =>
Int -> Lift1 f a -> ShowS
showsPrec1 :: forall a. Show a => Int -> Lift1 f a -> ShowS
$cshowList1 :: forall (f :: * -> *) a. (Show1 f, Show a) => [Lift1 f a] -> ShowS
showList1 :: forall a. Show a => [Lift1 f a] -> ShowS
Show1, (forall a. Read a => Int -> ReadS (Lift1 f a))
-> (forall a. Read a => ReadS [Lift1 f a]) -> Read1 (Lift1 f)
forall a. Read a => Int -> ReadS (Lift1 f a)
forall a. Read a => ReadS [Lift1 f a]
forall (f :: * -> *) a.
(Read1 f, Read a) =>
Int -> ReadS (Lift1 f a)
forall (f :: * -> *) a. (Read1 f, Read a) => ReadS [Lift1 f a]
forall (f :: * -> *).
(forall a. Read a => Int -> ReadS (f a))
-> (forall a. Read a => ReadS [f a]) -> Read1 f
$creadsPrec1 :: forall (f :: * -> *) a.
(Read1 f, Read a) =>
Int -> ReadS (Lift1 f a)
readsPrec1 :: forall a. Read a => Int -> ReadS (Lift1 f a)
$creadList1 :: forall (f :: * -> *) a. (Read1 f, Read a) => ReadS [Lift1 f a]
readList1 :: forall a. Read a => ReadS [Lift1 f a]
Read1)
instance (Eq1 f, Eq a) => Eq (Lift1 f a) where == :: Lift1 f a -> Lift1 f a -> Bool
(==) = Lift1 f a -> Lift1 f a -> Bool
forall a. Eq a => Lift1 f a -> Lift1 f a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
(==#)
instance (Ord1 f, Ord a) => Ord (Lift1 f a) where compare :: Lift1 f a -> Lift1 f a -> Ordering
compare = Lift1 f a -> Lift1 f a -> Ordering
forall a. Ord a => Lift1 f a -> Lift1 f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
instance (Show1 f, Show a) => Show (Lift1 f a) where showsPrec :: Int -> Lift1 f a -> ShowS
showsPrec = Int -> Lift1 f a -> ShowS
forall a. Show a => Int -> Lift1 f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1
instance (Read1 f, Read a) => Read (Lift1 f a) where readsPrec :: Int -> ReadS (Lift1 f a)
readsPrec = Int -> ReadS (Lift1 f a)
forall a. Read a => Int -> ReadS (Lift1 f a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1
newtype Lift2 f a b = Lift2 { forall (f :: * -> * -> *) a b. Lift2 f a b -> f a b
lower2 :: f a b }
deriving ((forall a b. (a -> b) -> Lift2 f a a -> Lift2 f a b)
-> (forall a b. a -> Lift2 f a b -> Lift2 f a a)
-> Functor (Lift2 f a)
forall a b. a -> Lift2 f a b -> Lift2 f a a
forall a b. (a -> b) -> Lift2 f a a -> Lift2 f a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (f :: * -> * -> *) a a b.
Functor (f a) =>
a -> Lift2 f a b -> Lift2 f a a
forall (f :: * -> * -> *) a a b.
Functor (f a) =>
(a -> b) -> Lift2 f a a -> Lift2 f a b
$cfmap :: forall (f :: * -> * -> *) a a b.
Functor (f a) =>
(a -> b) -> Lift2 f a a -> Lift2 f a b
fmap :: forall a b. (a -> b) -> Lift2 f a a -> Lift2 f a b
$c<$ :: forall (f :: * -> * -> *) a a b.
Functor (f a) =>
a -> Lift2 f a b -> Lift2 f a a
<$ :: forall a b. a -> Lift2 f a b -> Lift2 f a a
Functor, (forall m. Monoid m => Lift2 f a m -> m)
-> (forall m a. Monoid m => (a -> m) -> Lift2 f a a -> m)
-> (forall m a. Monoid m => (a -> m) -> Lift2 f a a -> m)
-> (forall a b. (a -> b -> b) -> b -> Lift2 f a a -> b)
-> (forall a b. (a -> b -> b) -> b -> Lift2 f a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Lift2 f a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Lift2 f a a -> b)
-> (forall a. (a -> a -> a) -> Lift2 f a a -> a)
-> (forall a. (a -> a -> a) -> Lift2 f a a -> a)
-> (forall a. Lift2 f a a -> [a])
-> (forall a. Lift2 f a a -> Bool)
-> (forall a. Lift2 f a a -> Int)
-> (forall a. Eq a => a -> Lift2 f a a -> Bool)
-> (forall a. Ord a => Lift2 f a a -> a)
-> (forall a. Ord a => Lift2 f a a -> a)
-> (forall a. Num a => Lift2 f a a -> a)
-> (forall a. Num a => Lift2 f a a -> a)
-> Foldable (Lift2 f a)
forall a. Eq a => a -> Lift2 f a a -> Bool
forall a. Num a => Lift2 f a a -> a
forall a. Ord a => Lift2 f a a -> a
forall m. Monoid m => Lift2 f a m -> m
forall a. Lift2 f a a -> Bool
forall a. Lift2 f a a -> Int
forall a. Lift2 f a a -> [a]
forall a. (a -> a -> a) -> Lift2 f a a -> a
forall m a. Monoid m => (a -> m) -> Lift2 f a a -> m
forall b a. (b -> a -> b) -> b -> Lift2 f a a -> b
forall a b. (a -> b -> b) -> b -> Lift2 f a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
forall (f :: * -> * -> *) a a.
(Foldable (f a), Eq a) =>
a -> Lift2 f a a -> Bool
forall (f :: * -> * -> *) a a.
(Foldable (f a), Num a) =>
Lift2 f a a -> a
forall (f :: * -> * -> *) a a.
(Foldable (f a), Ord a) =>
Lift2 f a a -> a
forall (f :: * -> * -> *) a m.
(Foldable (f a), Monoid m) =>
Lift2 f a m -> m
forall (f :: * -> * -> *) a a.
Foldable (f a) =>
Lift2 f a a -> Bool
forall (f :: * -> * -> *) a a. Foldable (f a) => Lift2 f a a -> Int
forall (f :: * -> * -> *) a a. Foldable (f a) => Lift2 f a a -> [a]
forall (f :: * -> * -> *) a a.
Foldable (f a) =>
(a -> a -> a) -> Lift2 f a a -> a
forall (f :: * -> * -> *) a m a.
(Foldable (f a), Monoid m) =>
(a -> m) -> Lift2 f a a -> m
forall (f :: * -> * -> *) a b a.
Foldable (f a) =>
(b -> a -> b) -> b -> Lift2 f a a -> b
forall (f :: * -> * -> *) a a b.
Foldable (f a) =>
(a -> b -> b) -> b -> Lift2 f a a -> b
$cfold :: forall (f :: * -> * -> *) a m.
(Foldable (f a), Monoid m) =>
Lift2 f a m -> m
fold :: forall m. Monoid m => Lift2 f a m -> m
$cfoldMap :: forall (f :: * -> * -> *) a m a.
(Foldable (f a), Monoid m) =>
(a -> m) -> Lift2 f a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Lift2 f a a -> m
$cfoldMap' :: forall (f :: * -> * -> *) a m a.
(Foldable (f a), Monoid m) =>
(a -> m) -> Lift2 f a a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Lift2 f a a -> m
$cfoldr :: forall (f :: * -> * -> *) a a b.
Foldable (f a) =>
(a -> b -> b) -> b -> Lift2 f a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Lift2 f a a -> b
$cfoldr' :: forall (f :: * -> * -> *) a a b.
Foldable (f a) =>
(a -> b -> b) -> b -> Lift2 f a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Lift2 f a a -> b
$cfoldl :: forall (f :: * -> * -> *) a b a.
Foldable (f a) =>
(b -> a -> b) -> b -> Lift2 f a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Lift2 f a a -> b
$cfoldl' :: forall (f :: * -> * -> *) a b a.
Foldable (f a) =>
(b -> a -> b) -> b -> Lift2 f a a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Lift2 f a a -> b
$cfoldr1 :: forall (f :: * -> * -> *) a a.
Foldable (f a) =>
(a -> a -> a) -> Lift2 f a a -> a
foldr1 :: forall a. (a -> a -> a) -> Lift2 f a a -> a
$cfoldl1 :: forall (f :: * -> * -> *) a a.
Foldable (f a) =>
(a -> a -> a) -> Lift2 f a a -> a
foldl1 :: forall a. (a -> a -> a) -> Lift2 f a a -> a
$ctoList :: forall (f :: * -> * -> *) a a. Foldable (f a) => Lift2 f a a -> [a]
toList :: forall a. Lift2 f a a -> [a]
$cnull :: forall (f :: * -> * -> *) a a.
Foldable (f a) =>
Lift2 f a a -> Bool
null :: forall a. Lift2 f a a -> Bool
$clength :: forall (f :: * -> * -> *) a a. Foldable (f a) => Lift2 f a a -> Int
length :: forall a. Lift2 f a a -> Int
$celem :: forall (f :: * -> * -> *) a a.
(Foldable (f a), Eq a) =>
a -> Lift2 f a a -> Bool
elem :: forall a. Eq a => a -> Lift2 f a a -> Bool
$cmaximum :: forall (f :: * -> * -> *) a a.
(Foldable (f a), Ord a) =>
Lift2 f a a -> a
maximum :: forall a. Ord a => Lift2 f a a -> a
$cminimum :: forall (f :: * -> * -> *) a a.
(Foldable (f a), Ord a) =>
Lift2 f a a -> a
minimum :: forall a. Ord a => Lift2 f a a -> a
$csum :: forall (f :: * -> * -> *) a a.
(Foldable (f a), Num a) =>
Lift2 f a a -> a
sum :: forall a. Num a => Lift2 f a a -> a
$cproduct :: forall (f :: * -> * -> *) a a.
(Foldable (f a), Num a) =>
Lift2 f a a -> a
product :: forall a. Num a => Lift2 f a a -> a
Foldable, Functor (Lift2 f a)
Foldable (Lift2 f a)
Functor (Lift2 f a)
-> Foldable (Lift2 f a)
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Lift2 f a a -> f (Lift2 f a b))
-> (forall (f :: * -> *) a.
Applicative f =>
Lift2 f a (f a) -> f (Lift2 f a a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Lift2 f a a -> m (Lift2 f a b))
-> (forall (m :: * -> *) a.
Monad m =>
Lift2 f a (m a) -> m (Lift2 f a a))
-> Traversable (Lift2 f a)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Lift2 f a (m a) -> m (Lift2 f a a)
forall (f :: * -> *) a.
Applicative f =>
Lift2 f a (f a) -> f (Lift2 f a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Lift2 f a a -> m (Lift2 f a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Lift2 f a a -> f (Lift2 f a b)
forall {f :: * -> * -> *} {a}.
Traversable (f a) =>
Functor (Lift2 f a)
forall {f :: * -> * -> *} {a}.
Traversable (f a) =>
Foldable (Lift2 f a)
forall (f :: * -> * -> *) a (m :: * -> *) a.
(Traversable (f a), Monad m) =>
Lift2 f a (m a) -> m (Lift2 f a a)
forall (f :: * -> * -> *) a (f :: * -> *) a.
(Traversable (f a), Applicative f) =>
Lift2 f a (f a) -> f (Lift2 f a a)
forall (f :: * -> * -> *) a (m :: * -> *) a b.
(Traversable (f a), Monad m) =>
(a -> m b) -> Lift2 f a a -> m (Lift2 f a b)
forall (f :: * -> * -> *) a (f :: * -> *) a b.
(Traversable (f a), Applicative f) =>
(a -> f b) -> Lift2 f a a -> f (Lift2 f a b)
$ctraverse :: forall (f :: * -> * -> *) a (f :: * -> *) a b.
(Traversable (f a), Applicative f) =>
(a -> f b) -> Lift2 f a a -> f (Lift2 f a b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Lift2 f a a -> f (Lift2 f a b)
$csequenceA :: forall (f :: * -> * -> *) a (f :: * -> *) a.
(Traversable (f a), Applicative f) =>
Lift2 f a (f a) -> f (Lift2 f a a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Lift2 f a (f a) -> f (Lift2 f a a)
$cmapM :: forall (f :: * -> * -> *) a (m :: * -> *) a b.
(Traversable (f a), Monad m) =>
(a -> m b) -> Lift2 f a a -> m (Lift2 f a b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Lift2 f a a -> m (Lift2 f a b)
$csequence :: forall (f :: * -> * -> *) a (m :: * -> *) a.
(Traversable (f a), Monad m) =>
Lift2 f a (m a) -> m (Lift2 f a a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Lift2 f a (m a) -> m (Lift2 f a a)
Traversable, (forall a b. (Eq a, Eq b) => Lift2 f a b -> Lift2 f a b -> Bool)
-> Eq2 (Lift2 f)
forall a b. (Eq a, Eq b) => Lift2 f a b -> Lift2 f a b -> Bool
forall (f :: * -> * -> *) a b.
(Eq2 f, Eq a, Eq b) =>
Lift2 f a b -> Lift2 f a b -> Bool
forall (f :: * -> * -> *).
(forall a b. (Eq a, Eq b) => f a b -> f a b -> Bool) -> Eq2 f
$c==## :: forall (f :: * -> * -> *) a b.
(Eq2 f, Eq a, Eq b) =>
Lift2 f a b -> Lift2 f a b -> Bool
==## :: forall a b. (Eq a, Eq b) => Lift2 f a b -> Lift2 f a b -> Bool
Eq2, Eq2 (Lift2 f)
Eq2 (Lift2 f)
-> (forall a b.
(Ord a, Ord b) =>
Lift2 f a b -> Lift2 f a b -> Ordering)
-> Ord2 (Lift2 f)
forall a b.
(Ord a, Ord b) =>
Lift2 f a b -> Lift2 f a b -> Ordering
forall {f :: * -> * -> *}. Ord2 f => Eq2 (Lift2 f)
forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
Lift2 f a b -> Lift2 f a b -> Ordering
forall (f :: * -> * -> *).
Eq2 f
-> (forall a b. (Ord a, Ord b) => f a b -> f a b -> Ordering)
-> Ord2 f
$ccompare2 :: forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
Lift2 f a b -> Lift2 f a b -> Ordering
compare2 :: forall a b.
(Ord a, Ord b) =>
Lift2 f a b -> Lift2 f a b -> Ordering
Ord2, (forall a b. (Show a, Show b) => Int -> Lift2 f a b -> ShowS)
-> (forall a b. (Show a, Show b) => [Lift2 f a b] -> ShowS)
-> Show2 (Lift2 f)
forall a b. (Show a, Show b) => Int -> Lift2 f a b -> ShowS
forall a b. (Show a, Show b) => [Lift2 f a b] -> ShowS
forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> Lift2 f a b -> ShowS
forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
[Lift2 f a b] -> ShowS
forall (f :: * -> * -> *).
(forall a b. (Show a, Show b) => Int -> f a b -> ShowS)
-> (forall a b. (Show a, Show b) => [f a b] -> ShowS) -> Show2 f
$cshowsPrec2 :: forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> Lift2 f a b -> ShowS
showsPrec2 :: forall a b. (Show a, Show b) => Int -> Lift2 f a b -> ShowS
$cshowList2 :: forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
[Lift2 f a b] -> ShowS
showList2 :: forall a b. (Show a, Show b) => [Lift2 f a b] -> ShowS
Show2, (forall a b. (Read a, Read b) => Int -> ReadS (Lift2 f a b))
-> (forall a b. (Read a, Read b) => ReadS [Lift2 f a b])
-> Read2 (Lift2 f)
forall a b. (Read a, Read b) => Int -> ReadS (Lift2 f a b)
forall a b. (Read a, Read b) => ReadS [Lift2 f a b]
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
Int -> ReadS (Lift2 f a b)
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadS [Lift2 f a b]
forall (f :: * -> * -> *).
(forall a b. (Read a, Read b) => Int -> ReadS (f a b))
-> (forall a b. (Read a, Read b) => ReadS [f a b]) -> Read2 f
$creadsPrec2 :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
Int -> ReadS (Lift2 f a b)
readsPrec2 :: forall a b. (Read a, Read b) => Int -> ReadS (Lift2 f a b)
$creadList2 :: forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
ReadS [Lift2 f a b]
readList2 :: forall a b. (Read a, Read b) => ReadS [Lift2 f a b]
Read2)
instance (Eq2 f, Eq a) => Eq1 (Lift2 f a) where ==# :: forall a. Eq a => Lift2 f a a -> Lift2 f a a -> Bool
(==#) = Lift2 f a a -> Lift2 f a a -> Bool
forall a b. (Eq a, Eq b) => Lift2 f a b -> Lift2 f a b -> Bool
forall (f :: * -> * -> *) a b.
(Eq2 f, Eq a, Eq b) =>
f a b -> f a b -> Bool
(==##)
instance (Ord2 f, Ord a) => Ord1 (Lift2 f a) where compare1 :: forall a. Ord a => Lift2 f a a -> Lift2 f a a -> Ordering
compare1 = Lift2 f a a -> Lift2 f a a -> Ordering
forall a b.
(Ord a, Ord b) =>
Lift2 f a b -> Lift2 f a b -> Ordering
forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Ordering
compare2
instance (Show2 f, Show a) => Show1 (Lift2 f a) where showsPrec1 :: forall a. Show a => Int -> Lift2 f a a -> ShowS
showsPrec1 = Int -> Lift2 f a a -> ShowS
forall a b. (Show a, Show b) => Int -> Lift2 f a b -> ShowS
forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> f a b -> ShowS
showsPrec2
instance (Read2 f, Read a) => Read1 (Lift2 f a) where readsPrec1 :: forall a. Read a => Int -> ReadS (Lift2 f a a)
readsPrec1 = Int -> ReadS (Lift2 f a a)
forall a b. (Read a, Read b) => Int -> ReadS (Lift2 f a b)
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
Int -> ReadS (f a b)
readsPrec2
instance (Eq2 f, Eq a, Eq b) => Eq (Lift2 f a b) where == :: Lift2 f a b -> Lift2 f a b -> Bool
(==) = Lift2 f a b -> Lift2 f a b -> Bool
forall a b. (Eq a, Eq b) => Lift2 f a b -> Lift2 f a b -> Bool
forall (f :: * -> * -> *) a b.
(Eq2 f, Eq a, Eq b) =>
f a b -> f a b -> Bool
(==##)
instance (Ord2 f, Ord a, Ord b) => Ord (Lift2 f a b) where compare :: Lift2 f a b -> Lift2 f a b -> Ordering
compare = Lift2 f a b -> Lift2 f a b -> Ordering
forall a b.
(Ord a, Ord b) =>
Lift2 f a b -> Lift2 f a b -> Ordering
forall (f :: * -> * -> *) a b.
(Ord2 f, Ord a, Ord b) =>
f a b -> f a b -> Ordering
compare2
instance (Show2 f, Show a, Show b) => Show (Lift2 f a b) where showsPrec :: Int -> Lift2 f a b -> ShowS
showsPrec = Int -> Lift2 f a b -> ShowS
forall a b. (Show a, Show b) => Int -> Lift2 f a b -> ShowS
forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> f a b -> ShowS
showsPrec2
instance (Read2 f, Read a, Read b) => Read (Lift2 f a b) where readsPrec :: Int -> ReadS (Lift2 f a b)
readsPrec = Int -> ReadS (Lift2 f a b)
forall a b. (Read a, Read b) => Int -> ReadS (Lift2 f a b)
forall (f :: * -> * -> *) a b.
(Read2 f, Read a, Read b) =>
Int -> ReadS (f a b)
readsPrec2