{-# LANGUAGE FlexibleContexts #-}

-- | A variant of 'Control.Monad.Monad' for 'Hyper.Type.HyperType's
module Hyper.Class.Monad
    ( HMonad (..)
    , hbind
    ) where

import Hyper.Class.Apply (HApplicative)
import Hyper.Class.Functor (HFunctor (..))
import Hyper.Class.Nodes (HWitness, (#>))
import Hyper.Class.Recursive (Recursively (..))
import Hyper.Combinator.Compose (HCompose, _HCompose)
import Hyper.Type (type (#))
import Hyper.Type.Pure (Pure (..), _Pure)

import Hyper.Internal.Prelude

-- | A variant of 'Control.Monad.Monad' for 'Hyper.Type.HyperType's
class HApplicative h => HMonad h where
    hjoin ::
        Recursively HFunctor p =>
        HCompose h h # p ->
        h # p

instance HMonad Pure where
    hjoin :: forall (p :: HyperType).
Recursively HFunctor p =>
(HCompose Pure Pure # p) -> Pure # p
hjoin HCompose Pure Pure # p
x =
        forall (h :: HyperType) (j :: HyperType).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure
            # hmap
                (Proxy @(Recursively HFunctor) #> hjoin)
                (x ^. _HCompose . _Pure . _HCompose . _Pure . _HCompose)
            forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
       (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (forall (p :: HyperType).
(HCompose Pure Pure # p) -> Proxy (HFunctor p)
p HCompose Pure Pure # p
x)
        where
            p :: HCompose Pure Pure # p -> Proxy (HFunctor p)
            p :: forall (p :: HyperType).
(HCompose Pure Pure # p) -> Proxy (HFunctor p)
p HCompose Pure Pure # p
_ = forall {k} (t :: k). Proxy t
Proxy

-- | A variant of 'Control.Monad.(>>=)' for 'Hyper.Type.HyperType's
hbind ::
    (HMonad h, Recursively HFunctor p) =>
    h # p ->
    (forall n. HWitness h n -> p # n -> HCompose h p # n) ->
    h # p
hbind :: forall (h :: HyperType) (p :: HyperType).
(HMonad h, Recursively HFunctor p) =>
(h # p)
-> (forall (n :: HyperType).
    HWitness h n -> (p # n) -> HCompose h p # n)
-> h # p
hbind h # p
x forall (n :: HyperType).
HWitness h n -> (p # n) -> HCompose h p # n
f = forall (a0 :: HyperType) (b0 :: HyperType) (h0 :: HyperType)
       (a1 :: HyperType) (b1 :: HyperType) (h1 :: HyperType).
Iso
  (HCompose a0 b0 # h0)
  (HCompose a1 b1 # h1)
  (a0 # HCompose b0 h0)
  (a1 # HCompose b1 h1)
_HCompose forall t b. AReview t b -> b -> t
# forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap forall (n :: HyperType).
HWitness h n -> (p # n) -> HCompose h p # n
f h # p
x forall a b. a -> (a -> b) -> b
& forall (h :: HyperType) (p :: HyperType).
(HMonad h, Recursively HFunctor p) =>
(HCompose h h # p) -> h # p
hjoin