{-# LANGUAGE DeriveDataTypeable   #-}
{-# LANGUAGE DeriveFoldable       #-}
{-# LANGUAGE DeriveFunctor        #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE DeriveTraversable    #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      : Data.Bounded.OneLiner
-- Description : Derived methods for Semigroup.
-- Copyright   : (c) Justin Le 2021
-- License     : BSD-3
-- Maintainer  : justin@jle.im
-- Stability   : unstable
-- Portability : portable
--
-- Derived methods for 'Bounded', using "Generics.OneLiner" and
-- "GHC.Generics".
--
-- Can be used for any types (deriving 'Generic') where every field is an
-- instance of 'Bounded'.
--
-- Also includes a newtype wrapper that imbues any such data type with an
-- instant 'Bounded' instance, which can one day be used with /DerivingVia/
-- syntax to derive instances automatically.
--

module Data.Bounded.OneLiner (
  -- * Newtype wrapper
    GBounded(..)
  -- * Generics-derived methods
  , gMinBound
  , gMaxBound
  ) where

import           Data.Coerce
import           Data.Data
import           GHC.Generics
import           Generics.OneLiner

-- | If @a@ is a data type whose fields are all instances of 'Bounded',
-- then @'GBounded' a@ has a 'Bounded' instance.
--
-- Will one day be able to be used with /DerivingVia/ syntax, to derive
-- instances automatically.
--
newtype GBounded a = GBounded { GBounded a -> a
getGBounded :: a }
  deriving (GBounded a -> GBounded a -> Bool
(GBounded a -> GBounded a -> Bool)
-> (GBounded a -> GBounded a -> Bool) -> Eq (GBounded a)
forall a. Eq a => GBounded a -> GBounded a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GBounded a -> GBounded a -> Bool
$c/= :: forall a. Eq a => GBounded a -> GBounded a -> Bool
== :: GBounded a -> GBounded a -> Bool
$c== :: forall a. Eq a => GBounded a -> GBounded a -> Bool
Eq, Eq (GBounded a)
Eq (GBounded a)
-> (GBounded a -> GBounded a -> Ordering)
-> (GBounded a -> GBounded a -> Bool)
-> (GBounded a -> GBounded a -> Bool)
-> (GBounded a -> GBounded a -> Bool)
-> (GBounded a -> GBounded a -> Bool)
-> (GBounded a -> GBounded a -> GBounded a)
-> (GBounded a -> GBounded a -> GBounded a)
-> Ord (GBounded a)
GBounded a -> GBounded a -> Bool
GBounded a -> GBounded a -> Ordering
GBounded a -> GBounded a -> GBounded a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (GBounded a)
forall a. Ord a => GBounded a -> GBounded a -> Bool
forall a. Ord a => GBounded a -> GBounded a -> Ordering
forall a. Ord a => GBounded a -> GBounded a -> GBounded a
min :: GBounded a -> GBounded a -> GBounded a
$cmin :: forall a. Ord a => GBounded a -> GBounded a -> GBounded a
max :: GBounded a -> GBounded a -> GBounded a
$cmax :: forall a. Ord a => GBounded a -> GBounded a -> GBounded a
>= :: GBounded a -> GBounded a -> Bool
$c>= :: forall a. Ord a => GBounded a -> GBounded a -> Bool
> :: GBounded a -> GBounded a -> Bool
$c> :: forall a. Ord a => GBounded a -> GBounded a -> Bool
<= :: GBounded a -> GBounded a -> Bool
$c<= :: forall a. Ord a => GBounded a -> GBounded a -> Bool
< :: GBounded a -> GBounded a -> Bool
$c< :: forall a. Ord a => GBounded a -> GBounded a -> Bool
compare :: GBounded a -> GBounded a -> Ordering
$ccompare :: forall a. Ord a => GBounded a -> GBounded a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (GBounded a)
Ord, Int -> GBounded a -> ShowS
[GBounded a] -> ShowS
GBounded a -> String
(Int -> GBounded a -> ShowS)
-> (GBounded a -> String)
-> ([GBounded a] -> ShowS)
-> Show (GBounded a)
forall a. Show a => Int -> GBounded a -> ShowS
forall a. Show a => [GBounded a] -> ShowS
forall a. Show a => GBounded a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GBounded a] -> ShowS
$cshowList :: forall a. Show a => [GBounded a] -> ShowS
show :: GBounded a -> String
$cshow :: forall a. Show a => GBounded a -> String
showsPrec :: Int -> GBounded a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GBounded a -> ShowS
Show, ReadPrec [GBounded a]
ReadPrec (GBounded a)
Int -> ReadS (GBounded a)
ReadS [GBounded a]
(Int -> ReadS (GBounded a))
-> ReadS [GBounded a]
-> ReadPrec (GBounded a)
-> ReadPrec [GBounded a]
-> Read (GBounded a)
forall a. Read a => ReadPrec [GBounded a]
forall a. Read a => ReadPrec (GBounded a)
forall a. Read a => Int -> ReadS (GBounded a)
forall a. Read a => ReadS [GBounded a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GBounded a]
$creadListPrec :: forall a. Read a => ReadPrec [GBounded a]
readPrec :: ReadPrec (GBounded a)
$creadPrec :: forall a. Read a => ReadPrec (GBounded a)
readList :: ReadS [GBounded a]
$creadList :: forall a. Read a => ReadS [GBounded a]
readsPrec :: Int -> ReadS (GBounded a)
$creadsPrec :: forall a. Read a => Int -> ReadS (GBounded a)
Read, Typeable (GBounded a)
DataType
Constr
Typeable (GBounded a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> GBounded a -> c (GBounded a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (GBounded a))
-> (GBounded a -> Constr)
-> (GBounded a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (GBounded a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (GBounded a)))
-> ((forall b. Data b => b -> b) -> GBounded a -> GBounded a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GBounded a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GBounded a -> r)
-> (forall u. (forall d. Data d => d -> u) -> GBounded a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GBounded a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a))
-> Data (GBounded a)
GBounded a -> DataType
GBounded a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (GBounded a))
(forall b. Data b => b -> b) -> GBounded a -> GBounded a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GBounded a -> c (GBounded a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GBounded a)
forall a. Data a => Typeable (GBounded a)
forall a. Data a => GBounded a -> DataType
forall a. Data a => GBounded a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> GBounded a -> GBounded a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> GBounded a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> GBounded a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GBounded a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GBounded a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GBounded a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GBounded a -> c (GBounded a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GBounded a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GBounded a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GBounded a -> u
forall u. (forall d. Data d => d -> u) -> GBounded a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GBounded a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GBounded a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GBounded a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GBounded a -> c (GBounded a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (GBounded a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GBounded a))
$cGBounded :: Constr
$tGBounded :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a)
gmapMp :: (forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a)
gmapM :: (forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> GBounded a -> m (GBounded a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> GBounded a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> GBounded a -> u
gmapQ :: (forall d. Data d => d -> u) -> GBounded a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> GBounded a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GBounded a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GBounded a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GBounded a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GBounded a -> r
gmapT :: (forall b. Data b => b -> b) -> GBounded a -> GBounded a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> GBounded a -> GBounded a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GBounded a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GBounded a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (GBounded a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GBounded a))
dataTypeOf :: GBounded a -> DataType
$cdataTypeOf :: forall a. Data a => GBounded a -> DataType
toConstr :: GBounded a -> Constr
$ctoConstr :: forall a. Data a => GBounded a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GBounded a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GBounded a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GBounded a -> c (GBounded a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GBounded a -> c (GBounded a)
$cp1Data :: forall a. Data a => Typeable (GBounded a)
Data, (forall x. GBounded a -> Rep (GBounded a) x)
-> (forall x. Rep (GBounded a) x -> GBounded a)
-> Generic (GBounded a)
forall x. Rep (GBounded a) x -> GBounded a
forall x. GBounded a -> Rep (GBounded a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (GBounded a) x -> GBounded a
forall a x. GBounded a -> Rep (GBounded a) x
$cto :: forall a x. Rep (GBounded a) x -> GBounded a
$cfrom :: forall a x. GBounded a -> Rep (GBounded a) x
Generic, a -> GBounded b -> GBounded a
(a -> b) -> GBounded a -> GBounded b
(forall a b. (a -> b) -> GBounded a -> GBounded b)
-> (forall a b. a -> GBounded b -> GBounded a) -> Functor GBounded
forall a b. a -> GBounded b -> GBounded a
forall a b. (a -> b) -> GBounded a -> GBounded b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GBounded b -> GBounded a
$c<$ :: forall a b. a -> GBounded b -> GBounded a
fmap :: (a -> b) -> GBounded a -> GBounded b
$cfmap :: forall a b. (a -> b) -> GBounded a -> GBounded b
Functor, GBounded a -> Bool
(a -> m) -> GBounded a -> m
(a -> b -> b) -> b -> GBounded a -> b
(forall m. Monoid m => GBounded m -> m)
-> (forall m a. Monoid m => (a -> m) -> GBounded a -> m)
-> (forall m a. Monoid m => (a -> m) -> GBounded a -> m)
-> (forall a b. (a -> b -> b) -> b -> GBounded a -> b)
-> (forall a b. (a -> b -> b) -> b -> GBounded a -> b)
-> (forall b a. (b -> a -> b) -> b -> GBounded a -> b)
-> (forall b a. (b -> a -> b) -> b -> GBounded a -> b)
-> (forall a. (a -> a -> a) -> GBounded a -> a)
-> (forall a. (a -> a -> a) -> GBounded a -> a)
-> (forall a. GBounded a -> [a])
-> (forall a. GBounded a -> Bool)
-> (forall a. GBounded a -> Int)
-> (forall a. Eq a => a -> GBounded a -> Bool)
-> (forall a. Ord a => GBounded a -> a)
-> (forall a. Ord a => GBounded a -> a)
-> (forall a. Num a => GBounded a -> a)
-> (forall a. Num a => GBounded a -> a)
-> Foldable GBounded
forall a. Eq a => a -> GBounded a -> Bool
forall a. Num a => GBounded a -> a
forall a. Ord a => GBounded a -> a
forall m. Monoid m => GBounded m -> m
forall a. GBounded a -> Bool
forall a. GBounded a -> Int
forall a. GBounded a -> [a]
forall a. (a -> a -> a) -> GBounded a -> a
forall m a. Monoid m => (a -> m) -> GBounded a -> m
forall b a. (b -> a -> b) -> b -> GBounded a -> b
forall a b. (a -> b -> b) -> b -> GBounded 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
product :: GBounded a -> a
$cproduct :: forall a. Num a => GBounded a -> a
sum :: GBounded a -> a
$csum :: forall a. Num a => GBounded a -> a
minimum :: GBounded a -> a
$cminimum :: forall a. Ord a => GBounded a -> a
maximum :: GBounded a -> a
$cmaximum :: forall a. Ord a => GBounded a -> a
elem :: a -> GBounded a -> Bool
$celem :: forall a. Eq a => a -> GBounded a -> Bool
length :: GBounded a -> Int
$clength :: forall a. GBounded a -> Int
null :: GBounded a -> Bool
$cnull :: forall a. GBounded a -> Bool
toList :: GBounded a -> [a]
$ctoList :: forall a. GBounded a -> [a]
foldl1 :: (a -> a -> a) -> GBounded a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GBounded a -> a
foldr1 :: (a -> a -> a) -> GBounded a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> GBounded a -> a
foldl' :: (b -> a -> b) -> b -> GBounded a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GBounded a -> b
foldl :: (b -> a -> b) -> b -> GBounded a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GBounded a -> b
foldr' :: (a -> b -> b) -> b -> GBounded a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GBounded a -> b
foldr :: (a -> b -> b) -> b -> GBounded a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> GBounded a -> b
foldMap' :: (a -> m) -> GBounded a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GBounded a -> m
foldMap :: (a -> m) -> GBounded a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GBounded a -> m
fold :: GBounded m -> m
$cfold :: forall m. Monoid m => GBounded m -> m
Foldable, Functor GBounded
Foldable GBounded
Functor GBounded
-> Foldable GBounded
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> GBounded a -> f (GBounded b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GBounded (f a) -> f (GBounded a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GBounded a -> m (GBounded b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GBounded (m a) -> m (GBounded a))
-> Traversable GBounded
(a -> f b) -> GBounded a -> f (GBounded b)
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 => GBounded (m a) -> m (GBounded a)
forall (f :: * -> *) a.
Applicative f =>
GBounded (f a) -> f (GBounded a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GBounded a -> m (GBounded b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GBounded a -> f (GBounded b)
sequence :: GBounded (m a) -> m (GBounded a)
$csequence :: forall (m :: * -> *) a. Monad m => GBounded (m a) -> m (GBounded a)
mapM :: (a -> m b) -> GBounded a -> m (GBounded b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GBounded a -> m (GBounded b)
sequenceA :: GBounded (f a) -> f (GBounded a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GBounded (f a) -> f (GBounded a)
traverse :: (a -> f b) -> GBounded a -> f (GBounded b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GBounded a -> f (GBounded b)
$cp2Traversable :: Foldable GBounded
$cp1Traversable :: Functor GBounded
Traversable)

instance ( ADT a
         , Constraints a Bounded
         )
      => Bounded (GBounded a) where
    minBound :: GBounded a
minBound = a -> GBounded a
coerce ((ADT a, Constraints a Bounded) => a
forall a. (ADT a, Constraints a Bounded) => a
gMinBound @a)
    {-# INLINE minBound #-}
    maxBound :: GBounded a
maxBound = a -> GBounded a
coerce ((ADT a, Constraints a Bounded) => a
forall a. (ADT a, Constraints a Bounded) => a
gMaxBound @a)
    {-# INLINE maxBound #-}

-- | 'minBound' implemented by using 'minBound' for all of the components
-- for the first constructor
gMinBound
    :: forall a. (ADT a, Constraints a Bounded)
    => a
gMinBound :: a
gMinBound = case (forall s. Bounded s => [s]) -> [a]
forall (c :: * -> Constraint) t.
(ADT t, Constraints t c) =>
(forall s. c s => [s]) -> [t]
create @Bounded [s
forall a. Bounded a => a
minBound] of
              []  -> String -> a
forall a. HasCallStack => String -> a
error String
"minBound: uninhabited"
              a
x:[a]
_ -> a
x

-- | 'maxBound' implemented by using 'maxBound' for all of the components
-- for the last constructor
gMaxBound
    :: forall a. (ADT a, Constraints a Bounded)
    => a
gMaxBound :: a
gMaxBound = case [a] -> [a]
forall a. [a] -> [a]
reverse ((forall s. Bounded s => [s]) -> [a]
forall (c :: * -> Constraint) t.
(ADT t, Constraints t c) =>
(forall s. c s => [s]) -> [t]
create @Bounded [s
forall a. Bounded a => a
maxBound]) of
              []  -> String -> a
forall a. HasCallStack => String -> a
error String
"maxBound: uninhabited"
              a
x:[a]
_ -> a
x