{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | "GHC.Generics" definition of 'rnf'
module Data.DerivingVia.DeepSeq (

)
where

import Control.DeepSeq
import Data.DerivingVia
import GHC.Generics

instance
  (Generic a, GNFData (Rep a)) =>
  NFData (InstantiatedAt Generic a)
  where
  rnf :: InstantiatedAt Generic a -> ()
rnf (InstantiatedAt a
x) = forall (rep :: * -> *) x. GNFData rep => rep x -> ()
grnf (forall a x. Generic a => a -> Rep a x
from a
x)

class GNFData rep where
  grnf :: rep x -> ()

instance NFData c => GNFData (K1 i c) where
  grnf :: forall x. K1 i c x -> ()
grnf (K1 c
a) = forall a. NFData a => a -> ()
rnf c
a

instance GNFData f => GNFData (M1 i c f) where
  grnf :: forall x. M1 i c f x -> ()
grnf (M1 f x
a) = forall (rep :: * -> *) x. GNFData rep => rep x -> ()
grnf f x
a

instance GNFData V1 where
  grnf :: forall x. V1 x -> ()
grnf = \case {}

instance GNFData U1 where
  grnf :: forall x. U1 x -> ()
grnf U1 x
U1 = ()

instance (GNFData l, GNFData r) => GNFData (l :*: r) where
  grnf :: forall x. (:*:) l r x -> ()
grnf (l x
l :*: r x
r) = forall (rep :: * -> *) x. GNFData rep => rep x -> ()
grnf l x
l seq :: forall a b. a -> b -> b
`seq` forall (rep :: * -> *) x. GNFData rep => rep x -> ()
grnf r x
r

instance (GNFData l, GNFData r) => GNFData (l :+: r) where
  grnf :: forall x. (:+:) l r x -> ()
grnf = \case
    L1 l x
l -> forall (rep :: * -> *) x. GNFData rep => rep x -> ()
grnf l x
l
    R1 r x
r -> forall (rep :: * -> *) x. GNFData rep => rep x -> ()
grnf r x
r