    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE UndecidableSuperClasses #-}

    -- | Pack/unpack newtypes.
    --
    -- === Warning
    --
    -- This is an internal module: it is not subject to any versioning policy,
    -- breaking changes can happen at any time.
    --
    -- If something here seems useful, please report it or create a pull request to
    -- export it from an external module.

    module Generic.Data.Internal.Newtype where

    import Data.Coerce (Coercible, coerce)
    import Data.Kind (Constraint, Type)
    import GHC.Generics (Generic(..), D1, C1, S1, K1)
    import GHC.TypeLits (TypeError, ErrorMessage(..))

    import Generic.Data.Internal.Meta (MetaDataNewtype, MetaOf)

    -- | Class of newtypes. There is an instance @'Newtype' a@ if and only if @a@
    -- is a newtype and an instance of 'Generic'.
    class (Generic a, Coercible a (Old a), Newtype' a) => Newtype a
    instance (Generic a, Coercible a (Old a), Newtype' a) => Newtype a

    -- | The type wrapped by a newtype.
    --
    -- @
    -- newtype Foo = Foo { bar :: Bar } deriving 'Generic'
    -- -- Old Foo ~ Bar
    -- @
    type Old a = GOld (Rep a)

    type family GOld (f :: Type -> Type) where
      GOld (D1 _d (C1 _c (S1 _s (K1 _i b)))) = b

    -- | Use 'Newtype' instead.
    type Newtype' a = NewtypeErr a (MetaDataNewtype (MetaOf (Rep a)))

    type family NewtypeErr a (b :: Bool) :: Constraint where
      NewtypeErr a 'True = ()
      NewtypeErr a 'False = TypeError
        ('Text "The type " ':<>: 'ShowType a ':<>: 'Text " is not a newtype.")

    -- | Generic newtype destructor.
    unpack :: Newtype a => a -> Old a
    unpack :: forall a. Newtype a => a -> Old a
    unpack = a -> GOld (Rep a)
    forall a b. Coercible a b => a -> b
    coerce

    -- | Generic newtype constructor.
    pack :: Newtype a => Old a -> a
    pack :: forall a. Newtype a => Old a -> a
    pack = GOld (Rep a) -> a
    forall a b. Coercible a b => a -> b
    coerce