{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# language ConstraintKinds #-}
{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language FunctionalDependencies #-}
{-# language MultiParamTypeClasses #-}
{-# language ScopedTypeVariables #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}

module Data.Generics.Internal.Wrapped
  ( Context
  , derived
  ) where

import Data.Generics.Internal.Profunctor.Iso

import Data.Generics.Internal.Families.Changing ( UnifyHead )

import Data.Kind (Constraint)
import GHC.Generics
import GHC.TypeLits

type Context s t a b
  = ( Generic s
    , Generic t
    , GWrapped (Rep s) (Rep t) a b
    , UnifyHead s t
    , UnifyHead t s
    , ErrorUnlessOnlyOne s (Rep s)
    )

derived :: Context s t a b => Iso s t a b
derived :: Iso s t a b
derived = p i (Rep s Any) (Rep t Any) -> p i s t
forall a b x. (Generic a, Generic b) => Iso a b (Rep a x) (Rep b x)
repIso (p i (Rep s Any) (Rep t Any) -> p i s t)
-> (p i a b -> p i (Rep s Any) (Rep t Any)) -> p i a b -> p i s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a b -> p i (Rep s Any) (Rep t Any)
forall (s :: * -> *) (t :: * -> *) a b x.
GWrapped s t a b =>
Iso (s x) (t x) a b
gWrapped
{-# INLINE derived #-}

type family ErrorUnlessOnlyOne a b :: Constraint where
  ErrorUnlessOnlyOne t (M1 i k a) = ErrorUnlessOnlyOne t a
  ErrorUnlessOnlyOne t (K1 i a) = ()
  ErrorUnlessOnlyOne t a =
    TypeError ('ShowType t ':<>: 'Text " is not a single-constructor, single-field datatype")

--------------------------------------------------------------------------------

class GWrapped s t a b | s -> a, t -> b, s b -> t, t a -> s where
  gWrapped :: Iso (s x) (t x) a b

instance GWrapped s t a b => GWrapped (M1 i k s) (M1 i k t) a b where
  gWrapped :: p i a b -> p i (M1 i k s x) (M1 i k t x)
gWrapped = p i (s x) (t x) -> p i (M1 i k s x) (M1 i k t x)
forall i (c :: Meta) (f :: * -> *) p (g :: * -> *).
Iso (M1 i c f p) (M1 i c g p) (f p) (g p)
mIso (p i (s x) (t x) -> p i (M1 i k s x) (M1 i k t x))
-> (p i a b -> p i (s x) (t x))
-> p i a b
-> p i (M1 i k s x) (M1 i k t x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a b -> p i (s x) (t x)
forall (s :: * -> *) (t :: * -> *) a b x.
GWrapped s t a b =>
Iso (s x) (t x) a b
gWrapped

instance (a ~ c, b ~ d) => GWrapped (K1 i a) (K1 i b) c d where
  gWrapped :: p i c d -> p i (K1 i a x) (K1 i b x)
gWrapped = p i c d -> p i (K1 i a x) (K1 i b x)
forall r a p b. Iso (K1 r a p) (K1 r b p) a b
kIso