{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Newtype wrappers for us in @deriving via@ clauses that " should " have
-- been defined in @base@ and other packages we depend on but do not control
--
-- We expected variations of these to eventually be defined upstream, but we'd
-- like to use these concepts before that happens.
module Data.DerivingVia (
  InstantiatedAt (..),
)
where

import Data.Kind (Constraint, Type)
import GHC.Generics

import Data.DerivingVia.GHC.Generics.Monoid
import Data.DerivingVia.GHC.Generics.Semigroup

infix 0 `InstantiatedAt`

-- | A hook that represents a @deriving via@ scheme via some class constraint
--
-- The most notable example is 'GHC.Generics.Generic'.
--
-- > data T = ...
-- >   deriving (Monoid, Semigroup)
-- >        via InstantiatedAt Generic T
--
-- This type's parameterization is useful because many such schemes are
-- similarly identified by a single type class, such as 'Ord'.
newtype InstantiatedAt (c :: Type -> Constraint) a = InstantiatedAt a
  deriving newtype (InstantiatedAt c a -> InstantiatedAt c a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (c :: * -> Constraint) a.
Eq a =>
InstantiatedAt c a -> InstantiatedAt c a -> Bool
/= :: InstantiatedAt c a -> InstantiatedAt c a -> Bool
$c/= :: forall (c :: * -> Constraint) a.
Eq a =>
InstantiatedAt c a -> InstantiatedAt c a -> Bool
== :: InstantiatedAt c a -> InstantiatedAt c a -> Bool
$c== :: forall (c :: * -> Constraint) a.
Eq a =>
InstantiatedAt c a -> InstantiatedAt c a -> Bool
Eq, InstantiatedAt c a -> InstantiatedAt c a -> Bool
InstantiatedAt c a -> InstantiatedAt c a -> Ordering
InstantiatedAt c a -> InstantiatedAt c a -> InstantiatedAt c a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {c :: * -> Constraint} {a}. Ord a => Eq (InstantiatedAt c a)
forall (c :: * -> Constraint) a.
Ord a =>
InstantiatedAt c a -> InstantiatedAt c a -> Bool
forall (c :: * -> Constraint) a.
Ord a =>
InstantiatedAt c a -> InstantiatedAt c a -> Ordering
forall (c :: * -> Constraint) a.
Ord a =>
InstantiatedAt c a -> InstantiatedAt c a -> InstantiatedAt c a
min :: InstantiatedAt c a -> InstantiatedAt c a -> InstantiatedAt c a
$cmin :: forall (c :: * -> Constraint) a.
Ord a =>
InstantiatedAt c a -> InstantiatedAt c a -> InstantiatedAt c a
max :: InstantiatedAt c a -> InstantiatedAt c a -> InstantiatedAt c a
$cmax :: forall (c :: * -> Constraint) a.
Ord a =>
InstantiatedAt c a -> InstantiatedAt c a -> InstantiatedAt c a
>= :: InstantiatedAt c a -> InstantiatedAt c a -> Bool
$c>= :: forall (c :: * -> Constraint) a.
Ord a =>
InstantiatedAt c a -> InstantiatedAt c a -> Bool
> :: InstantiatedAt c a -> InstantiatedAt c a -> Bool
$c> :: forall (c :: * -> Constraint) a.
Ord a =>
InstantiatedAt c a -> InstantiatedAt c a -> Bool
<= :: InstantiatedAt c a -> InstantiatedAt c a -> Bool
$c<= :: forall (c :: * -> Constraint) a.
Ord a =>
InstantiatedAt c a -> InstantiatedAt c a -> Bool
< :: InstantiatedAt c a -> InstantiatedAt c a -> Bool
$c< :: forall (c :: * -> Constraint) a.
Ord a =>
InstantiatedAt c a -> InstantiatedAt c a -> Bool
compare :: InstantiatedAt c a -> InstantiatedAt c a -> Ordering
$ccompare :: forall (c :: * -> Constraint) a.
Ord a =>
InstantiatedAt c a -> InstantiatedAt c a -> Ordering
Ord, Int -> InstantiatedAt c a -> ShowS
[InstantiatedAt c a] -> ShowS
InstantiatedAt c a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (c :: * -> Constraint) a.
Show a =>
Int -> InstantiatedAt c a -> ShowS
forall (c :: * -> Constraint) a.
Show a =>
[InstantiatedAt c a] -> ShowS
forall (c :: * -> Constraint) a.
Show a =>
InstantiatedAt c a -> String
showList :: [InstantiatedAt c a] -> ShowS
$cshowList :: forall (c :: * -> Constraint) a.
Show a =>
[InstantiatedAt c a] -> ShowS
show :: InstantiatedAt c a -> String
$cshow :: forall (c :: * -> Constraint) a.
Show a =>
InstantiatedAt c a -> String
showsPrec :: Int -> InstantiatedAt c a -> ShowS
$cshowsPrec :: forall (c :: * -> Constraint) a.
Show a =>
Int -> InstantiatedAt c a -> ShowS
Show)

instance
  (Generic a, GSemigroup (Rep a)) =>
  Semigroup (InstantiatedAt Generic a)
  where
  InstantiatedAt a
l <> :: InstantiatedAt Generic a
-> InstantiatedAt Generic a -> InstantiatedAt Generic a
<> InstantiatedAt a
r =
    forall (c :: * -> Constraint) a. a -> InstantiatedAt c a
InstantiatedAt forall a b. (a -> b) -> a -> b
$ forall a x. Generic a => Rep a x -> a
to forall a b. (a -> b) -> a -> b
$ forall (rep :: * -> *) x. GSemigroup rep => rep x -> rep x -> rep x
gsappend (forall a x. Generic a => a -> Rep a x
from a
l) (forall a x. Generic a => a -> Rep a x
from a
r)

instance
  (Generic a, GSemigroup (Rep a), GMonoid (Rep a)) =>
  Monoid (InstantiatedAt Generic a)
  where
  mempty :: InstantiatedAt Generic a
mempty = forall (c :: * -> Constraint) a. a -> InstantiatedAt c a
InstantiatedAt forall a b. (a -> b) -> a -> b
$ forall a x. Generic a => Rep a x -> a
to forall (rep :: * -> *) x. GMonoid rep => rep x
gmempty