{-# LANGUAGE AllowAmbiguousTypes, TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ConstraintKinds, DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK prune, ignore-exports #-}

{-|
Module      : Data.Sum
Description : Open sums (type-indexed co-products) for extensible effects.
Copyright   : Allele Dev 2015
License     : BSD-3
Maintainer  : allele.dev@gmail.com
Stability   : experimental
Portability : POSIX

All operations are constant-time, and there is no Typeable constraint.

This is a variation of Kiselyov's OpenUnion5.hs, which relies on
overlapping instances instead of closed type families. Closed type
families have their problems: overlapping instances can resolve even
for unground types, but closed type families are subject to a strict
apartness condition.
-}

module Data.Sum
  ( -- * The fundamental sum-of-products type
    Sum
  -- * Creating and extracting sums from products
  , inject
  , project
  , projectGuard
  -- * Operating on sums' effects lists
  , decompose
  , decomposeLast
  , weaken
  -- * Membership prodicates
  , Element
  , type(:<)
  , Elements
  , type(:<:)
  , ElemIndex
  , elemIndex
  -- * Typeclass application.
  , Apply(..)
  , apply'
  , apply2
  , apply2'
  ) where

import Control.Applicative (Alternative (..))
import Control.DeepSeq (NFData(..), NFData1(..))
import Data.Functor.Classes (Eq1(..), eq1, Ord1(..), compare1, Show1(..), showsPrec1)
import Data.Hashable (Hashable(..))
import Data.Hashable.Lifted (Hashable1(..), hashWithSalt1)
import Data.Maybe (fromMaybe)
import Data.Sum.Templates
import GHC.Exts (Constraint)
import GHC.Prim (Proxy#, proxy#)
import GHC.TypeLits
import Unsafe.Coerce(unsafeCoerce)

mkElemIndexTypeFamily 200

infixr 5 :<

-- | The fundamental sum type over a type-level list of products @r@
-- and an annotation type @v@. The constructor is not exported;
-- use 'inject' to create a 'Sum'.
data Sum (r :: [ * -> * ]) (v :: *) where
  -- | Strong Sum (Existential with the evidence) is an open sum
  -- t is can be a GADT and hence not necessarily a Functor.
  -- Int is the index of t in the list r; that is, the index of t in the
  -- universe r.
  Sum :: {-# UNPACK #-} !Int -> t v -> Sum r v

unsafeInject :: Int -> t v -> Sum r v
unsafeInject :: Int -> t v -> Sum r v
unsafeInject = Int -> t v -> Sum r v
forall (t :: * -> *) v (r :: [* -> *]). Int -> t v -> Sum r v
Sum
{-# INLINE unsafeInject #-}

unsafeProject :: Int -> Sum r v -> Maybe (t v)
unsafeProject :: Int -> Sum r v -> Maybe (t v)
unsafeProject Int
n (Sum Int
n' t v
x) | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n'   = t v -> Maybe (t v)
forall a. a -> Maybe a
Just (t v -> t v
forall a b. a -> b
unsafeCoerce t v
x)
                           | Bool
otherwise = Maybe (t v)
forall a. Maybe a
Nothing
{-# INLINE unsafeProject #-}

newtype P (t :: * -> *) (r :: [* -> *]) = P { P t r -> Int
unP :: Int }

infixr 5 :<:
-- | An @Elements ms r@ constraint proves that @r@ contains
-- all of the elements in @ms@.
type family Elements (ms :: [* -> *]) r :: Constraint where
  Elements (t ': cs) r = (Element t r, Elements cs r)
  Elements '[] r = ()

-- | An infix synonym for 'Elements'.
type (ts :<: r) = Elements ts r

-- | Inject a functor into a type-aligned sum.
inject :: forall e r v. (e :< r) => e v -> Sum r v
inject :: e v -> Sum r v
inject = Int -> e v -> Sum r v
forall (t :: * -> *) v (r :: [* -> *]). Int -> t v -> Sum r v
unsafeInject (P e r -> Int
forall (t :: * -> *) (r :: [* -> *]). P t r -> Int
unP (P e r
forall (t :: * -> *) (r :: [* -> *]). (t :< r) => P t r
elemNo :: P e r))
{-# INLINE inject #-}

-- | Maybe project a functor out of a type-aligned sum.
project :: forall e r v. (e :< r) => Sum r v -> Maybe (e v)
project :: Sum r v -> Maybe (e v)
project = Int -> Sum r v -> Maybe (e v)
forall (r :: [* -> *]) v (t :: * -> *).
Int -> Sum r v -> Maybe (t v)
unsafeProject (P e r -> Int
forall (t :: * -> *) (r :: [* -> *]). P t r -> Int
unP (P e r
forall (t :: * -> *) (r :: [* -> *]). (t :< r) => P t r
elemNo :: P e r))
{-# INLINE project #-}

-- | As 'project', but generalized to any 'Alternative' functor.
projectGuard :: forall m e r v . (Alternative m, e :< r) => Sum r v -> m (e v)
projectGuard :: Sum r v -> m (e v)
projectGuard = m (e v) -> (e v -> m (e v)) -> Maybe (e v) -> m (e v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (e v)
forall (f :: * -> *) a. Alternative f => f a
empty e v -> m (e v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (e v) -> m (e v))
-> (Sum r v -> Maybe (e v)) -> Sum r v -> m (e v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum r v -> Maybe (e v)
forall (e :: * -> *) (r :: [* -> *]) v.
(e :< r) =>
Sum r v -> Maybe (e v)
project

-- | Attempts to extract the head type @e@ from a @Sum@. Returns
-- @Right@ on success, and a @Sum@ without @e@ otherwise. You can
-- repeatedly apply this and apply 'decomposeLast' when you have @Sum
-- '[e]@ to get typesafe, exhaustive matching of an open sum. See
-- @examples/Errors.hs@ for a full example.
decompose :: Sum (e ': es) b -> Either (Sum es b) (e b)
decompose :: Sum (e : es) b -> Either (Sum es b) (e b)
decompose sum :: Sum (e : es) b
sum@(Sum Int
n t b
v) = Either (Sum es b) (e b)
-> (e b -> Either (Sum es b) (e b))
-> Maybe (e b)
-> Either (Sum es b) (e b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Sum es b -> Either (Sum es b) (e b)
forall a b. a -> Either a b
Left (Int -> t b -> Sum es b
forall (t :: * -> *) v (r :: [* -> *]). Int -> t v -> Sum r v
Sum (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) t b
v)) e b -> Either (Sum es b) (e b)
forall a b. b -> Either a b
Right (Sum (e : es) b -> Maybe (e b)
forall (e :: * -> *) (r :: [* -> *]) v.
(e :< r) =>
Sum r v -> Maybe (e v)
project Sum (e : es) b
sum)
{-# INLINE decompose #-}

-- | Special case of 'decompose' which knows that there is only one
-- possible type remaining in the @Sum@, @e@ thus it is guaranteed to
-- return @e@
decomposeLast :: Sum '[e] b -> e b
decomposeLast :: Sum '[e] b -> e b
decomposeLast = (Sum '[] b -> e b)
-> (e b -> e b) -> Either (Sum '[] b) (e b) -> e b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Sum '[] b -> e b
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Sum: impossible case in decomposeLast") e b -> e b
forall a. a -> a
id (Either (Sum '[] b) (e b) -> e b)
-> (Sum '[e] b -> Either (Sum '[] b) (e b)) -> Sum '[e] b -> e b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum '[e] b -> Either (Sum '[] b) (e b)
forall (e :: * -> *) (es :: [* -> *]) b.
Sum (e : es) b -> Either (Sum es b) (e b)
decompose
{-# INLINE decomposeLast #-}

-- | Add an arbitrary product @any@ to a product list @r@.
weaken :: Sum r w -> Sum (any ': r) w
weaken :: Sum r w -> Sum (any : r) w
weaken (Sum Int
n t w
v) = Int -> t w -> Sum (any : r) w
forall (t :: * -> *) v (r :: [* -> *]). Int -> t v -> Sum r v
Sum (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) t w
v

-- | @Element t r@ is a proof that @t@ is a member of @r@. This is implemented
-- in terms of @KnownNat@ rather than recursive typeclass lookups.
type (Element t r) = KnownNat (ElemIndex t r)

-- | An infix version of 'Element'. Note that you will need @-XTypeOperators@
-- turned on to use this.
type (t :< r) = Element t r

elemIndex :: Sum r w -> Int
elemIndex :: Sum r w -> Int
elemIndex (Sum Int
n t w
_) = Int
n

-- Find an index of an element in an `r'.
-- The element must exist, so this is essentially a compile-time computation.
elemNo :: forall t r . (t :< r) => P t r
elemNo :: P t r
elemNo = Int -> P t r
forall (t :: * -> *) (r :: [* -> *]). Int -> P t r
P (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy# (ElemIndex t r) -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# (ElemIndex t r)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (ElemIndex t r))))

-- | Helper to apply a function to a functor of the nth type in a type list.
-- An @Apply SomeClass fs@ instance means that @Sum fs@ has an instance of @SomeClass@.
-- Instances are written using 'apply' and an explicit type application:
--
-- > instance Apply SomeClass fs => SomeClass (Sum fs) where method = apply @SomeClass method
--
-- An @INLINEABLE@ pragma on such an instance may improve dispatch speed.
class Apply (c :: (* -> *) -> Constraint) (fs :: [* -> *]) where
  apply :: (forall g . c g => g a -> b) -> Sum fs a -> b

apply' :: forall c fs a b . Apply c fs => (forall g . c g => (forall x. g x -> Sum fs x) -> g a -> b) -> Sum fs a -> b
apply' :: (forall (g :: * -> *).
 c g =>
 (forall x. g x -> Sum fs x) -> g a -> b)
-> Sum fs a -> b
apply' forall (g :: * -> *).
c g =>
(forall x. g x -> Sum fs x) -> g a -> b
f u :: Sum fs a
u@(Sum Int
n t a
_) = (forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
apply @c ((forall x. g x -> Sum fs x) -> g a -> b
forall (g :: * -> *).
c g =>
(forall x. g x -> Sum fs x) -> g a -> b
f (Int -> g x -> Sum fs x
forall (t :: * -> *) v (r :: [* -> *]). Int -> t v -> Sum r v
Sum Int
n)) Sum fs a
u
{-# INLINABLE apply' #-}

apply2 :: forall c fs a b d . Apply c fs => (forall g . c g => g a -> g b -> d) -> Sum fs a -> Sum fs b -> Maybe d
apply2 :: (forall (g :: * -> *). c g => g a -> g b -> d)
-> Sum fs a -> Sum fs b -> Maybe d
apply2 forall (g :: * -> *). c g => g a -> g b -> d
f u :: Sum fs a
u@(Sum Int
n1 t a
_) (Sum Int
n2 t b
r2)
  | Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2  = d -> Maybe d
forall a. a -> Maybe a
Just ((forall (g :: * -> *). c g => g a -> d) -> Sum fs a -> d
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
apply @c (\ g a
r1 -> g a -> g b -> d
forall (g :: * -> *). c g => g a -> g b -> d
f g a
r1 (t b -> g b
forall a b. a -> b
unsafeCoerce t b
r2)) Sum fs a
u)
  | Bool
otherwise = Maybe d
forall a. Maybe a
Nothing
{-# INLINABLE apply2 #-}

apply2' :: forall c fs a b d . Apply c fs => (forall g . c g => (forall x. g x -> Sum fs x) -> g a -> g b -> d) -> Sum fs a -> Sum fs b -> Maybe d
apply2' :: (forall (g :: * -> *).
 c g =>
 (forall x. g x -> Sum fs x) -> g a -> g b -> d)
-> Sum fs a -> Sum fs b -> Maybe d
apply2' forall (g :: * -> *).
c g =>
(forall x. g x -> Sum fs x) -> g a -> g b -> d
f u :: Sum fs a
u@(Sum Int
n1 t a
_) (Sum Int
n2 t b
r2)
  | Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2  = d -> Maybe d
forall a. a -> Maybe a
Just ((forall (g :: * -> *).
 c g =>
 (forall x. g x -> Sum fs x) -> g a -> d)
-> Sum fs a -> d
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *).
 c g =>
 (forall x. g x -> Sum fs x) -> g a -> b)
-> Sum fs a -> b
apply' @c (\ forall x. g x -> Sum fs x
reinject g a
r1 -> (forall x. g x -> Sum fs x) -> g a -> g b -> d
forall (g :: * -> *).
c g =>
(forall x. g x -> Sum fs x) -> g a -> g b -> d
f forall x. g x -> Sum fs x
reinject g a
r1 (t b -> g b
forall a b. a -> b
unsafeCoerce t b
r2)) Sum fs a
u)
  | Bool
otherwise = Maybe d
forall a. Maybe a
Nothing
{-# INLINABLE apply2' #-}

pure (mkApplyInstance <$> [1..200])


instance Apply Foldable fs => Foldable (Sum fs) where
  foldMap :: (a -> m) -> Sum fs a -> m
foldMap a -> m
f = (forall (g :: * -> *). Foldable g => g a -> m) -> Sum fs a -> m
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
apply @Foldable ((a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f)
  {-# INLINABLE foldMap #-}

  foldr :: (a -> b -> b) -> b -> Sum fs a -> b
foldr a -> b -> b
combine b
seed = (forall (g :: * -> *). Foldable g => g a -> b) -> Sum fs a -> b
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
apply @Foldable ((a -> b -> b) -> b -> g a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
combine b
seed)
  {-# INLINABLE foldr #-}

  foldl :: (b -> a -> b) -> b -> Sum fs a -> b
foldl b -> a -> b
combine b
seed = (forall (g :: * -> *). Foldable g => g a -> b) -> Sum fs a -> b
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
apply @Foldable ((b -> a -> b) -> b -> g a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
combine b
seed)
  {-# INLINABLE foldl #-}

  null :: Sum fs a -> Bool
null = (forall (g :: * -> *). Foldable g => g a -> Bool)
-> Sum fs a -> Bool
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
apply @Foldable forall (g :: * -> *). Foldable g => g a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
  {-# INLINABLE null #-}

  length :: Sum fs a -> Int
length = (forall (g :: * -> *). Foldable g => g a -> Int) -> Sum fs a -> Int
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
apply @Foldable forall (g :: * -> *). Foldable g => g a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
  {-# INLINABLE length #-}

instance Apply Functor fs => Functor (Sum fs) where
  fmap :: (a -> b) -> Sum fs a -> Sum fs b
fmap a -> b
f = (forall (g :: * -> *).
 Functor g =>
 (forall x. g x -> Sum fs x) -> g a -> Sum fs b)
-> Sum fs a -> Sum fs b
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *).
 c g =>
 (forall x. g x -> Sum fs x) -> g a -> b)
-> Sum fs a -> b
apply' @Functor (\ forall x. g x -> Sum fs x
reinject g a
a -> g b -> Sum fs b
forall x. g x -> Sum fs x
reinject ((a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f g a
a))
  {-# INLINABLE fmap #-}

  <$ :: a -> Sum fs b -> Sum fs a
(<$) a
v = (forall (g :: * -> *).
 Functor g =>
 (forall x. g x -> Sum fs x) -> g b -> Sum fs a)
-> Sum fs b -> Sum fs a
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *).
 c g =>
 (forall x. g x -> Sum fs x) -> g a -> b)
-> Sum fs a -> b
apply' @Functor (\ forall x. g x -> Sum fs x
reinject g b
a -> g a -> Sum fs a
forall x. g x -> Sum fs x
reinject (a
v a -> g b -> g a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ g b
a))
  {-# INLINABLE (<$) #-}

instance (Apply Foldable fs, Apply Functor fs, Apply Traversable fs) => Traversable (Sum fs) where
  traverse :: (a -> f b) -> Sum fs a -> f (Sum fs b)
traverse a -> f b
f = (forall (g :: * -> *).
 Traversable g =>
 (forall x. g x -> Sum fs x) -> g a -> f (Sum fs b))
-> Sum fs a -> f (Sum fs b)
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *).
 c g =>
 (forall x. g x -> Sum fs x) -> g a -> b)
-> Sum fs a -> b
apply' @Traversable (\ forall x. g x -> Sum fs x
reinject g a
a -> g b -> Sum fs b
forall x. g x -> Sum fs x
reinject (g b -> Sum fs b) -> f (g b) -> f (Sum fs b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> g a -> f (g b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f g a
a)
  {-# INLINABLE traverse #-}

  sequenceA :: Sum fs (f a) -> f (Sum fs a)
sequenceA = (forall (g :: * -> *).
 Traversable g =>
 (forall x. g x -> Sum fs x) -> g (f a) -> f (Sum fs a))
-> Sum fs (f a) -> f (Sum fs a)
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *).
 c g =>
 (forall x. g x -> Sum fs x) -> g a -> b)
-> Sum fs a -> b
apply' @Traversable (\ forall x. g x -> Sum fs x
reinject g (f a)
a -> g a -> Sum fs a
forall x. g x -> Sum fs x
reinject (g a -> Sum fs a) -> f (g a) -> f (Sum fs a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g (f a) -> f (g a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA g (f a)
a)
  {-# INLINABLE sequenceA #-}


instance Apply Eq1 fs => Eq1 (Sum fs) where
  liftEq :: (a -> b -> Bool) -> Sum fs a -> Sum fs b -> Bool
liftEq a -> b -> Bool
eq Sum fs a
u1 Sum fs b
u2 = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False ((forall (g :: * -> *). Eq1 g => g a -> g b -> Bool)
-> Sum fs a -> Sum fs b -> Maybe Bool
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b d.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> g b -> d)
-> Sum fs a -> Sum fs b -> Maybe d
apply2 @Eq1 ((a -> b -> Bool) -> g a -> g b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq) Sum fs a
u1 Sum fs b
u2)
  {-# INLINABLE liftEq #-}

instance (Apply Eq1 fs, Eq a) => Eq (Sum fs a) where
  == :: Sum fs a -> Sum fs a -> Bool
(==) = Sum fs a -> Sum fs a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
  {-# INLINABLE (==) #-}


instance (Apply Eq1 fs, Apply Ord1 fs) => Ord1 (Sum fs) where
  liftCompare :: (a -> b -> Ordering) -> Sum fs a -> Sum fs b -> Ordering
liftCompare a -> b -> Ordering
compareA u1 :: Sum fs a
u1@(Sum Int
n1 t a
_) u2 :: Sum fs b
u2@(Sum Int
n2 t b
_) = Ordering -> Maybe Ordering -> Ordering
forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n1 Int
n2) ((forall (g :: * -> *). Ord1 g => g a -> g b -> Ordering)
-> Sum fs a -> Sum fs b -> Maybe Ordering
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b d.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> g b -> d)
-> Sum fs a -> Sum fs b -> Maybe d
apply2 @Ord1 ((a -> b -> Ordering) -> g a -> g b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
compareA) Sum fs a
u1 Sum fs b
u2)
  {-# INLINABLE liftCompare #-}

instance (Apply Eq1 fs, Apply Ord1 fs, Ord a) => Ord (Sum fs a) where
  compare :: Sum fs a -> Sum fs a -> Ordering
compare = Sum fs a -> Sum fs a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
  {-# INLINABLE compare #-}


instance Apply Show1 fs => Show1 (Sum fs) where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Sum fs a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d = (forall (g :: * -> *). Show1 g => g a -> ShowS)
-> Sum fs a -> ShowS
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
apply @Show1 ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d)
  {-# INLINABLE liftShowsPrec #-}

instance (Apply Show1 fs, Show a) => Show (Sum fs a) where
  showsPrec :: Int -> Sum fs a -> ShowS
showsPrec = Int -> Sum fs a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1
  {-# INLINABLE showsPrec #-}


instance (Apply Eq1 fs, Apply Hashable1 fs) => Hashable1 (Sum fs) where
  liftHashWithSalt :: (Int -> a -> Int) -> Int -> Sum fs a -> Int
liftHashWithSalt Int -> a -> Int
hashWithSalt' Int
salt u :: Sum fs a
u@(Sum Int
n t a
_) = Int
salt Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (forall (g :: * -> *). Hashable1 g => g a -> Int)
-> Sum fs a -> Int
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
apply @Hashable1 ((Int -> a -> Int) -> Int -> g a -> Int
forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt Int -> a -> Int
hashWithSalt' Int
n) Sum fs a
u
  {-# INLINABLE liftHashWithSalt #-}

instance (Apply Eq1 fs, Apply Hashable1 fs, Hashable a) => Hashable (Sum fs a) where
  hashWithSalt :: Int -> Sum fs a -> Int
hashWithSalt = Int -> Sum fs a -> Int
forall (f :: * -> *) a.
(Hashable1 f, Hashable a) =>
Int -> f a -> Int
hashWithSalt1
  {-# INLINABLE hashWithSalt #-}

instance Apply NFData1 fs => NFData1 (Sum fs) where
  liftRnf :: (a -> ()) -> Sum fs a -> ()
liftRnf a -> ()
rnf' u :: Sum fs a
u@(Sum Int
n t a
_) = (forall (g :: * -> *). NFData1 g => g a -> ()) -> Sum fs a -> ()
forall (c :: (* -> *) -> Constraint) (fs :: [* -> *]) a b.
Apply c fs =>
(forall (g :: * -> *). c g => g a -> b) -> Sum fs a -> b
apply @NFData1 ((a -> ()) -> g a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
rnf') Sum fs a
u
  {-# INLINABLE liftRnf #-}

instance (Apply NFData1 fs, NFData a) => NFData (Sum fs a) where
  rnf :: Sum fs a -> ()
rnf u :: Sum fs a
u@(Sum Int
n t a
_) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
n () -> () -> ()
`seq` (a -> ()) -> Sum fs a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
forall a. NFData a => a -> ()
rnf Sum fs a
u
  {-# INLINABLE rnf #-}