-- | A variant of 'Control.Monad.Monad' for 'Hyper.Type.HyperType's

{-# LANGUAGE FlexibleContexts #-}

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 :: (HCompose Pure Pure # p) -> Pure # p
hjoin HCompose Pure Pure # p
x =
        Dict (HFunctor p, HNodesConstraint p (Recursively HFunctor))
-> ((HFunctor p, HNodesConstraint p (Recursively HFunctor)) =>
    Pure # p)
-> Pure # p
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (HFunctor p)
-> Dict (HFunctor p, HNodesConstraint p (Recursively HFunctor))
forall (c :: HyperType -> Constraint) (h :: HyperType)
       (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively ((HCompose Pure Pure # p) -> Proxy (HFunctor p)
forall (p :: HyperType).
(HCompose Pure Pure # p) -> Proxy (HFunctor p)
p HCompose Pure Pure # p
x)) (((HFunctor p, HNodesConstraint p (Recursively HFunctor)) =>
  Pure # p)
 -> Pure # p)
-> ((HFunctor p, HNodesConstraint p (Recursively HFunctor)) =>
    Pure # p)
-> Pure # p
forall a b. (a -> b) -> a -> b
$
        Tagged (p # Pure) (Identity (p # Pure))
-> Tagged (Pure # p) (Identity (Pure # p))
forall (h :: HyperType) (j :: HyperType).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure (Tagged (p # Pure) (Identity (p # Pure))
 -> Tagged (Pure # p) (Identity (Pure # p)))
-> (p # Pure) -> Pure # p
forall t b. AReview t b -> b -> t
#
        (forall (n :: HyperType).
 HWitness p n -> (HCompose Pure Pure # n) -> Pure # n)
-> (p # HCompose Pure Pure) -> p # Pure
forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (Proxy (Recursively HFunctor)
forall k (t :: k). Proxy t
Proxy @(Recursively HFunctor) Proxy (Recursively HFunctor)
-> (Recursively HFunctor n => (HCompose Pure Pure # n) -> Pure # n)
-> HWitness p n
-> (HCompose Pure Pure # n)
-> Pure # n
forall (h :: HyperType) (c :: HyperType -> Constraint)
       (n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => r) -> HWitness h n -> r
#> Recursively HFunctor n => (HCompose Pure Pure # n) -> Pure # n
forall (h :: HyperType) (p :: HyperType).
(HMonad h, Recursively HFunctor p) =>
(HCompose h h # p) -> h # p
hjoin)
        (HCompose Pure Pure # p
x (HCompose Pure Pure # p)
-> Getting
     (p # HCompose Pure Pure)
     (HCompose Pure Pure # p)
     (p # HCompose Pure Pure)
-> p # HCompose Pure Pure
forall s a. s -> Getting a s a -> a
^. ((Pure # HCompose Pure p)
 -> Const (p # HCompose Pure Pure) (Pure # HCompose Pure p))
-> (HCompose Pure Pure # p)
-> Const (p # HCompose Pure Pure) (HCompose Pure Pure # p)
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 (((Pure # HCompose Pure p)
  -> Const (p # HCompose Pure Pure) (Pure # HCompose Pure p))
 -> (HCompose Pure Pure # p)
 -> Const (p # HCompose Pure Pure) (HCompose Pure Pure # p))
-> (((p # HCompose Pure Pure)
     -> Const (p # HCompose Pure Pure) (p # HCompose Pure Pure))
    -> (Pure # HCompose Pure p)
    -> Const (p # HCompose Pure Pure) (Pure # HCompose Pure p))
-> Getting
     (p # HCompose Pure Pure)
     (HCompose Pure Pure # p)
     (p # HCompose Pure Pure)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HCompose Pure p # Pure)
 -> Const (p # HCompose Pure Pure) (HCompose Pure p # Pure))
-> (Pure # HCompose Pure p)
-> Const (p # HCompose Pure Pure) (Pure # HCompose Pure p)
forall (h :: HyperType) (j :: HyperType).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure (((HCompose Pure p # Pure)
  -> Const (p # HCompose Pure Pure) (HCompose Pure p # Pure))
 -> (Pure # HCompose Pure p)
 -> Const (p # HCompose Pure Pure) (Pure # HCompose Pure p))
-> (((p # HCompose Pure Pure)
     -> Const (p # HCompose Pure Pure) (p # HCompose Pure Pure))
    -> (HCompose Pure p # Pure)
    -> Const (p # HCompose Pure Pure) (HCompose Pure p # Pure))
-> ((p # HCompose Pure Pure)
    -> Const (p # HCompose Pure Pure) (p # HCompose Pure Pure))
-> (Pure # HCompose Pure p)
-> Const (p # HCompose Pure Pure) (Pure # HCompose Pure p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Pure # HCompose p Pure)
 -> Const (p # HCompose Pure Pure) (Pure # HCompose p Pure))
-> (HCompose Pure p # Pure)
-> Const (p # HCompose Pure Pure) (HCompose Pure p # Pure)
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 (((Pure # HCompose p Pure)
  -> Const (p # HCompose Pure Pure) (Pure # HCompose p Pure))
 -> (HCompose Pure p # Pure)
 -> Const (p # HCompose Pure Pure) (HCompose Pure p # Pure))
-> (((p # HCompose Pure Pure)
     -> Const (p # HCompose Pure Pure) (p # HCompose Pure Pure))
    -> (Pure # HCompose p Pure)
    -> Const (p # HCompose Pure Pure) (Pure # HCompose p Pure))
-> ((p # HCompose Pure Pure)
    -> Const (p # HCompose Pure Pure) (p # HCompose Pure Pure))
-> (HCompose Pure p # Pure)
-> Const (p # HCompose Pure Pure) (HCompose Pure p # Pure)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HCompose p Pure # Pure)
 -> Const (p # HCompose Pure Pure) (HCompose p Pure # Pure))
-> (Pure # HCompose p Pure)
-> Const (p # HCompose Pure Pure) (Pure # HCompose p Pure)
forall (h :: HyperType) (j :: HyperType).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure (((HCompose p Pure # Pure)
  -> Const (p # HCompose Pure Pure) (HCompose p Pure # Pure))
 -> (Pure # HCompose p Pure)
 -> Const (p # HCompose Pure Pure) (Pure # HCompose p Pure))
-> (((p # HCompose Pure Pure)
     -> Const (p # HCompose Pure Pure) (p # HCompose Pure Pure))
    -> (HCompose p Pure # Pure)
    -> Const (p # HCompose Pure Pure) (HCompose p Pure # Pure))
-> ((p # HCompose Pure Pure)
    -> Const (p # HCompose Pure Pure) (p # HCompose Pure Pure))
-> (Pure # HCompose p Pure)
-> Const (p # HCompose Pure Pure) (Pure # HCompose p Pure)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((p # HCompose Pure Pure)
 -> Const (p # HCompose Pure Pure) (p # HCompose Pure Pure))
-> (HCompose p Pure # Pure)
-> Const (p # HCompose Pure Pure) (HCompose p Pure # Pure)
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)
        where
            p :: HCompose Pure Pure # p -> Proxy (HFunctor p)
            p :: (HCompose Pure Pure # p) -> Proxy (HFunctor p)
p HCompose Pure Pure # p
_ = Proxy (HFunctor 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 :: (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 = Tagged (h # HCompose h p) (Identity (h # HCompose h p))
-> Tagged (HCompose h h # p) (Identity (HCompose h h # p))
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 (Tagged (h # HCompose h p) (Identity (h # HCompose h p))
 -> Tagged (HCompose h h # p) (Identity (HCompose h h # p)))
-> (h # HCompose h p) -> HCompose h h # p
forall t b. AReview t b -> b -> t
# (forall (n :: HyperType).
 HWitness h n -> (p # n) -> HCompose h p # n)
-> (h # p) -> h # HCompose h p
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 (HCompose h h # p) -> ((HCompose h h # p) -> h # p) -> h # p
forall a b. a -> (a -> b) -> b
& (HCompose h h # p) -> h # p
forall (h :: HyperType) (p :: HyperType).
(HMonad h, Recursively HFunctor p) =>
(HCompose h h # p) -> h # p
hjoin