{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeOperators #-}
module Data.PartialSemigroup.Generics
(
genericPartialSemigroupOp
, PartialSemigroupRep (..)
, Generic
, PartialSemigroup (..)
) where
import Data.PartialSemigroup
import Control.Applicative ((<$>), (<*>))
import Data.Maybe (Maybe (..))
import GHC.Generics ((:*:) (..), (:+:) (..), Generic, K1 (..), M1 (..),
Rep, from, to)
genericPartialSemigroupOp :: (Generic a, PartialSemigroupRep (Rep a))
=> a -> a -> Maybe a
genericPartialSemigroupOp :: a -> a -> Maybe a
genericPartialSemigroupOp a
x a
y =
Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Maybe (Rep a Any) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rep a Any -> Rep a Any -> Maybe (Rep a Any)
forall (rep :: * -> *) a.
PartialSemigroupRep rep =>
rep a -> rep a -> Maybe (rep a)
repPartialSemigroupOp (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
x) (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
y)
class PartialSemigroupRep rep
where
repPartialSemigroupOp :: rep a -> rep a -> Maybe (rep a)
instance PartialSemigroup a => PartialSemigroupRep (K1 i a)
where
repPartialSemigroupOp :: K1 i a a -> K1 i a a -> Maybe (K1 i a a)
repPartialSemigroupOp (K1 a
x) (K1 a
y) = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> Maybe a -> Maybe (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a
x a -> a -> Maybe a
forall a. PartialSemigroup a => a -> a -> Maybe a
<>? a
y)
instance PartialSemigroupRep rep => PartialSemigroupRep (M1 i meta rep)
where
repPartialSemigroupOp :: M1 i meta rep a -> M1 i meta rep a -> Maybe (M1 i meta rep a)
repPartialSemigroupOp (M1 rep a
x) (M1 rep a
y) = rep a -> M1 i meta rep a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (rep a -> M1 i meta rep a)
-> Maybe (rep a) -> Maybe (M1 i meta rep a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> rep a -> rep a -> Maybe (rep a)
forall (rep :: * -> *) a.
PartialSemigroupRep rep =>
rep a -> rep a -> Maybe (rep a)
repPartialSemigroupOp rep a
x rep a
y
instance (PartialSemigroupRep rep1, PartialSemigroupRep rep2) =>
PartialSemigroupRep (rep1 :*: rep2)
where
repPartialSemigroupOp :: (:*:) rep1 rep2 a -> (:*:) rep1 rep2 a -> Maybe ((:*:) rep1 rep2 a)
repPartialSemigroupOp (rep1 a
x1 :*: rep2 a
x2) (rep1 a
y1 :*: rep2 a
y2) =
rep1 a -> rep2 a -> (:*:) rep1 rep2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (rep1 a -> rep2 a -> (:*:) rep1 rep2 a)
-> Maybe (rep1 a) -> Maybe (rep2 a -> (:*:) rep1 rep2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> rep1 a -> rep1 a -> Maybe (rep1 a)
forall (rep :: * -> *) a.
PartialSemigroupRep rep =>
rep a -> rep a -> Maybe (rep a)
repPartialSemigroupOp rep1 a
x1 rep1 a
y1
Maybe (rep2 a -> (:*:) rep1 rep2 a)
-> Maybe (rep2 a) -> Maybe ((:*:) rep1 rep2 a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> rep2 a -> rep2 a -> Maybe (rep2 a)
forall (rep :: * -> *) a.
PartialSemigroupRep rep =>
rep a -> rep a -> Maybe (rep a)
repPartialSemigroupOp rep2 a
x2 rep2 a
y2
instance (PartialSemigroupRep rep1, PartialSemigroupRep rep2) =>
PartialSemigroupRep (rep1 :+: rep2)
where
repPartialSemigroupOp :: (:+:) rep1 rep2 a -> (:+:) rep1 rep2 a -> Maybe ((:+:) rep1 rep2 a)
repPartialSemigroupOp (L1 rep1 a
x) (L1 rep1 a
y) = rep1 a -> (:+:) rep1 rep2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (rep1 a -> (:+:) rep1 rep2 a)
-> Maybe (rep1 a) -> Maybe ((:+:) rep1 rep2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> rep1 a -> rep1 a -> Maybe (rep1 a)
forall (rep :: * -> *) a.
PartialSemigroupRep rep =>
rep a -> rep a -> Maybe (rep a)
repPartialSemigroupOp rep1 a
x rep1 a
y
repPartialSemigroupOp (R1 rep2 a
x) (R1 rep2 a
y) = rep2 a -> (:+:) rep1 rep2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (rep2 a -> (:+:) rep1 rep2 a)
-> Maybe (rep2 a) -> Maybe ((:+:) rep1 rep2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> rep2 a -> rep2 a -> Maybe (rep2 a)
forall (rep :: * -> *) a.
PartialSemigroupRep rep =>
rep a -> rep a -> Maybe (rep a)
repPartialSemigroupOp rep2 a
x rep2 a
y
repPartialSemigroupOp (:+:) rep1 rep2 a
_ (:+:) rep1 rep2 a
_ = Maybe ((:+:) rep1 rep2 a)
forall a. Maybe a
Nothing