{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Generic.HKD.Construction
( Construct (..)
) where
import Data.Generic.HKD.Types (HKD (..), GHKD_)
import Data.Kind (Type)
import GHC.Generics
class Construct (f :: Type -> Type) (structure :: Type) where
construct :: HKD structure f -> f structure
deconstruct :: structure -> HKD structure f
class GConstruct (f :: Type -> Type) (rep :: Type -> Type) where
gconstruct :: GHKD_ f rep p -> f (rep p)
gdeconstruct :: rep p -> GHKD_ f rep p
instance (Functor f, GConstruct f inner)
=> GConstruct f (M1 index meta inner) where
gconstruct :: forall p.
GHKD_ f (M1 index meta inner) p -> f (M1 index meta inner p)
gconstruct = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (rep :: * -> *) p.
GConstruct f rep =>
GHKD_ f rep p -> f (rep p)
gconstruct forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
gdeconstruct :: forall p. M1 index meta inner p -> GHKD_ f (M1 index meta inner) p
gdeconstruct = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (rep :: * -> *) p.
GConstruct f rep =>
rep p -> GHKD_ f rep p
gdeconstruct @f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
instance (Applicative f, GConstruct f left, GConstruct f right)
=> GConstruct f (left :*: right) where
gconstruct :: forall p. GHKD_ f (left :*: right) p -> f ((:*:) left right p)
gconstruct (GHKD_ f left p
l :*: GHKD_ f right p
r) = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (rep :: * -> *) p.
GConstruct f rep =>
GHKD_ f rep p -> f (rep p)
gconstruct GHKD_ f left p
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) (rep :: * -> *) p.
GConstruct f rep =>
GHKD_ f rep p -> f (rep p)
gconstruct GHKD_ f right p
r
gdeconstruct :: forall p. (:*:) left right p -> GHKD_ f (left :*: right) p
gdeconstruct (left p
l :*: right p
r) = forall (f :: * -> *) (rep :: * -> *) p.
GConstruct f rep =>
rep p -> GHKD_ f rep p
gdeconstruct @f left p
l forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (f :: * -> *) (rep :: * -> *) p.
GConstruct f rep =>
rep p -> GHKD_ f rep p
gdeconstruct @f right p
r
instance Applicative f => GConstruct f (K1 index inner) where
gconstruct :: forall p. GHKD_ f (K1 index inner) p -> f (K1 index inner p)
gconstruct (K1 f inner
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i c (p :: k). c -> K1 i c p
K1 f inner
x
gdeconstruct :: forall p. K1 index inner p -> GHKD_ f (K1 index inner) p
gdeconstruct (K1 inner
x) = forall k i c (p :: k). c -> K1 i c p
K1 (forall (f :: * -> *) a. Applicative f => a -> f a
pure inner
x)
instance (Applicative f, Generic structure, GConstruct f (Rep structure))
=> Construct f structure where
construct :: HKD structure f -> f structure
construct = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a x. Generic a => Rep a x -> a
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (rep :: * -> *) p.
GConstruct f rep =>
GHKD_ f rep p -> f (rep p)
gconstruct forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall structure (f :: * -> *).
HKD structure f -> HKD_ f structure Void
runHKD
deconstruct :: structure -> HKD structure f
deconstruct = forall structure (f :: * -> *).
HKD_ f structure Void -> HKD structure f
HKD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (rep :: * -> *) p.
GConstruct f rep =>
rep p -> GHKD_ f rep p
gdeconstruct @f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from