-- | A variant of 'Data.Pointed.Pointed' for 'Hyper.Type.HyperType's

module Hyper.Class.Pointed
    ( HPointed(..)
    ) where

import GHC.Generics ((:+:)(..))
import Hyper.Class.Nodes (HNodes, HWitness(..))
import Hyper.Type (type (#))

import Hyper.Internal.Prelude

-- | A variant of 'Data.Pointed.Pointed' for 'Hyper.Type.HyperType's
class HNodes h => HPointed h where
    -- | Construct a value from a generator of @h@'s nodes
    -- (a generator which can generate a tree of any type given a witness that it is a node of @h@)
    hpure ::
        (forall n. HWitness h n -> p # n) ->
        h # p

instance Monoid a => HPointed (Const a) where
    {-# INLINE hpure #-}
    hpure :: (forall (n :: HyperType). HWitness (Const a) n -> p # n)
-> Const a # p
hpure forall (n :: HyperType). HWitness (Const a) n -> p # n
_ = a -> Const a # p
forall k a (b :: k). a -> Const a b
Const a
forall a. Monoid a => a
mempty

instance (HPointed a, HPointed b) => HPointed (a :*: b) where
    {-# INLINE hpure #-}
    hpure :: (forall (n :: HyperType). HWitness (a :*: b) n -> p # n)
-> (a :*: b) # p
hpure forall (n :: HyperType). HWitness (a :*: b) n -> p # n
f = (forall (n :: HyperType). HWitness a n -> p # n) -> a # p
forall (h :: HyperType) (p :: HyperType).
HPointed h =>
(forall (n :: HyperType). HWitness h n -> p # n) -> h # p
hpure (HWitness (a :*: b) n -> p # n
forall (n :: HyperType). HWitness (a :*: b) n -> p # n
f (HWitness (a :*: b) n -> p # n)
-> (HWitness a n -> HWitness (a :*: b) n) -> HWitness a n -> p # n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) (HWitness a) (HWitness b) n -> HWitness (a :*: b) n
forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness ((:+:) (HWitness a) (HWitness b) n -> HWitness (a :*: b) n)
-> (HWitness a n -> (:+:) (HWitness a) (HWitness b) n)
-> HWitness a n
-> HWitness (a :*: b) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWitness a n -> (:+:) (HWitness a) (HWitness b) n
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) (a # p) -> b ('AHyperType p) -> (a :*: b) # p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (forall (n :: HyperType). HWitness b n -> p # n)
-> b ('AHyperType p)
forall (h :: HyperType) (p :: HyperType).
HPointed h =>
(forall (n :: HyperType). HWitness h n -> p # n) -> h # p
hpure (HWitness (a :*: b) n -> p # n
forall (n :: HyperType). HWitness (a :*: b) n -> p # n
f (HWitness (a :*: b) n -> p # n)
-> (HWitness b n -> HWitness (a :*: b) n) -> HWitness b n -> p # n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) (HWitness a) (HWitness b) n -> HWitness (a :*: b) n
forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness ((:+:) (HWitness a) (HWitness b) n -> HWitness (a :*: b) n)
-> (HWitness b n -> (:+:) (HWitness a) (HWitness b) n)
-> HWitness b n
-> HWitness (a :*: b) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWitness b n -> (:+:) (HWitness a) (HWitness b) n
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1)