-----------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE RankNTypes                 #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Binding
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module Miso.Binding
  ( -- ** Types
    Binding (..)
    -- ** Combinators
  , (<-->)
  , (<--)
  , (-->)
  , (<--->)
  , (<---)
  , (--->)
  ) where
----------------------------------------------------------------------------
import Data.Functor.Const (Const(..))
import Control.Monad.Identity (Identity(..))
----------------------------------------------------------------------------
import Miso.Lens (Lens(..), Lens')
----------------------------------------------------------------------------
-- | Type used for React-like "props" functionality. This is used to
-- to bind parent model changes to the child model, or vice versa.
--
-- The difference between miso and React here is that miso is
-- synchronizing model states of Components declaratively (outside of the
-- view). In React "props" are used in the view code.
--
-- <https://react.dev/learn/passing-props-to-a-component>
--
-- This can be thought of as establishing an "edge" in the 'Component' graph,
-- whereby events cause model change synchronization to "ripple" or "pulsate"
-- through the views. The "reactivity" of the graph is constructed manually
-- by the end-user, using the edge primitives `-->`, `<--`, `<-->` (reactive combinators).
--
-- This can also be thought of as a "Wire" (from `netwire`) for reactive
-- variable synchronization, except done at the granularity specified by the `Lens`.
--
-- @
--
-- main :: IO ()
-- main = run app { bindings = [ parentLens <--> childLens ] }
--
-- @
--
-- @since 1.9.0.0
data Binding parent child
  = forall field . ParentToChild (parent -> field) (field -> child -> child)
  | forall field . ChildToParent (field -> parent -> parent) (child -> field)
  | forall field . Bidirectional (parent -> field) (field -> parent -> parent) (child -> field) (field -> child -> child)
-----------------------------------------------------------------------------
-- | Unidirectionally binds a parent field to a child field
--
-- @since 1.9.0.0
(-->) :: Lens parent a -> Lens model a -> Binding parent model
Lens parent a
parent --> :: forall parent a model.
Lens parent a -> Lens model a -> Binding parent model
--> Lens model a
child = (parent -> a) -> (a -> model -> model) -> Binding parent model
forall parent child field.
(parent -> field)
-> (field -> child -> child) -> Binding parent child
ParentToChild (Lens parent a -> parent -> a
forall record field. Lens record field -> record -> field
_get Lens parent a
parent) (Lens model a -> a -> model -> model
forall record field. Lens record field -> field -> record -> record
_set Lens model a
child) 
-----------------------------------------------------------------------------
-- | Unidirectionally binds a child field to a parent field
--
-- @since 1.9.0.0
(<--) :: Lens parent a  -> Lens model a -> Binding parent model
Lens parent a
parent <-- :: forall parent a model.
Lens parent a -> Lens model a -> Binding parent model
<-- Lens model a
child = (a -> parent -> parent) -> (model -> a) -> Binding parent model
forall parent child field.
(field -> parent -> parent)
-> (child -> field) -> Binding parent child
ChildToParent (Lens parent a -> a -> parent -> parent
forall record field. Lens record field -> field -> record -> record
_set Lens parent a
parent) (Lens model a -> model -> a
forall record field. Lens record field -> record -> field
_get Lens model a
child)
-----------------------------------------------------------------------------
-- | Bidirectionally binds a child field to a parent field, using @Lens@
--
-- This is a bidirectional reactive combinator for a miso @Lens@.
--
-- @since 1.9.0.0
(<-->) :: Lens parent field -> Lens child field -> Binding parent child
Lens parent field
p <--> :: forall parent a model.
Lens parent a -> Lens model a -> Binding parent model
<--> Lens child field
c = (parent -> field)
-> (field -> parent -> parent)
-> (child -> field)
-> (field -> child -> child)
-> Binding parent child
forall parent child field.
(parent -> field)
-> (field -> parent -> parent)
-> (child -> field)
-> (field -> child -> child)
-> Binding parent child
Bidirectional (Lens parent field -> parent -> field
forall record field. Lens record field -> record -> field
_get Lens parent field
p) (Lens parent field -> field -> parent -> parent
forall record field. Lens record field -> field -> record -> record
_set Lens parent field
p) (Lens child field -> child -> field
forall record field. Lens record field -> record -> field
_get Lens child field
c) (Lens child field -> field -> child -> child
forall record field. Lens record field -> field -> record -> record
_set Lens child field
c)
-----------------------------------------------------------------------------
-- | Bidirectionally binds a child field to a parent field, using @Lens'@
--
-- This is a bidirectional reactive combinator for a van Laarhoven @Lens'@
--
-- @since 1.9.0.0
(<--->) :: Lens' parent field -> Lens' child field -> Binding parent child
Lens' parent field
p <---> :: forall parent field child.
Lens' parent field -> Lens' child field -> Binding parent child
<---> Lens' child field
c = (parent -> field)
-> (field -> parent -> parent)
-> (child -> field)
-> (field -> child -> child)
-> Binding parent child
forall parent child field.
(parent -> field)
-> (field -> parent -> parent)
-> (child -> field)
-> (field -> child -> child)
-> Binding parent child
Bidirectional (((field -> Const field field) -> parent -> Const field parent)
-> parent -> field
forall {a} {b} {t} {a} {b}.
((a -> Const a b) -> t -> Const a b) -> t -> a
get_ (field -> Const field field) -> parent -> Const field parent
Lens' parent field
p) (((field -> Identity field) -> parent -> Identity parent)
-> field -> parent -> parent
forall {t} {a} {a} {c}.
((t -> Identity a) -> a -> Identity c) -> a -> a -> c
set_ (field -> Identity field) -> parent -> Identity parent
Lens' parent field
p) (((field -> Const field field) -> child -> Const field child)
-> child -> field
forall {a} {b} {t} {a} {b}.
((a -> Const a b) -> t -> Const a b) -> t -> a
get_ (field -> Const field field) -> child -> Const field child
Lens' child field
c) (((field -> Identity field) -> child -> Identity child)
-> field -> child -> child
forall {t} {a} {a} {c}.
((t -> Identity a) -> a -> Identity c) -> a -> a -> c
set_ (field -> Identity field) -> child -> Identity child
Lens' child field
c)
  where
    get_ :: ((a -> Const a b) -> t -> Const a b) -> t -> a
get_ (a -> Const a b) -> t -> Const a b
lens_ t
record = Const a b -> a
forall {k} a (b :: k). Const a b -> a
getConst ((a -> Const a b) -> t -> Const a b
lens_ a -> Const a b
forall {k} a (b :: k). a -> Const a b
Const t
record)
    set_ :: ((t -> Identity a) -> a -> Identity c) -> a -> a -> c
set_ (t -> Identity a) -> a -> Identity c
lens_ a
field = Identity c -> c
forall a. Identity a -> a
runIdentity (Identity c -> c) -> (a -> Identity c) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Identity a) -> a -> Identity c
lens_ (\t
_ -> a -> Identity a
forall a. a -> Identity a
Identity a
field)
-----------------------------------------------------------------------------
-- | Unidirectionally binds a parent field to a child field, for van Laarhoven
-- style @Lens'@
--
-- @since 1.9.0.0
(--->) :: Lens' parent field -> Lens' child field -> Binding parent child
Lens' parent field
p ---> :: forall parent field child.
Lens' parent field -> Lens' child field -> Binding parent child
---> Lens' child field
c = (parent -> field)
-> (field -> child -> child) -> Binding parent child
forall parent child field.
(parent -> field)
-> (field -> child -> child) -> Binding parent child
ParentToChild (((field -> Const field field) -> parent -> Const field parent)
-> parent -> field
forall {a} {b} {t} {a} {b}.
((a -> Const a b) -> t -> Const a b) -> t -> a
get_ (field -> Const field field) -> parent -> Const field parent
Lens' parent field
p) (((field -> Identity field) -> child -> Identity child)
-> field -> child -> child
forall {t} {a} {a} {c}.
((t -> Identity a) -> a -> Identity c) -> a -> a -> c
set_ (field -> Identity field) -> child -> Identity child
Lens' child field
c)
  where
    get_ :: ((a -> Const a b) -> t -> Const a b) -> t -> a
get_ (a -> Const a b) -> t -> Const a b
lens_ t
record = Const a b -> a
forall {k} a (b :: k). Const a b -> a
getConst ((a -> Const a b) -> t -> Const a b
lens_ a -> Const a b
forall {k} a (b :: k). a -> Const a b
Const t
record)
    set_ :: ((t -> Identity a) -> a -> Identity c) -> a -> a -> c
set_ (t -> Identity a) -> a -> Identity c
lens_ a
field = Identity c -> c
forall a. Identity a -> a
runIdentity (Identity c -> c) -> (a -> Identity c) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Identity a) -> a -> Identity c
lens_ (\t
_ -> a -> Identity a
forall a. a -> Identity a
Identity a
field)
-----------------------------------------------------------------------------
-- | Unidirectionally binds a child field to a parent field, for van Laarhoven
-- style @Lens'@
--
-- @since 1.9.0.0
(<---) :: Lens' parent field -> Lens' child field -> Binding parent child
Lens' parent field
p <--- :: forall parent field child.
Lens' parent field -> Lens' child field -> Binding parent child
<--- Lens' child field
c = (field -> parent -> parent)
-> (child -> field) -> Binding parent child
forall parent child field.
(field -> parent -> parent)
-> (child -> field) -> Binding parent child
ChildToParent (((field -> Identity field) -> parent -> Identity parent)
-> field -> parent -> parent
forall {t} {a} {a} {c}.
((t -> Identity a) -> a -> Identity c) -> a -> a -> c
set_ (field -> Identity field) -> parent -> Identity parent
Lens' parent field
p) (((field -> Const field field) -> child -> Const field child)
-> child -> field
forall {a} {b} {t} {a} {b}.
((a -> Const a b) -> t -> Const a b) -> t -> a
get_ (field -> Const field field) -> child -> Const field child
Lens' child field
c)
  where
    get_ :: ((a -> Const a b) -> t -> Const a b) -> t -> a
get_ (a -> Const a b) -> t -> Const a b
lens_ t
record = Const a b -> a
forall {k} a (b :: k). Const a b -> a
getConst ((a -> Const a b) -> t -> Const a b
lens_ a -> Const a b
forall {k} a (b :: k). a -> Const a b
Const t
record)
    set_ :: ((t -> Identity a) -> a -> Identity c) -> a -> a -> c
set_ (t -> Identity a) -> a -> Identity c
lens_ a
field = Identity c -> c
forall a. Identity a -> a
runIdentity (Identity c -> c) -> (a -> Identity c) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Identity a) -> a -> Identity c
lens_ (\t
_ -> a -> Identity a
forall a. a -> Identity a
Identity a
field)
-----------------------------------------------------------------------------