{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}
module Generics.Deriving.Copoint (
GCopoint(..)
, gcopointdefault
, 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
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
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 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