{-# 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
(InstantiatedAt c a -> InstantiatedAt c a -> Bool)
-> (InstantiatedAt c a -> InstantiatedAt c a -> Bool)
-> Eq (InstantiatedAt c a)
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, Eq (InstantiatedAt c a)
Eq (InstantiatedAt c a)
-> (InstantiatedAt c a -> InstantiatedAt c a -> Ordering)
-> (InstantiatedAt c a -> InstantiatedAt c a -> Bool)
-> (InstantiatedAt c a -> InstantiatedAt c a -> Bool)
-> (InstantiatedAt c a -> InstantiatedAt c a -> Bool)
-> (InstantiatedAt c a -> InstantiatedAt c a -> Bool)
-> (InstantiatedAt c a -> InstantiatedAt c a -> InstantiatedAt c a)
-> (InstantiatedAt c a -> InstantiatedAt c a -> InstantiatedAt c a)
-> Ord (InstantiatedAt c a)
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
$cp1Ord :: forall (c :: * -> Constraint) a. Ord a => Eq (InstantiatedAt c a)
Ord, Int -> InstantiatedAt c a -> ShowS
[InstantiatedAt c a] -> ShowS
InstantiatedAt c a -> String
(Int -> InstantiatedAt c a -> ShowS)
-> (InstantiatedAt c a -> String)
-> ([InstantiatedAt c a] -> ShowS)
-> Show (InstantiatedAt c a)
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 =
    a -> InstantiatedAt Generic a
forall (c :: * -> Constraint) a. a -> InstantiatedAt c a
InstantiatedAt (a -> InstantiatedAt Generic a) -> a -> InstantiatedAt Generic a
forall a b. (a -> b) -> a -> b
$ Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Rep a Any -> a
forall a b. (a -> b) -> a -> b
$ Rep a Any -> Rep a Any -> Rep a Any
forall (rep :: * -> *) x. GSemigroup rep => rep x -> rep x -> rep x
gsappend (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
l) (a -> Rep a Any
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 = a -> InstantiatedAt Generic a
forall (c :: * -> Constraint) a. a -> InstantiatedAt c a
InstantiatedAt (a -> InstantiatedAt Generic a) -> a -> InstantiatedAt Generic a
forall a b. (a -> b) -> a -> b
$ Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to Rep a Any
forall (rep :: * -> *) x. GMonoid rep => rep x
gmempty