    {-# LANGUAGE DefaultSignatures #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE Safe #-}
    {-# LANGUAGE TypeOperators #-}

    module Generics.Deriving.Copoint (
      -- * GCopoint class
        GCopoint(..)

      -- * Default method
      , gcopointdefault

      -- * Internal class
      , GCopoint'(..)

      ) where

    import           Control.Applicative (WrappedMonad)

    import           Data.Functor.Identity (Identity)
    import qualified Data.Functor.Sum as Functor (Sum)
    import           Data.Monoid (Alt, Dual)
    import qualified Data.Monoid as Monoid (Sum)
    import           Data.Ord (Down)
    import           Data.Semigroup (Arg, First, Last, Max, Min, WrappedMonoid)

    import           Generics.Deriving.Base

    --------------------------------------------------------------------------------
    -- Generic copoint
    --------------------------------------------------------------------------------

    -- General copoint may return 'Nothing'

    class GCopoint' t where
        gcopoint' :: t a -> Maybe a

    instance GCopoint' V1 where
        gcopoint' :: forall a. V1 a -> Maybe a
    gcopoint' V1 a
    _ = Maybe a
    forall a. Maybe a
    Nothing

    instance GCopoint' U1 where
        gcopoint' :: forall a. U1 a -> Maybe a
    gcopoint' U1 a
    U1 = Maybe a
    forall a. Maybe a
    Nothing

    instance GCopoint' Par1 where
        gcopoint' :: forall a. Par1 a -> Maybe a
    gcopoint' (Par1 a
    a) = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a

    instance GCopoint' (K1 i c) where
        gcopoint' :: forall a. K1 i c a -> Maybe a
    gcopoint' K1 i c a
    _ = Maybe a
    forall a. Maybe a
    Nothing

    instance GCopoint' f => GCopoint' (M1 i c f) where
        gcopoint' :: forall a. M1 i c f a -> Maybe a
    gcopoint' (M1 f a
    a) = f a -> Maybe a
    forall a. f a -> Maybe a
    forall (t :: * -> *) a. GCopoint' t => t a -> Maybe a
    gcopoint' f a
    a

    instance (GCopoint' f, GCopoint' g) => GCopoint' (f :+: g) where
        gcopoint' :: forall a. (:+:) f g a -> Maybe a
    gcopoint' (L1 f a
    a) = f a -> Maybe a
    forall a. f a -> Maybe a
    forall (t :: * -> *) a. GCopoint' t => t a -> Maybe a
    gcopoint' f a
    a
        gcopoint' (R1 g a
    a) = g a -> Maybe a
    forall a. g a -> Maybe a
    forall (t :: * -> *) a. GCopoint' t => t a -> Maybe a
    gcopoint' g a
    a

    -- Favours left "hole" for copoint
    instance (GCopoint' f, GCopoint' g) => GCopoint' (f :*: g) where
        gcopoint' :: forall a. (:*:) f g a -> Maybe a
    gcopoint' (f a
    a :*: g a
    b) = case (f a -> Maybe a
    forall a. f a -> Maybe a
    forall (t :: * -> *) a. GCopoint' t => t a -> Maybe a
    gcopoint' f a
    a) of
                                Just a
    x -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x
                                Maybe a
    Nothing -> g a -> Maybe a
    forall a. g a -> Maybe a
    forall (t :: * -> *) a. GCopoint' t => t a -> Maybe a
    gcopoint' g a
    b

    instance (GCopoint f) => GCopoint' (Rec1 f) where
        gcopoint' :: forall a. Rec1 f a -> Maybe a
    gcopoint' (Rec1 f a
    a) = a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ f a -> a
    forall a. f a -> a
    forall (d :: * -> *) a. GCopoint d => d a -> a
    gcopoint f a
    a

    instance (GCopoint f, GCopoint' g) => GCopoint' (f :.: g) where
        gcopoint' :: forall a. (:.:) f g a -> Maybe a
    gcopoint' (Comp1 f (g a)
    x) = g a -> Maybe a
    forall a. g a -> Maybe a
    forall (t :: * -> *) a. GCopoint' t => t a -> Maybe a
    gcopoint' (g a -> Maybe a) -> (f (g a) -> g a) -> f (g a) -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f (g a) -> g a
    forall a. f a -> a
    forall (d :: * -> *) a. GCopoint d => d a -> a
    gcopoint (f (g a) -> Maybe a) -> f (g a) -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ f (g a)
    x

    class GCopoint d where
      gcopoint :: d a -> a
      default gcopoint :: (Generic1 d, GCopoint' (Rep1 d))
                       => (d a -> a)
      gcopoint = d a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    gcopointdefault :: (Generic1 d, GCopoint' (Rep1 d))
                    => d a -> a
    gcopointdefault :: forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault d a
    x = case (Rep1 d a -> Maybe a
    forall a. Rep1 d a -> Maybe a
    forall (t :: * -> *) a. GCopoint' t => t a -> Maybe a
    gcopoint' (Rep1 d a -> Maybe a) -> (d a -> Rep1 d a) -> d a -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . d a -> Rep1 d a
    forall a. d a -> Rep1 d a
    forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
    from1 (d a -> Maybe a) -> d a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ d a
    x) of
                          Just a
    x' -> a
    x'
                          Maybe a
    Nothing -> [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Data type is not copointed"

    -- instance (Generic1 d, GCopoint' (Rep1 d)) => GCopoint d

    -- Base types instances
    instance GCopoint ((,) a) where
      gcopoint :: forall a. (a, a) -> a
    gcopoint = (a, a) -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint ((,,) a b) where
      gcopoint :: forall a. (a, b, a) -> a
    gcopoint = (a, b, a) -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint ((,,,) a b c) where
      gcopoint :: forall a. (a, b, c, a) -> a
    gcopoint = (a, b, c, a) -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint ((,,,,) a b c d) where
      gcopoint :: forall a. (a, b, c, d, a) -> a
    gcopoint = (a, b, c, d, a) -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint ((,,,,,) a b c d e) where
      gcopoint :: forall a. (a, b, c, d, e, a) -> a
    gcopoint = (a, b, c, d, e, a) -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint ((,,,,,,) a b c d e f) where
      gcopoint :: forall a. (a, b, c, d, e, f, a) -> a
    gcopoint = (a, b, c, d, e, f, a) -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint f => GCopoint (Alt f) where
      gcopoint :: forall a. Alt f a -> a
    gcopoint = Alt f a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint (Arg a) where
      gcopoint :: forall a. Arg a a -> a
    gcopoint = Arg a a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint Down where
      gcopoint :: forall a. Down a -> a
    gcopoint = Down a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint Dual where
      gcopoint :: forall a. Dual a -> a
    gcopoint = Dual a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint First where
      gcopoint :: forall a. First a -> a
    gcopoint = First a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint Identity where
      gcopoint :: forall a. Identity a -> a
    gcopoint = Identity a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint Last where
      gcopoint :: forall a. Last a -> a
    gcopoint = Last a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint Max where
      gcopoint :: forall a. Max a -> a
    gcopoint = Max a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint Min where
      gcopoint :: forall a. Min a -> a
    gcopoint = Min a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance (GCopoint f, GCopoint g) => GCopoint (Functor.Sum f g) where
      gcopoint :: forall a. Sum f g a -> a
    gcopoint = Sum f g a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint Monoid.Sum where
      gcopoint :: forall a. Sum a -> a
    gcopoint = Sum a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint m => GCopoint (WrappedMonad m) where
      gcopoint :: forall a. WrappedMonad m a -> a
    gcopoint = WrappedMonad m a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault

    instance GCopoint WrappedMonoid where
      gcopoint :: forall a. WrappedMonoid a -> a
    gcopoint = WrappedMonoid a -> a
    forall (d :: * -> *) a.
    (Generic1 d, GCopoint' (Rep1 d)) =>
    d a -> a
    gcopointdefault