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 :: forall (i0 :: HyperType) (o0 :: HyperType) (h0 :: HyperType)
       (i1 :: HyperType) (o1 :: HyperType) (h1 :: HyperType).
Iso
  (HFunc i0 o0 # h0)
  (HFunc i1 o1 # h1)
  ((i0 # h0) -> o0 # h0)
  ((i1 # h1) -> o1 # h1)
_HFunc = 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) forall (i :: HyperType) (o :: HyperType) (h :: AHyperType).
(i h -> o h) -> HFunc i o h
HFunc