{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Variadic.Generic.Internal where
import Control.Variadic
import Data.Kind (Constraint)
import Data.Proxy (Proxy(Proxy))
import GHC.Generics
import GHC.TypeLits
ghoist
:: ( Generic (r f)
, Generic (r g)
, GHoist (Rep (r f)) (Rep (r g)) f g '["close"]
)
=> (forall x. f x -> g x)
-> r f
-> r g
ghoist :: (forall x. f x -> g x) -> r f -> r g
ghoist = Proxy '["close"] -> (forall x. f x -> g x) -> r f -> r g
forall (r :: (* -> *) -> *) (f :: * -> *) (g :: * -> *)
(ignored :: [Symbol]) (proxy :: [Symbol] -> *).
(Generic (r f), Generic (r g),
GHoist (Rep (r f)) (Rep (r g)) f g ignored) =>
proxy ignored -> (forall x. f x -> g x) -> r f -> r g
ghoist' (Proxy '["close"]
forall k (t :: k). Proxy t
Proxy @'["close"])
ghoist0
:: ( Generic (r f)
, Generic (r g)
, GHoist (Rep (r f)) (Rep (r g)) f g '[]
)
=> (forall x. f x -> g x)
-> r f
-> r g
ghoist0 :: (forall x. f x -> g x) -> r f -> r g
ghoist0 = Proxy '[] -> (forall x. f x -> g x) -> r f -> r g
forall (r :: (* -> *) -> *) (f :: * -> *) (g :: * -> *)
(ignored :: [Symbol]) (proxy :: [Symbol] -> *).
(Generic (r f), Generic (r g),
GHoist (Rep (r f)) (Rep (r g)) f g ignored) =>
proxy ignored -> (forall x. f x -> g x) -> r f -> r g
ghoist' (Proxy '[]
forall k (t :: k). Proxy t
Proxy @'[])
ghoist'
:: ( Generic (r f)
, Generic (r g)
, GHoist (Rep (r f)) (Rep (r g)) f g ignored
)
=> proxy ignored
-> (forall x. f x -> g x)
-> r f
-> r g
ghoist' :: proxy ignored -> (forall x. f x -> g x) -> r f -> r g
ghoist' proxy :: proxy ignored
proxy f :: forall x. f x -> g x
f = Rep (r g) Any -> r g
forall a x. Generic a => Rep a x -> a
to (Rep (r g) Any -> r g) -> (r f -> Rep (r g) Any) -> r f -> r g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy ignored
-> (forall x. f x -> g x) -> Rep (r f) Any -> Rep (r g) Any
forall (i :: * -> *) (o :: * -> *) (f :: * -> *) (g :: * -> *)
(ignored :: [Symbol]) (proxy :: [Symbol] -> *) p.
GHoist i o f g ignored =>
proxy ignored -> (forall x. f x -> g x) -> i p -> o p
gghoist proxy ignored
proxy forall x. f x -> g x
f (Rep (r f) Any -> Rep (r g) Any)
-> (r f -> Rep (r f) Any) -> r f -> Rep (r g) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r f -> Rep (r f) Any
forall a x. Generic a => a -> Rep a x
from
class GHoist (i :: * -> *) (o :: * -> *) (f :: * -> *) (g :: * -> *) (ignored :: [Symbol]) where
gghoist :: proxy ignored -> (forall x. f x -> g x) -> i p -> o p
instance (GHoist i o f g ignored) => GHoist (M1 D c i) (M1 D c o) f g ignored where
gghoist :: proxy ignored -> (forall x. f x -> g x) -> M1 D c i p -> M1 D c o p
gghoist proxy :: proxy ignored
proxy f :: forall x. f x -> g x
f (M1 i :: i p
i) = o p -> M1 D c o p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (proxy ignored -> (forall x. f x -> g x) -> i p -> o p
forall (i :: * -> *) (o :: * -> *) (f :: * -> *) (g :: * -> *)
(ignored :: [Symbol]) (proxy :: [Symbol] -> *) p.
GHoist i o f g ignored =>
proxy ignored -> (forall x. f x -> g x) -> i p -> o p
gghoist proxy ignored
proxy forall x. f x -> g x
f i p
i)
instance (GHoist i o f g ignored) => GHoist (M1 C c i) (M1 C c o) f g ignored where
gghoist :: proxy ignored -> (forall x. f x -> g x) -> M1 C c i p -> M1 C c o p
gghoist proxy :: proxy ignored
proxy f :: forall x. f x -> g x
f (M1 i :: i p
i) = o p -> M1 C c o p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (proxy ignored -> (forall x. f x -> g x) -> i p -> o p
forall (i :: * -> *) (o :: * -> *) (f :: * -> *) (g :: * -> *)
(ignored :: [Symbol]) (proxy :: [Symbol] -> *) p.
GHoist i o f g ignored =>
proxy ignored -> (forall x. f x -> g x) -> i p -> o p
gghoist proxy ignored
proxy forall x. f x -> g x
f i p
i)
instance {-# OVERLAPPING #-}
( VerifyIgnored n a ignored
) => GHoist
(M1 S ('MetaSel ('Just n) su ss ds) (K1 R a))
(M1 S ('MetaSel ('Just n) su ss ds) (K1 R a))
f g ignored
where
gghoist :: proxy ignored
-> (forall x. f x -> g x)
-> M1 S ('MetaSel ('Just n) su ss ds) (K1 R a) p
-> M1 S ('MetaSel ('Just n) su ss ds) (K1 R a) p
gghoist _proxy :: proxy ignored
_proxy _f :: forall x. f x -> g x
_f (M1 i :: K1 R a p
i) = K1 R a p -> M1 S ('MetaSel ('Just n) su ss ds) (K1 R a) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 K1 R a p
i
instance
( GHoist (K1 R i) (K1 R o) f g ignored
, VerifyNotIgnored n i ignored
) => GHoist
(M1 S ('MetaSel ('Just n) su ss ds) (K1 R i))
(M1 S ('MetaSel ('Just n) su ss ds) (K1 R o))
f g ignored
where
gghoist :: proxy ignored
-> (forall x. f x -> g x)
-> M1 S ('MetaSel ('Just n) su ss ds) (K1 R i) p
-> M1 S ('MetaSel ('Just n) su ss ds) (K1 R o) p
gghoist proxy :: proxy ignored
proxy f :: forall x. f x -> g x
f (M1 i :: K1 R i p
i) = K1 R o p -> M1 S ('MetaSel ('Just n) su ss ds) (K1 R o) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (proxy ignored -> (forall x. f x -> g x) -> K1 R i p -> K1 R o p
forall (i :: * -> *) (o :: * -> *) (f :: * -> *) (g :: * -> *)
(ignored :: [Symbol]) (proxy :: [Symbol] -> *) p.
GHoist i o f g ignored =>
proxy ignored -> (forall x. f x -> g x) -> i p -> o p
gghoist proxy ignored
proxy forall x. f x -> g x
f K1 R i p
i)
instance
( GHoist i1 o1 f g ignored
, GHoist i2 o2 f g ignored
) => GHoist (i1 :*: i2) (o1 :*: o2) f g ignored
where
gghoist :: proxy ignored
-> (forall x. f x -> g x) -> (:*:) i1 i2 p -> (:*:) o1 o2 p
gghoist proxy :: proxy ignored
proxy f :: forall x. f x -> g x
f (i1 :: i1 p
i1 :*: i2 :: i2 p
i2) = proxy ignored -> (forall x. f x -> g x) -> i1 p -> o1 p
forall (i :: * -> *) (o :: * -> *) (f :: * -> *) (g :: * -> *)
(ignored :: [Symbol]) (proxy :: [Symbol] -> *) p.
GHoist i o f g ignored =>
proxy ignored -> (forall x. f x -> g x) -> i p -> o p
gghoist proxy ignored
proxy forall x. f x -> g x
f i1 p
i1 o1 p -> o2 p -> (:*:) o1 o2 p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: proxy ignored -> (forall x. f x -> g x) -> i2 p -> o2 p
forall (i :: * -> *) (o :: * -> *) (f :: * -> *) (g :: * -> *)
(ignored :: [Symbol]) (proxy :: [Symbol] -> *) p.
GHoist i o f g ignored =>
proxy ignored -> (forall x. f x -> g x) -> i p -> o p
gghoist proxy ignored
proxy forall x. f x -> g x
f i2 p
i2
instance
( Monad f
, IsVariadic vf args (f a)
, IsVariadic vg args (g a)
) => GHoist (K1 R vf) (K1 R vg) f g ignored
where
gghoist :: proxy ignored -> (forall x. f x -> g x) -> K1 R vf p -> K1 R vg p
gghoist _proxy :: proxy ignored
_proxy f :: forall x. f x -> g x
f (K1 vf :: vf
vf) = vg -> K1 R vg p
forall k i c (p :: k). c -> K1 i c p
K1 ((forall x. f x -> g x) -> vf -> vg
forall (f :: * -> *) vf (args :: [*]) a vg (g :: * -> *).
(Monad f, IsVariadic vf args (f a), IsVariadic vg args (g a)) =>
(forall x. f x -> g x) -> vf -> vg
vhoist forall x. f x -> g x
f vf
vf)
type VerifyIgnored e a es = VerifyIgnoredGo e a es es
type family VerifyIgnoredGo e a es orig :: Constraint where
VerifyIgnoredGo x a (x ': xs) orig = ()
VerifyIgnoredGo y a (x ': xs) orig = VerifyIgnoredGo y a xs orig
VerifyIgnoredGo x a '[] orig =
TypeError
( 'Text "Field:"
':$$: 'Text " "
':<>: 'Text x
':<>: 'Text " :: "
':<>: 'ShowType a
':$$: 'Text "cannot be ghoist-ed with the supplied "
':<>: 'Text "function and was not in the ignored fields list: "
':<>: 'ShowType orig
)
type VerifyNotIgnored e a es = VerifyNotIgnoredGo e a es es
type family VerifyNotIgnoredGo e a es orig :: Constraint where
VerifyNotIgnoredGo x a (x ': xs) orig =
TypeError
( 'Text "Field:"
':$$: 'Text " "
':<>: 'Text x
':<>: 'Text " :: "
':<>: 'ShowType a
':$$: 'Text "must be ghoist-ed but was present in the ignored "
':<>: 'Text "fields list: "
':<>: 'ShowType orig
)
VerifyNotIgnoredGo y a (x ': xs) orig = VerifyNotIgnoredGo y a xs orig
VerifyNotIgnoredGo x a '[] orig = ()