{-# LANGUAGE Unsafe #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -Wno-unsafe #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}

module GHC.Generics.CoerceTo
(GenericCoerceTo(..))
where

import Prelude ((.), ($))

import GHC.Generics (Generic(Rep))
import GHC.Generics.Coerce (GenericCoerce())

import GHC.Generics qualified as Generics
import GHC.Generics.Coerce qualified as GenericCoerce

import Data.Kind (Type)

import Data.List qualified as List
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty

import Data.Semigroup (Semigroup ((<>), sconcat))
import Data.Monoid (Monoid (mempty, mconcat))

type role GenericCoerceTo representational phantom

type GenericCoerceTo :: Type -> Type -> Type

newtype GenericCoerceTo self other = GenericCoerceTo { get :: self }


toOther :: (Generic b, Generic a, GenericCoerce (Rep a) (Rep b)) => GenericCoerceTo a b -> b
toOther = Generics.to . GenericCoerce.gfrom . Generics.from . get

fromOther :: (Generic a, Generic b, GenericCoerce (Rep a) (Rep b)) => b -> GenericCoerceTo a b
fromOther = GenericCoerceTo . Generics.to . GenericCoerce.gto . Generics.from


instance 
  (Generic this
  , Generic other
  , GenericCoerce (Rep this) (Rep other)
  , Semigroup other) 
  => Semigroup (GenericCoerceTo this other) where

  (<>) :: GenericCoerceTo this other -> GenericCoerceTo this other -> GenericCoerceTo this other
  lhs <> rhs = fromOther $ toOther lhs <> toOther rhs

  sconcat :: NonEmpty (GenericCoerceTo this other) -> GenericCoerceTo this other
  sconcat = fromOther . sconcat . NonEmpty.map toOther

instance
  (Generic this
  , Generic other
  , GenericCoerce (Rep this) (Rep other)
  , Monoid other)
  => Monoid (GenericCoerceTo this other) where

  mempty :: GenericCoerceTo this other
  mempty = fromOther mempty

  mconcat :: [GenericCoerceTo this other] -> GenericCoerceTo this other
  mconcat = fromOther . mconcat . List.map toOther