module Hyper.Combinator.Func
    ( HFunc(..), _HFunc
    ) where

import Control.Lens (Iso, iso)
import Hyper.Type (HyperType, type (#))

newtype HFunc (i :: HyperType) o h = HFunc (i h -> o h)

_HFunc ::
    Iso (HFunc i0 o0 # h0)
        (HFunc i1 o1 # h1)
        (i0 # h0 -> o0 # h0)
        (i1 # h1 -> o1 # h1)
_HFunc :: p ((i0 # h0) -> o0 # h0) (f ((i1 # h1) -> o1 # h1))
-> p (HFunc i0 o0 # h0) (f (HFunc i1 o1 # h1))
_HFunc = ((HFunc i0 o0 # h0) -> (i0 # h0) -> o0 # h0)
-> (((i1 # h1) -> o1 # h1) -> HFunc i1 o1 # h1)
-> Iso
     (HFunc i0 o0 # h0)
     (HFunc i1 o1 # h1)
     ((i0 # h0) -> o0 # h0)
     ((i1 # h1) -> o1 # h1)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(HFunc (i0 # h0) -> o0 # h0
x) -> (i0 # h0) -> o0 # h0
x) ((i1 # h1) -> o1 # h1) -> HFunc i1 o1 # h1
forall (i :: HyperType) (o :: HyperType) (h :: AHyperType).
(i h -> o h) -> HFunc i o h
HFunc