{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

-- | Generic deriving for 'Enum'.

module Generic.Data.Internal.Enum where

import GHC.Generics

-- | Generic 'toEnum' generated with the 'StandardEnum' option.
--
-- @
-- instance 'Enum' MyType where
--   'toEnum' = 'gtoEnum'
--   'fromEnum' = 'gfromEnum'
--   'enumFrom' = 'genumFrom'
--   'enumFromThen' = 'genumFromThen'
--   'enumFromTo' = 'genumFromTo'
--   'enumFromThenTo' = 'genumFromThenTo'
-- @
gtoEnum :: forall a. (Generic a, GEnum StandardEnum (Rep a)) => Int -> a
gtoEnum :: Int -> a
gtoEnum = String -> Int -> a
forall opts a.
(Generic a, GEnum opts (Rep a)) =>
String -> Int -> a
gtoEnum' @StandardEnum "gtoEnum"

-- | Generic 'fromEnum' generated with the 'StandardEnum' option.
--
-- See also 'gtoEnum'.
gfromEnum :: (Generic a, GEnum StandardEnum (Rep a)) => a -> Int
gfromEnum :: a -> Int
gfromEnum = forall a. (Generic a, GEnum StandardEnum (Rep a)) => a -> Int
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum' @StandardEnum

-- | Generic 'enumFrom' generated with the 'StandardEnum' option.
--
-- See also 'gtoEnum'.
genumFrom :: (Generic a, GEnum StandardEnum (Rep a)) => a -> [a]
genumFrom :: a -> [a]
genumFrom = forall a. (Generic a, GEnum StandardEnum (Rep a)) => a -> [a]
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> [a]
genumFrom' @StandardEnum

-- | Generic 'enumFromThen' generated with the 'StandardEnum' option.
--
-- See also 'gtoEnum'.
genumFromThen :: (Generic a, GEnum StandardEnum (Rep a)) => a -> a -> [a]
genumFromThen :: a -> a -> [a]
genumFromThen = forall a. (Generic a, GEnum StandardEnum (Rep a)) => a -> a -> [a]
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> a -> [a]
genumFromThen' @StandardEnum

-- | Generic 'enumFromTo' generated with the 'StandardEnum' option.
--
-- See also 'gtoEnum'.
genumFromTo :: (Generic a, GEnum StandardEnum (Rep a)) => a -> a -> [a]
genumFromTo :: a -> a -> [a]
genumFromTo = forall a. (Generic a, GEnum StandardEnum (Rep a)) => a -> a -> [a]
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> a -> [a]
genumFromTo' @StandardEnum

-- | Generic 'enumFromThenTo' generated with the 'StandardEnum' option.
--
-- See also 'gtoEnum'.
genumFromThenTo :: (Generic a, GEnum StandardEnum (Rep a)) => a -> a -> a -> [a]
genumFromThenTo :: a -> a -> a -> [a]
genumFromThenTo = forall a.
(Generic a, GEnum StandardEnum (Rep a)) =>
a -> a -> a -> [a]
forall opts a.
(Generic a, GEnum opts (Rep a)) =>
a -> a -> a -> [a]
genumFromThenTo' @StandardEnum


-- | Generic 'toEnum' generated with the 'FiniteEnum' option.
--
-- @
-- instance 'Enum' MyType where
--   'toEnum' = 'gtoFiniteEnum'
--   'fromEnum' = 'gfromFiniteEnum'
--   'enumFrom' = 'gfiniteEnumFrom'
--   'enumFromThen' = 'gfiniteEnumFromThen'
--   'enumFromTo' = 'gfiniteEnumFromTo'
--   'enumFromThenTo' = 'gfiniteEnumFromThenTo'
-- @
gtoFiniteEnum :: forall a. (Generic a, GEnum FiniteEnum (Rep a)) => Int -> a
gtoFiniteEnum :: Int -> a
gtoFiniteEnum = String -> Int -> a
forall opts a.
(Generic a, GEnum opts (Rep a)) =>
String -> Int -> a
gtoEnum' @FiniteEnum "gtoFiniteEnum"

-- | Generic 'fromEnum' generated with the 'FiniteEnum' option.
--
-- See also 'gtoFiniteEnum'.
gfromFiniteEnum :: (Generic a, GEnum FiniteEnum (Rep a)) => a -> Int
gfromFiniteEnum :: a -> Int
gfromFiniteEnum = forall a. (Generic a, GEnum FiniteEnum (Rep a)) => a -> Int
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum' @FiniteEnum

-- | Generic 'enumFrom' generated with the 'FiniteEnum' option.
--
-- See also 'gtoFiniteEnum'.
gfiniteEnumFrom :: (Generic a, GEnum FiniteEnum (Rep a)) => a -> [a]
gfiniteEnumFrom :: a -> [a]
gfiniteEnumFrom = forall a. (Generic a, GEnum FiniteEnum (Rep a)) => a -> [a]
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> [a]
genumFrom' @FiniteEnum

-- | Generic 'enumFromThen' generated with the 'FiniteEnum' option.
--
-- See also 'gtoFiniteEnum'.
gfiniteEnumFromThen :: (Generic a, GEnum FiniteEnum (Rep a)) => a -> a -> [a]
gfiniteEnumFromThen :: a -> a -> [a]
gfiniteEnumFromThen = forall a. (Generic a, GEnum FiniteEnum (Rep a)) => a -> a -> [a]
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> a -> [a]
genumFromThen' @FiniteEnum

-- | Generic 'enumFromTo' generated with the 'FiniteEnum' option.
--
-- See also 'gtoFiniteEnum'.
gfiniteEnumFromTo :: (Generic a, GEnum FiniteEnum (Rep a)) => a -> a -> [a]
gfiniteEnumFromTo :: a -> a -> [a]
gfiniteEnumFromTo = forall a. (Generic a, GEnum FiniteEnum (Rep a)) => a -> a -> [a]
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> a -> [a]
genumFromTo' @FiniteEnum

-- | Generic 'enumFromThenTo' generated with the 'FiniteEnum' option.
--
-- See also 'gtoFiniteEnum'.
gfiniteEnumFromThenTo :: (Generic a, GEnum FiniteEnum (Rep a)) => a -> a -> a -> [a]
gfiniteEnumFromThenTo :: a -> a -> a -> [a]
gfiniteEnumFromThenTo = forall a.
(Generic a, GEnum FiniteEnum (Rep a)) =>
a -> a -> a -> [a]
forall opts a.
(Generic a, GEnum opts (Rep a)) =>
a -> a -> a -> [a]
genumFromThenTo' @FiniteEnum

-- | Unsafe generic 'toEnum'. Does not check whether the argument is within
-- valid bounds. Use 'gtoEnum' or 'gtoFiniteEnum' instead.
gtoEnumRaw' :: forall opts a. (Generic a, GEnum opts (Rep a)) => Int -> a
gtoEnumRaw' :: Int -> a
gtoEnumRaw' = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> (Int -> Rep a Any) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall opts (f :: * -> *) p. GEnum opts f => Int -> f p
forall (f :: * -> *) p. GEnum opts f => Int -> f p
gToEnum @opts

-- | Generic 'toEnum'. Use 'gfromEnum' or 'gfromFiniteEnum' instead.
gtoEnum' :: forall opts a. (Generic a, GEnum opts (Rep a)) => String -> Int -> a
gtoEnum' :: String -> Int -> a
gtoEnum' name :: String
name n :: Int
n
  | 0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
card = Int -> a
forall opts a. (Generic a, GEnum opts (Rep a)) => Int -> a
gtoEnumRaw' @opts Int
n
  | Bool
otherwise = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
      String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": out of bounds, index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", cardinality " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
card
  where
    card :: Int
card = GEnum opts (Rep a) => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @opts @(Rep a)

-- | Generic 'fromEnum'. Use 'gfromEnum' or 'gfromFiniteEnum' instead.
gfromEnum' :: forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum' :: a -> Int
gfromEnum' = forall opts (f :: * -> *) p. GEnum opts f => f p -> Int
forall (f :: * -> *) p. GEnum opts f => f p -> Int
gFromEnum @opts (Rep a Any -> Int) -> (a -> Rep a Any) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

-- | > genumMin == gfromEnum gminBound
genumMin :: Int
genumMin :: Int
genumMin = 0

-- | > genumMax == gfromEnum gmaxBound
genumMax :: forall opts a. (Generic a, GEnum opts (Rep a)) => Int
genumMax :: Int
genumMax = GEnum opts (Rep a) => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @opts @(Rep a) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1

-- | Generic 'enumFrom'. Use 'genumFrom' or 'gfiniteEnumFrom' instead.
genumFrom' :: forall opts a. (Generic a, GEnum opts (Rep a)) => a -> [a]
genumFrom' :: a -> [a]
genumFrom' x :: a
x = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
toE [ Int
i_x .. (Generic a, GEnum opts (Rep a)) => Int
forall opts a. (Generic a, GEnum opts (Rep a)) => Int
genumMax @opts @a ]
  where
    toE :: Int -> a
toE = forall a. (Generic a, GEnum opts (Rep a)) => Int -> a
forall opts a. (Generic a, GEnum opts (Rep a)) => Int -> a
gtoEnumRaw' @opts
    i_x :: Int
i_x = a -> Int
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum'  @opts a
x

-- | Generic 'enumFromThen'. Use 'genumFromThen' or 'gfiniteEnumFromThen' instead.
genumFromThen' :: forall opts a. (Generic a, GEnum opts (Rep a)) => a -> a -> [a]
genumFromThen' :: a -> a -> [a]
genumFromThen' x1 :: a
x1 x2 :: a
x2 = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
toE [ Int
i_x1, Int
i_x2 .. Int
bound ]
  where
    toE :: Int -> a
toE  = forall a. (Generic a, GEnum opts (Rep a)) => Int -> a
forall opts a. (Generic a, GEnum opts (Rep a)) => Int -> a
gtoEnumRaw' @opts
    i_x1 :: Int
i_x1 = a -> Int
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum'  @opts a
x1
    i_x2 :: Int
i_x2 = a -> Int
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum'  @opts a
x2
    bound :: Int
bound | Int
i_x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i_x2 = Int
genumMin
          | Bool
otherwise    = (Generic a, GEnum opts (Rep a)) => Int
forall opts a. (Generic a, GEnum opts (Rep a)) => Int
genumMax @opts @a

-- | Generic 'enumFromTo'. Use 'genumFromTo' or 'gfiniteEnumFromTo' instead.
genumFromTo' :: forall opts a. (Generic a, GEnum opts (Rep a)) => a -> a -> [a]
genumFromTo' :: a -> a -> [a]
genumFromTo' x :: a
x y :: a
y = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
toE [ Int
i_x .. Int
i_y ]
  where
    toE :: Int -> a
toE = forall a. (Generic a, GEnum opts (Rep a)) => Int -> a
forall opts a. (Generic a, GEnum opts (Rep a)) => Int -> a
gtoEnumRaw' @opts
    i_x :: Int
i_x = a -> Int
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum'  @opts a
x
    i_y :: Int
i_y = a -> Int
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum'  @opts a
y

-- | Generic 'enumFromThenTo'. Use 'genumFromThenTo' or 'gfiniteEnumFromThenTo' instead.
genumFromThenTo' :: forall opts a. (Generic a, GEnum opts (Rep a)) => a -> a -> a -> [a]
genumFromThenTo' :: a -> a -> a -> [a]
genumFromThenTo' x1 :: a
x1 x2 :: a
x2 y :: a
y = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
toE [ Int
i_x1, Int
i_x2 .. Int
i_y ]
  where
    toE :: Int -> a
toE  = forall a. (Generic a, GEnum opts (Rep a)) => Int -> a
forall opts a. (Generic a, GEnum opts (Rep a)) => Int -> a
gtoEnumRaw' @opts
    i_x1 :: Int
i_x1 = a -> Int
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum'  @opts a
x1
    i_x2 :: Int
i_x2 = a -> Int
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum'  @opts a
x2
    i_y :: Int
i_y  = a -> Int
forall opts a. (Generic a, GEnum opts (Rep a)) => a -> Int
gfromEnum'  @opts a
y

-- | Generic 'minBound'.
--
-- @
-- instance 'Bounded' MyType where
--   'minBound' = 'gminBound'
--   'maxBound' = 'gmaxBound'
-- @
gminBound :: (Generic a, GBounded (Rep a)) => a
gminBound :: a
gminBound = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to Rep a Any
forall (f :: * -> *) p. GBounded f => f p
gMinBound

-- | Generic 'maxBound'.
--
-- See also 'gminBound'.
gmaxBound :: (Generic a, GBounded (Rep a)) => a
gmaxBound :: a
gmaxBound = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to Rep a Any
forall (f :: * -> *) p. GBounded f => f p
gMaxBound

-- | Generic representation of 'Enum' types.
--
-- The @opts@ parameter is a type-level option to select different
-- implementations.
class GEnum opts f where
  gCardinality :: Int
  gFromEnum :: f p -> Int
  gToEnum :: Int -> f p

-- | Standard option for 'GEnum': derive 'Enum' for types with only nullary
-- constructors (the same restrictions as in the [Haskell 2010
-- report](https://www.haskell.org/onlinereport/haskell2010/haskellch11.html#x18-18400011.2)).
data StandardEnum

-- | Extends the 'StandardEnum' option for 'GEnum' to allow all constructors to 
-- have arbitrary many fields. Each field type must be an instance of 
-- both 'Enum' and 'Bounded'. Two restrictions require the user's caution:
--
-- * The 'Enum' instances of the field types need to start enumerating from 0. 
-- Particularly 'Int' is an unfit field type, because the enumeration of the 
-- negative values starts before 0. 
--
-- * There can only be up to @'maxBound' :: 'Int'@ values (because the implementation
-- represents the cardinality explicitly as an 'Int'). This restriction makes
-- 'Word' an invalid field type. Notably, it is insufficient for each
-- individual field types to stay below this limit. Instead it applies to the
-- generic type as a whole.
--
-- The resulting 'GEnum' instance starts enumerating from @0@ up to
-- @(cardinality - 1)@ and respects the generic 'Ord' instance (defined by
-- 'Generic.Data.gcompare'). The values from different constructors are enumerated
-- sequentially; they are not interleaved.
--
-- @
-- data Example = C0 Bool Bool | C1 Bool
--   deriving ('Eq', 'Ord', 'Show', 'Generic')
--
-- cardinality = 6  -- 2    * 2    + 2
--                  -- Bool * Bool | Bool
--
-- enumeration =
--     [ C0 False False
--     , C0 False  True
--     , C0  True False
--     , C0  True  True
--     , C1 False
--     , C1 True
--     ]
--
-- enumeration == map 'gtoFiniteEnum' [0 .. 5]
-- [0 .. 5] == map 'gfromFiniteEnum' enumeration
-- @
data FiniteEnum

instance GEnum opts f => GEnum opts (M1 i c f) where
  gCardinality :: Int
gCardinality = GEnum opts f => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @opts @f
  gFromEnum :: M1 i c f p -> Int
gFromEnum = forall opts (f :: * -> *) p. GEnum opts f => f p -> Int
forall (f :: * -> *) p. GEnum opts f => f p -> Int
gFromEnum @opts (f p -> Int) -> (M1 i c f p -> f p) -> M1 i c f p -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c f p -> f p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
  gToEnum :: Int -> M1 i c f p
gToEnum = f p -> M1 i c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 i c f p) -> (Int -> f p) -> Int -> M1 i c f p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall opts (f :: * -> *) p. GEnum opts f => Int -> f p
forall (f :: * -> *) p. GEnum opts f => Int -> f p
gToEnum @opts

instance (GEnum opts f, GEnum opts g) => GEnum opts (f :+: g) where
  gCardinality :: Int
gCardinality = GEnum opts f => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @opts @f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ GEnum opts g => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @opts @g
  gFromEnum :: (:+:) f g p -> Int
gFromEnum (L1 x :: f p
x) = f p -> Int
forall opts (f :: * -> *) p. GEnum opts f => f p -> Int
gFromEnum @opts f p
x
  gFromEnum (R1 y :: g p
y) = Int
cardF Int -> Int -> Int
forall a. Num a => a -> a -> a
+ g p -> Int
forall opts (f :: * -> *) p. GEnum opts f => f p -> Int
gFromEnum @opts g p
y
    where
      cardF :: Int
cardF = GEnum opts f => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @opts @f
  gToEnum :: Int -> (:+:) f g p
gToEnum n :: Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cardF = f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Int -> f p
forall opts (f :: * -> *) p. GEnum opts f => Int -> f p
gToEnum @opts Int
n)
    | Bool
otherwise = g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Int -> g p
forall opts (f :: * -> *) p. GEnum opts f => Int -> f p
gToEnum @opts (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cardF))
    where
      cardF :: Int
cardF = GEnum opts f => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @opts @f

instance (GEnum FiniteEnum f, GEnum FiniteEnum g) => GEnum FiniteEnum (f :*: g) where
  gCardinality :: Int
gCardinality = GEnum FiniteEnum f => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @FiniteEnum @f Int -> Int -> Int
forall a. Num a => a -> a -> a
* GEnum FiniteEnum g => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @FiniteEnum @g
  gFromEnum :: (:*:) f g p -> Int
gFromEnum (x :: f p
x :*: y :: g p
y) = f p -> Int
forall opts (f :: * -> *) p. GEnum opts f => f p -> Int
gFromEnum @FiniteEnum f p
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cardG Int -> Int -> Int
forall a. Num a => a -> a -> a
+ g p -> Int
forall opts (f :: * -> *) p. GEnum opts f => f p -> Int
gFromEnum @FiniteEnum g p
y
    where
      cardG :: Int
cardG = GEnum FiniteEnum g => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @FiniteEnum @g
  gToEnum :: Int -> (:*:) f g p
gToEnum n :: Int
n = Int -> f p
forall opts (f :: * -> *) p. GEnum opts f => Int -> f p
gToEnum @FiniteEnum Int
x f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Int -> g p
forall opts (f :: * -> *) p. GEnum opts f => Int -> f p
gToEnum @FiniteEnum Int
y
    where
      (x :: Int
x, y :: Int
y) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
cardG
      cardG :: Int
cardG = GEnum FiniteEnum g => Int
forall opts (f :: * -> *). GEnum opts f => Int
gCardinality @FiniteEnum @g
  
instance GEnum opts U1 where
  gCardinality :: Int
gCardinality = 1
  gFromEnum :: U1 p -> Int
gFromEnum U1 = 0
  gToEnum :: Int -> U1 p
gToEnum _ = U1 p
forall k (p :: k). U1 p
U1

instance (Bounded c, Enum c) => GEnum FiniteEnum (K1 i c) where
  gCardinality :: Int
gCardinality = c -> Int
forall a. Enum a => a -> Int
fromEnum (c
forall a. Bounded a => a
maxBound :: c) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
  gFromEnum :: K1 i c p -> Int
gFromEnum = c -> Int
forall a. Enum a => a -> Int
fromEnum (c -> Int) -> (K1 i c p -> c) -> K1 i c p -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i c p -> c
forall i c k (p :: k). K1 i c p -> c
unK1
  gToEnum :: Int -> K1 i c p
gToEnum = c -> K1 i c p
forall k i c (p :: k). c -> K1 i c p
K1 (c -> K1 i c p) -> (Int -> c) -> Int -> K1 i c p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> c
forall a. Enum a => Int -> a
toEnum

-- | Generic representation of 'Bounded' types.
class GBounded f where
  gMinBound :: f p
  gMaxBound :: f p

deriving instance GBounded f => GBounded (M1 i c f)

instance GBounded U1 where
  gMinBound :: U1 p
gMinBound = U1 p
forall k (p :: k). U1 p
U1
  gMaxBound :: U1 p
gMaxBound = U1 p
forall k (p :: k). U1 p
U1

instance Bounded c => GBounded (K1 i c) where
  gMinBound :: K1 i c p
gMinBound = c -> K1 i c p
forall k i c (p :: k). c -> K1 i c p
K1 c
forall a. Bounded a => a
minBound
  gMaxBound :: K1 i c p
gMaxBound = c -> K1 i c p
forall k i c (p :: k). c -> K1 i c p
K1 c
forall a. Bounded a => a
maxBound

instance (GBounded f, GBounded g) => GBounded (f :+: g) where
  gMinBound :: (:+:) f g p
gMinBound = f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
forall (f :: * -> *) p. GBounded f => f p
gMinBound
  gMaxBound :: (:+:) f g p
gMaxBound = g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g p
forall (f :: * -> *) p. GBounded f => f p
gMaxBound

instance (GBounded f, GBounded g) => GBounded (f :*: g) where
  gMinBound :: (:*:) f g p
gMinBound = f p
forall (f :: * -> *) p. GBounded f => f p
gMinBound f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
forall (f :: * -> *) p. GBounded f => f p
gMinBound
  gMaxBound :: (:*:) f g p
gMaxBound = f p
forall (f :: * -> *) p. GBounded f => f p
gMaxBound f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
forall (f :: * -> *) p. GBounded f => f p
gMaxBound