RequestExample.purs

module Stuff where

import Prelude

import Data.Functor.Coproduct (Coproduct, left, right)
import Data.Maybe (Maybe(..), fromMaybe)

import Debug.Trace (traceA) -- from purescript-debug
import Data.Either (Either)
import Halogen as H
import Halogen.HTML as HH
import Halogen.Component.ChildPath (ChildPath, cpL, cpR)

--------------------------------------------------------------------------------

type GrandState = Unit
data GrandQuery a = AskGrandChild (String -> a)

grandchild :: forall g. H.Component GrandState GrandQuery g
grandchild = H.component { render, eval }
  where
  render :: GrandState -> H.ComponentHTML GrandQuery
  render _ = HH.div_ []
  eval :: H.Natural GrandQuery (H.ComponentDSL GrandState GrandQuery g)
  eval (AskGrandChild k) = pure $ k "Hello from grandchild"

--------------------------------------------------------------------------------

type ChildState2 = Unit
data ChildQuery2 a = AskChild (String -> a)
type GrandSlot2 = Unit

type ChildStateP2 g = H.ParentState ChildState2 GrandState ChildQuery2 GrandQuery g GrandSlot2
type ChildQueryP2 = Coproduct ChildQuery2 (H.ChildF GrandSlot2 GrandQuery)

child2 :: forall g. Functor g => H.Component (ChildStateP2 g) ChildQueryP2 g
child2 = H.parentComponent { render, eval, peek: Nothing }
  where
  render :: ChildState2 -> H.ParentHTML GrandState ChildQuery2 GrandQuery g GrandSlot2
  render _ = HH.slot unit \_ -> { component: grandchild, initialState: unit }
  eval :: H.Natural ChildQuery2 (H.ParentDSL ChildState2 GrandState ChildQuery2 GrandQuery g GrandSlot2)
  eval (AskChild k) = pure $ k "Hello from child"

--------------------------------------------------------------------------------

type ChildState1 = Unit
data ChildQuery1 a = AskChild1 (String -> a)
type GrandSlot1 = Unit

type ChildStateP1 g = H.ParentState ChildState1 GrandState ChildQuery1 GrandQuery g GrandSlot1
type ChildQueryP1 = Coproduct ChildQuery1 (H.ChildF GrandSlot1 GrandQuery)

child1 :: forall g. Functor g => H.Component (ChildStateP1 g) ChildQueryP1 g
child1 = H.parentComponent { render, eval, peek: Nothing }
  where
  render :: ChildState1 -> H.ParentHTML GrandState ChildQuery1 GrandQuery g GrandSlot1
  render _ = HH.slot unit \_ -> { component: grandchild, initialState: unit }
  eval :: H.Natural ChildQuery1 (H.ParentDSL ChildState1 GrandState ChildQuery1 GrandQuery g GrandSlot1)
  eval (AskChild1 k) = pure $ k "Hello from child"

--------------------------------------------------------------------------------

type ParentState = Unit
data ParentQuery a = Something a
type ChildSlot = Unit


type ParentStateP g = H.ParentState ParentState (ParentChildState g) ParentQuery ParentChildQuery g ParentChildSlot
type ParentQueryP = Coproduct ParentQuery (H.ChildF ParentChildSlot ParentChildQuery)


type ParentChildState g = Either (ChildStateP1 g) (ChildStateP2 g)
type ParentChildQuery = Coproduct ChildQueryP1 ChildQueryP2
type ParentChildSlot = Either GrandSlot1 GrandSlot2

parent :: forall g. Functor g => H.Component (ParentStateP g) ParentQueryP g
parent = H.parentComponent { render, eval, peek: Nothing }
  where
  render :: ParentState -> H.ParentHTML (ParentChildState g) ParentQuery ParentChildQuery g ParentChildSlot
  render _ = viewChild "Child1"

  viewChild :: String -> H.HTML (H.SlotConstructor (ParentChildState g) ParentChildQuery g ParentChildSlot) ParentQuery
  viewChild "Child1" =
    HH.slot' pathToChild1 unit \_ -> { component: child1, initialState: H.parentState unit }
  viewChild "Child2" =
    HH.slot' pathToChild2 unit \_ -> { component: child2, initialState: H.parentState unit }

  pathToChild1 :: ChildPath (ChildStateP1 g) (ParentChildState g) ChildQueryP1 ParentChildQuery GrandSlot1 ParentChildSlot
  pathToChild1 = cpL

  pathToChild2 :: ChildPath (ChildStateP2 g) (ParentChildState g) ChildQueryP2 ParentChildQuery GrandSlot2 ParentChildSlot
  pathToChild2 = cpR

  eval :: H.Natural ParentQuery (H.ParentDSL ParentState (ParentChildState g) ParentQuery ParentChildQuery g ParentChildSlot)
  eval (Something next) = do

    -- Now these don't compile
    -- childAnswer <- H.query unit $ left $ H.request AskChild
    -- traceA $ fromMaybe "child not found" $ childAnswer

    -- grandAnswer <- H.query unit $ right $ H.ChildF unit $ H.request AskGrandChild
    -- traceA $ fromMaybe "grandchild not found" $ grandAnswer

    pure next