{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

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

)
where

import Data.DerivingVia
import Data.Proxy
import GHC.Generics
import NoThunks.Class

-- | Copied from the "NoThunks.Class" default method definitions
instance
  (Generic a, GShowTypeOf (Rep a), GWNoThunks '[] (Rep a)) =>
  NoThunks (InstantiatedAt Generic a)
  where
  wNoThunks :: Context -> InstantiatedAt Generic a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctxt (InstantiatedAt a
x) =
    forall (a :: [Symbol]) (f :: * -> *) (proxy :: [Symbol] -> *) x.
GWNoThunks a f =>
proxy a -> Context -> f x -> IO (Maybe ThunkInfo)
gwNoThunks (forall {k} (t :: k). Proxy t
Proxy @'[]) Context
ctxt forall {x}. Rep a x
fp
    where
      !fp :: Rep a x
fp = forall a x. Generic a => a -> Rep a x
from a
x

  showTypeOf :: Proxy (InstantiatedAt Generic a) -> String
showTypeOf Proxy (InstantiatedAt Generic a)
_ = forall (f :: * -> *) x. GShowTypeOf f => f x -> String
gShowTypeOf (forall a x. Generic a => a -> Rep a x
from (forall a. HasCallStack => a
undefined :: a))

-- Copied from the "NoThunks.Class"
class GShowTypeOf f where gShowTypeOf :: f x -> String
instance Datatype c => GShowTypeOf (D1 c f) where gShowTypeOf :: forall x. D1 c f x -> String
gShowTypeOf = forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName