{-# LANGUAGE UndecidableInstances #-} -- due to typeclass design
{-# LANGUAGE AllowAmbiguousTypes #-}  -- due to typeclass design

module Generic.Data.Function.Contra.Sum where

import GHC.Generics
import Generic.Data.Function.Util.Generic ( conName' )
import Generic.Data.Function.Contra.Constructor
  ( GContraC(gContraC)
  , GenericContra(type GenericContraF)
  )
import Generic.Data.Rep.Error
import Generic.Data.Function.Common

import Data.Functor.Contravariant.Divisible
import Data.Functor.Contravariant

class GContraSum tag (opts :: SumOpts) gf where
    gContraSum :: GenericContraF tag String -> GenericContraF tag (gf p)

instance (GContraSumD tag opts gf, Contravariant (GenericContraF tag))
  => GContraSum tag opts (D1 cd gf) where
    gContraSum :: forall (p :: k).
GenericContraF tag String -> GenericContraF tag (D1 cd gf p)
gContraSum GenericContraF tag String
f = (M1 D cd gf p -> gf p)
-> GenericContraF tag (gf p) -> GenericContraF tag (M1 D cd gf p)
forall a' a.
(a' -> a) -> GenericContraF tag a -> GenericContraF tag a'
forall (f :: Type -> Type) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap M1 D cd gf p -> gf p
forall k i (c :: Meta) (f :: k -> Type) (p :: k). M1 i c f p -> f p
unM1 (forall (tag :: k) (opts :: SumOpts) (gf :: k -> Type) (p :: k).
GContraSumD tag opts gf =>
GenericContraF tag String -> GenericContraF tag (gf p)
forall {k} {k} (tag :: k) (opts :: SumOpts) (gf :: k -> Type)
       (p :: k).
GContraSumD tag opts gf =>
GenericContraF tag String -> GenericContraF tag (gf p)
gContraSumD @tag @opts GenericContraF tag String
f)

class GContraSumD tag (opts :: SumOpts) gf where
    gContraSumD :: GenericContraF tag String -> GenericContraF tag (gf p)

instance GContraCSum tag (l :+: r) => GContraSumD tag opts (l :+: r) where
    gContraSumD :: forall (p :: k).
GenericContraF tag String -> GenericContraF tag ((:+:) l r p)
gContraSumD = forall (tag :: k) (gf :: k -> Type) (p :: k).
GContraCSum tag gf =>
GenericContraF tag String -> GenericContraF tag (gf p)
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GContraCSum tag gf =>
GenericContraF tag String -> GenericContraF tag (gf p)
gContraCSum @tag

instance GContraSumD tag 'SumOnly (C1 cc gf) where
    gContraSumD :: forall (p :: k).
GenericContraF tag String -> GenericContraF tag (C1 cc gf p)
gContraSumD = String
-> GenericContraF tag String -> GenericContraF tag (C1 cc gf p)
forall a. HasCallStack => String -> a
error String
eNeedSum

instance GContraCSum tag (C1 cc gf)
  => GContraSumD tag 'AllowSingletonSum (C1 cc gf) where
    gContraSumD :: forall (p :: k).
GenericContraF tag String -> GenericContraF tag (C1 cc gf p)
gContraSumD = forall (tag :: k) (gf :: k -> Type) (p :: k).
GContraCSum tag gf =>
GenericContraF tag String -> GenericContraF tag (gf p)
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GContraCSum tag gf =>
GenericContraF tag String -> GenericContraF tag (gf p)
gContraCSum @tag

instance GContraSumD tag opts V1 where
    gContraSumD :: forall (p :: k).
GenericContraF tag String -> GenericContraF tag (V1 p)
gContraSumD = String -> GenericContraF tag String -> GenericContraF tag (V1 p)
forall a. HasCallStack => String -> a
error String
eNoEmpty

-- TODO rename (? had this on foldmap sum)
class GContraCSum tag gf where
    gContraCSum :: GenericContraF tag String -> GenericContraF tag (gf p)

instance
  ( Decidable (GenericContraF tag)
  , GContraCSum tag l
  , GContraCSum tag r
  ) => GContraCSum tag (l :+: r) where
    gContraCSum :: forall (p :: k).
GenericContraF tag String -> GenericContraF tag ((:+:) l r p)
gContraCSum GenericContraF tag String
f = ((:+:) l r p -> Either (l p) (r p))
-> GenericContraF tag (l p)
-> GenericContraF tag (r p)
-> GenericContraF tag ((:+:) l r p)
forall a b c.
(a -> Either b c)
-> GenericContraF tag b
-> GenericContraF tag c
-> GenericContraF tag a
forall (f :: Type -> Type) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose (:+:) l r p -> Either (l p) (r p)
forall {k} {f :: k -> Type} {g :: k -> Type} {p :: k}.
(:+:) f g p -> Either (f p) (g p)
genericSumToEither (forall (tag :: k) (gf :: k -> Type) (p :: k).
GContraCSum tag gf =>
GenericContraF tag String -> GenericContraF tag (gf p)
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GContraCSum tag gf =>
GenericContraF tag String -> GenericContraF tag (gf p)
gContraCSum @tag GenericContraF tag String
f) (forall (tag :: k) (gf :: k -> Type) (p :: k).
GContraCSum tag gf =>
GenericContraF tag String -> GenericContraF tag (gf p)
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GContraCSum tag gf =>
GenericContraF tag String -> GenericContraF tag (gf p)
gContraCSum @tag GenericContraF tag String
f)
      where genericSumToEither :: (:+:) f g p -> Either (f p) (g p)
genericSumToEither = \case L1 f p
l -> f p -> Either (f p) (g p)
forall a b. a -> Either a b
Left f p
l; R1 g p
r -> g p -> Either (f p) (g p)
forall a b. b -> Either a b
Right g p
r

instance
  ( Divisible (GenericContraF tag)
  , GContraC tag gf, Constructor c
  ) => GContraCSum tag (C1 c gf) where
    gContraCSum :: forall (p :: k).
GenericContraF tag String -> GenericContraF tag (C1 c gf p)
gContraCSum GenericContraF tag String
f = (M1 C c gf p -> (String, gf p))
-> GenericContraF tag String
-> GenericContraF tag (gf p)
-> GenericContraF tag (M1 C c gf p)
forall a b c.
(a -> (b, c))
-> GenericContraF tag b
-> GenericContraF tag c
-> GenericContraF tag a
forall (f :: Type -> Type) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\(M1 gf p
g) -> (forall {k} (c :: k). Constructor c => String
forall (c :: Meta). Constructor c => String
conName' @c, gf p
g)) GenericContraF tag String
f (forall (tag :: k) (gf :: k -> Type) (p :: k).
GContraC tag gf =>
GenericContraF tag (gf p)
forall {k} {k1} (tag :: k) (gf :: k1 -> Type) (p :: k1).
GContraC tag gf =>
GenericContraF tag (gf p)
gContraC @tag)