-----------------------------------------------------------------------------
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
#ifdef WASM
{-# LANGUAGE TemplateHaskell   #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Flow.Internal.Bridge
-- License     :  BSD3-style (see the file LICENSE)
--
-- Low-level bindings to the miso-flow JavaScript bridge
-- (@js\/miso-flow.js@, built from @ts\/miso-flow.ts@), which drives the
-- imperative @\@xyflow\/system@ modules (XYPanZoom, XYDrag, XYHandle,
-- XYResizer, XYMinimap) against the DOM rendered by miso.
--
-- Everything crossing the boundary is JSON. Higher layers
-- ("Miso.Flow.Component" and the @Miso.Flow.*@ instance modules) wrap
-- this into MVU-friendly interfaces.
----------------------------------------------------------------------------
module Miso.Flow.Internal.Bridge
  ( -- * Store handle
    FlowStore (..)
    -- * Options
  , StoreOptions (..)
  , defaultStoreOptions
    -- * Callbacks out of the gesture system
  , BridgeCallbacks (..)
  , emptyBridgeCallbacks
    -- * Wire types (JS -> Haskell payloads)
  , WireNodeChange (..)
  , ConnectionStateWire (..)
  , wireConnectionState
    -- * Store lifecycle
  , createFlowStore
  , storeDestroy
    -- * Graph sync
  , storeSetNodes
  , storeSetEdges
  , storeUpdateOptions
    -- * Viewport control
  , storeGetViewport
  , storeSetViewport
  , storeSyncViewport
  , storeZoomIn
  , storeZoomOut
  , storeZoomTo
  , storeScaleBy
  , storeSetCenter
  , storeFitView
  , storeFitBounds
  , storePanBy
    -- * Node measurement
  , storeObserveNode
  , storeUnobserveNode
  , storeRequestNodeMeasure
    -- * Dragging
  , storeAttachNodeDrag
  , storeUpdateNodeDrag
  , storeDetachNodeDrag
    -- * Connections
  , storeAttachHandle
  , storeAttachReconnectAnchor
    -- * Resizer
  , storeAttachResizer
  , storeUpdateResizer
  , storeDetachResizer
    -- * Minimap
  , storeAttachMinimap
  , storeUpdateMinimap
  ) where
-----------------------------------------------------------------------------
import           Control.Applicative ((<|>))
import           Control.Monad (void)
import           Data.Maybe (fromMaybe)
import           Prelude
#ifdef WASM
import           Control.Monad (unless)
import           Data.IORef (IORef, newIORef, readIORef, atomicWriteIORef)
import           System.IO.Unsafe (unsafePerformIO)
#endif
-----------------------------------------------------------------------------
import           Miso.DSL
#ifdef WASM
import           Miso.DSL.TH.File (evalFile)
#endif
import           Miso.Effect (DOMRef)
import           Miso.JSON
  ( FromJSON (..)
  , ToJSON (..)
  , Value (Bool, String)
  , decode
  , encode
  , object
  , withObject
  , (.:)
  , (.:?)
  , (.=)
  )
import           Miso.String (MisoString)
-----------------------------------------------------------------------------
import           Miso.Flow.Internal.JSNum (jsShow)
import           Miso.Flow.Types
-----------------------------------------------------------------------------
-- | Handle to a JavaScript-side @MisoFlowStore@.
newtype FlowStore = FlowStore JSVal
-----------------------------------------------------------------------------
-- | A component holds at most one store for its whole lifetime, so all
-- handles are interchangeable; this lets models containing a 'FlowStore'
-- satisfy the @Eq model@ constraint of the miso runtime.
instance Eq FlowStore where
  FlowStore
_ == :: FlowStore -> FlowStore -> Bool
== FlowStore
_ = Bool
True
-----------------------------------------------------------------------------
-- | Options handed to the JavaScript store; mirrors the union of pane,
-- drag and connection settings across @\@xyflow\/system@'s modules.
data StoreOptions = StoreOptions
  { StoreOptions -> MisoString
soFlowId                  :: MisoString
  , StoreOptions -> MisoString
soLib                     :: MisoString
  , StoreOptions -> Double
soMinZoom                 :: Double
  , StoreOptions -> Double
soMaxZoom                 :: Double
  , StoreOptions -> Maybe CoordinateExtent
soTranslateExtent         :: Maybe CoordinateExtent
  , StoreOptions -> Maybe CoordinateExtent
soNodeExtent              :: Maybe CoordinateExtent
  , StoreOptions -> NodeOrigin
soNodeOrigin              :: NodeOrigin
  , StoreOptions -> Viewport
soDefaultViewport         :: Viewport
  , StoreOptions -> Bool
soSnapToGrid              :: Bool
  , StoreOptions -> SnapGrid
soSnapGrid                :: SnapGrid
  , StoreOptions -> Bool
soElevateNodesOnSelect    :: Bool
  , StoreOptions -> ZIndexMode
soZIndexMode              :: ZIndexMode
  , StoreOptions -> Bool
soNodesDraggable          :: Bool
  , StoreOptions -> Bool
soAutoPanOnNodeDrag       :: Bool
  , StoreOptions -> Bool
soAutoPanOnConnect        :: Bool
  , StoreOptions -> Double
soAutoPanSpeed            :: Double
  , StoreOptions -> Double
soNodeDragThreshold       :: Double
  , StoreOptions -> Double
soNodeClickDistance       :: Double
  , StoreOptions -> Bool
soSelectNodesOnDrag       :: Bool
  , StoreOptions -> ConnectionMode
soConnectionMode          :: ConnectionMode
  , StoreOptions -> Double
soConnectionRadius        :: Double
  , StoreOptions -> Double
soConnectionDragThreshold :: Double
  , StoreOptions -> PanOnDrag
soPanOnDrag               :: PanOnDrag
  , StoreOptions -> Bool
soPanOnScroll             :: Bool
  , StoreOptions -> PanOnScrollMode
soPanOnScrollMode         :: PanOnScrollMode
  , StoreOptions -> Double
soPanOnScrollSpeed        :: Double
  , StoreOptions -> Bool
soZoomOnScroll            :: Bool
  , StoreOptions -> Bool
soZoomOnPinch             :: Bool
  , StoreOptions -> Bool
soZoomOnDoubleClick       :: Bool
  , StoreOptions -> Bool
soPreventScrolling        :: Bool
  , StoreOptions -> Double
soPaneClickDistance       :: Double
  } deriving (Int -> StoreOptions -> ShowS
[StoreOptions] -> ShowS
StoreOptions -> String
(Int -> StoreOptions -> ShowS)
-> (StoreOptions -> String)
-> ([StoreOptions] -> ShowS)
-> Show StoreOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoreOptions -> ShowS
showsPrec :: Int -> StoreOptions -> ShowS
$cshow :: StoreOptions -> String
show :: StoreOptions -> String
$cshowList :: [StoreOptions] -> ShowS
showList :: [StoreOptions] -> ShowS
Show, StoreOptions -> StoreOptions -> Bool
(StoreOptions -> StoreOptions -> Bool)
-> (StoreOptions -> StoreOptions -> Bool) -> Eq StoreOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreOptions -> StoreOptions -> Bool
== :: StoreOptions -> StoreOptions -> Bool
$c/= :: StoreOptions -> StoreOptions -> Bool
/= :: StoreOptions -> StoreOptions -> Bool
Eq)
-----------------------------------------------------------------------------
-- | Defaults matching xyflow's.
defaultStoreOptions :: StoreOptions
defaultStoreOptions :: StoreOptions
defaultStoreOptions = StoreOptions
  { soFlowId :: MisoString
soFlowId = MisoString
"1"
  , soLib :: MisoString
soLib = MisoString
"miso"
  , soMinZoom :: Double
soMinZoom = Double
0.5
  , soMaxZoom :: Double
soMaxZoom = Double
2
  , soTranslateExtent :: Maybe CoordinateExtent
soTranslateExtent = Maybe CoordinateExtent
forall a. Maybe a
Nothing
  , soNodeExtent :: Maybe CoordinateExtent
soNodeExtent = Maybe CoordinateExtent
forall a. Maybe a
Nothing
  , soNodeOrigin :: NodeOrigin
soNodeOrigin = NodeOrigin
defaultOrigin
  , soDefaultViewport :: Viewport
soDefaultViewport = Viewport
defaultViewport
  , soSnapToGrid :: Bool
soSnapToGrid = Bool
False
  , soSnapGrid :: SnapGrid
soSnapGrid = Double -> Double -> SnapGrid
SnapGrid Double
15 Double
15
  , soElevateNodesOnSelect :: Bool
soElevateNodesOnSelect = Bool
True
  , soZIndexMode :: ZIndexMode
soZIndexMode = ZIndexMode
ZIndexBasic
  , soNodesDraggable :: Bool
soNodesDraggable = Bool
True
  , soAutoPanOnNodeDrag :: Bool
soAutoPanOnNodeDrag = Bool
True
  , soAutoPanOnConnect :: Bool
soAutoPanOnConnect = Bool
True
  , soAutoPanSpeed :: Double
soAutoPanSpeed = Double
15
  , soNodeDragThreshold :: Double
soNodeDragThreshold = Double
1
  , soNodeClickDistance :: Double
soNodeClickDistance = Double
0
  , soSelectNodesOnDrag :: Bool
soSelectNodesOnDrag = Bool
True
  , soConnectionMode :: ConnectionMode
soConnectionMode = ConnectionMode
ConnectionModeStrict
  , soConnectionRadius :: Double
soConnectionRadius = Double
20
  , soConnectionDragThreshold :: Double
soConnectionDragThreshold = Double
1
  , soPanOnDrag :: PanOnDrag
soPanOnDrag = Bool -> PanOnDrag
PanOnDrag Bool
True
  , soPanOnScroll :: Bool
soPanOnScroll = Bool
False
  , soPanOnScrollMode :: PanOnScrollMode
soPanOnScrollMode = PanOnScrollMode
PanOnScrollFree
  , soPanOnScrollSpeed :: Double
soPanOnScrollSpeed = Double
0.5
  , soZoomOnScroll :: Bool
soZoomOnScroll = Bool
True
  , soZoomOnPinch :: Bool
soZoomOnPinch = Bool
True
  , soZoomOnDoubleClick :: Bool
soZoomOnDoubleClick = Bool
True
  , soPreventScrolling :: Bool
soPreventScrolling = Bool
True
  , soPaneClickDistance :: Double
soPaneClickDistance = Double
0
  }
-----------------------------------------------------------------------------
instance ToJSON StoreOptions where
  toJSON :: StoreOptions -> Value
toJSON StoreOptions {Bool
Double
Maybe CoordinateExtent
MisoString
ConnectionMode
NodeOrigin
PanOnDrag
PanOnScrollMode
SnapGrid
Viewport
ZIndexMode
soFlowId :: StoreOptions -> MisoString
soLib :: StoreOptions -> MisoString
soMinZoom :: StoreOptions -> Double
soMaxZoom :: StoreOptions -> Double
soTranslateExtent :: StoreOptions -> Maybe CoordinateExtent
soNodeExtent :: StoreOptions -> Maybe CoordinateExtent
soNodeOrigin :: StoreOptions -> NodeOrigin
soDefaultViewport :: StoreOptions -> Viewport
soSnapToGrid :: StoreOptions -> Bool
soSnapGrid :: StoreOptions -> SnapGrid
soElevateNodesOnSelect :: StoreOptions -> Bool
soZIndexMode :: StoreOptions -> ZIndexMode
soNodesDraggable :: StoreOptions -> Bool
soAutoPanOnNodeDrag :: StoreOptions -> Bool
soAutoPanOnConnect :: StoreOptions -> Bool
soAutoPanSpeed :: StoreOptions -> Double
soNodeDragThreshold :: StoreOptions -> Double
soNodeClickDistance :: StoreOptions -> Double
soSelectNodesOnDrag :: StoreOptions -> Bool
soConnectionMode :: StoreOptions -> ConnectionMode
soConnectionRadius :: StoreOptions -> Double
soConnectionDragThreshold :: StoreOptions -> Double
soPanOnDrag :: StoreOptions -> PanOnDrag
soPanOnScroll :: StoreOptions -> Bool
soPanOnScrollMode :: StoreOptions -> PanOnScrollMode
soPanOnScrollSpeed :: StoreOptions -> Double
soZoomOnScroll :: StoreOptions -> Bool
soZoomOnPinch :: StoreOptions -> Bool
soZoomOnDoubleClick :: StoreOptions -> Bool
soPreventScrolling :: StoreOptions -> Bool
soPaneClickDistance :: StoreOptions -> Double
soFlowId :: MisoString
soLib :: MisoString
soMinZoom :: Double
soMaxZoom :: Double
soTranslateExtent :: Maybe CoordinateExtent
soNodeExtent :: Maybe CoordinateExtent
soNodeOrigin :: NodeOrigin
soDefaultViewport :: Viewport
soSnapToGrid :: Bool
soSnapGrid :: SnapGrid
soElevateNodesOnSelect :: Bool
soZIndexMode :: ZIndexMode
soNodesDraggable :: Bool
soAutoPanOnNodeDrag :: Bool
soAutoPanOnConnect :: Bool
soAutoPanSpeed :: Double
soNodeDragThreshold :: Double
soNodeClickDistance :: Double
soSelectNodesOnDrag :: Bool
soConnectionMode :: ConnectionMode
soConnectionRadius :: Double
soConnectionDragThreshold :: Double
soPanOnDrag :: PanOnDrag
soPanOnScroll :: Bool
soPanOnScrollMode :: PanOnScrollMode
soPanOnScrollSpeed :: Double
soZoomOnScroll :: Bool
soZoomOnPinch :: Bool
soZoomOnDoubleClick :: Bool
soPreventScrolling :: Bool
soPaneClickDistance :: Double
..} = [Pair] -> Value
object
    [ MisoString
"flowId" MisoString -> MisoString -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= MisoString
soFlowId
    , MisoString
"lib" MisoString -> MisoString -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= MisoString
soLib
    , MisoString
"minZoom" MisoString -> Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Double
soMinZoom
    , MisoString
"maxZoom" MisoString -> Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Double
soMaxZoom
    , MisoString
"translateExtent" MisoString -> Maybe CoordinateExtent -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Maybe CoordinateExtent
soTranslateExtent
    , MisoString
"nodeExtent" MisoString -> Maybe CoordinateExtent -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Maybe CoordinateExtent
soNodeExtent
    , MisoString
"nodeOrigin" MisoString -> NodeOrigin -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= NodeOrigin
soNodeOrigin
    , MisoString
"defaultViewport" MisoString -> Viewport -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Viewport
soDefaultViewport
    , MisoString
"snapToGrid" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soSnapToGrid
    , MisoString
"snapGrid" MisoString -> SnapGrid -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= SnapGrid
soSnapGrid
    , MisoString
"elevateNodesOnSelect" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soElevateNodesOnSelect
    , MisoString
"zIndexMode" MisoString -> ZIndexMode -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= ZIndexMode
soZIndexMode
    , MisoString
"nodesDraggable" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soNodesDraggable
    , MisoString
"autoPanOnNodeDrag" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soAutoPanOnNodeDrag
    , MisoString
"autoPanOnConnect" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soAutoPanOnConnect
    , MisoString
"autoPanSpeed" MisoString -> Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Double
soAutoPanSpeed
    , MisoString
"nodeDragThreshold" MisoString -> Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Double
soNodeDragThreshold
    , MisoString
"nodeClickDistance" MisoString -> Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Double
soNodeClickDistance
    , MisoString
"selectNodesOnDrag" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soSelectNodesOnDrag
    , MisoString
"connectionMode" MisoString -> ConnectionMode -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= ConnectionMode
soConnectionMode
    , MisoString
"connectionRadius" MisoString -> Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Double
soConnectionRadius
    , MisoString
"connectionDragThreshold" MisoString -> Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Double
soConnectionDragThreshold
    , MisoString
"panOnDrag" MisoString -> PanOnDrag -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= PanOnDrag
soPanOnDrag
    , MisoString
"panOnScroll" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soPanOnScroll
    , MisoString
"panOnScrollMode" MisoString -> PanOnScrollMode -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= PanOnScrollMode
soPanOnScrollMode
    , MisoString
"panOnScrollSpeed" MisoString -> Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Double
soPanOnScrollSpeed
    , MisoString
"zoomOnScroll" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soZoomOnScroll
    , MisoString
"zoomOnPinch" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soZoomOnPinch
    , MisoString
"zoomOnDoubleClick" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soZoomOnDoubleClick
    , MisoString
"preventScrolling" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
soPreventScrolling
    , MisoString
"paneClickDistance" MisoString -> Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Double
soPaneClickDistance
    ]
-----------------------------------------------------------------------------
-- | One node change as reported by the JavaScript side (drag steps,
-- measurements, resizes). Unlike 'NodeChange' this can carry the
-- DOM-measured handle bounds and absolute position.
data WireNodeChange
  = WirePositionChange NodeId (Maybe XYPosition) (Maybe XYPosition) (Maybe Bool)
    -- ^ id, position, positionAbsolute, dragging
  | WireDimensionChange NodeId (Maybe Dimensions) (Maybe Bool) SetAttributes
      (Maybe NodeHandleBounds) (Maybe XYPosition)
    -- ^ id, dimensions, resizing, setAttributes, handleBounds, positionAbsolute
  | WireSelectionChange NodeId Bool
  | WireRemoveChange NodeId
  deriving (Int -> WireNodeChange -> ShowS
[WireNodeChange] -> ShowS
WireNodeChange -> String
(Int -> WireNodeChange -> ShowS)
-> (WireNodeChange -> String)
-> ([WireNodeChange] -> ShowS)
-> Show WireNodeChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WireNodeChange -> ShowS
showsPrec :: Int -> WireNodeChange -> ShowS
$cshow :: WireNodeChange -> String
show :: WireNodeChange -> String
$cshowList :: [WireNodeChange] -> ShowS
showList :: [WireNodeChange] -> ShowS
Show, WireNodeChange -> WireNodeChange -> Bool
(WireNodeChange -> WireNodeChange -> Bool)
-> (WireNodeChange -> WireNodeChange -> Bool) -> Eq WireNodeChange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WireNodeChange -> WireNodeChange -> Bool
== :: WireNodeChange -> WireNodeChange -> Bool
$c/= :: WireNodeChange -> WireNodeChange -> Bool
/= :: WireNodeChange -> WireNodeChange -> Bool
Eq)
-----------------------------------------------------------------------------
instance FromJSON WireNodeChange where
  parseJSON :: Value -> Parser WireNodeChange
parseJSON = MisoString
-> (Object -> Parser WireNodeChange)
-> Value
-> Parser WireNodeChange
forall a. MisoString -> (Object -> Parser a) -> Value -> Parser a
withObject MisoString
"WireNodeChange" ((Object -> Parser WireNodeChange)
 -> Value -> Parser WireNodeChange)
-> (Object -> Parser WireNodeChange)
-> Value
-> Parser WireNodeChange
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    ty <- Object
o Object -> MisoString -> Parser MisoString
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"type"
    case ty :: MisoString of
      MisoString
"position" ->
        MisoString
-> Maybe XYPosition
-> Maybe XYPosition
-> Maybe Bool
-> WireNodeChange
WirePositionChange
          (MisoString
 -> Maybe XYPosition
 -> Maybe XYPosition
 -> Maybe Bool
 -> WireNodeChange)
-> Parser MisoString
-> Parser
     (Maybe XYPosition
      -> Maybe XYPosition -> Maybe Bool -> WireNodeChange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> MisoString -> Parser MisoString
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"id"
          Parser
  (Maybe XYPosition
   -> Maybe XYPosition -> Maybe Bool -> WireNodeChange)
-> Parser (Maybe XYPosition)
-> Parser (Maybe XYPosition -> Maybe Bool -> WireNodeChange)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe XYPosition)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"position"
          Parser (Maybe XYPosition -> Maybe Bool -> WireNodeChange)
-> Parser (Maybe XYPosition)
-> Parser (Maybe Bool -> WireNodeChange)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe XYPosition)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"positionAbsolute"
          Parser (Maybe Bool -> WireNodeChange)
-> Parser (Maybe Bool) -> Parser WireNodeChange
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"dragging"
      MisoString
"dimensions" ->
        MisoString
-> Maybe Dimensions
-> Maybe Bool
-> SetAttributes
-> Maybe NodeHandleBounds
-> Maybe XYPosition
-> WireNodeChange
WireDimensionChange
          (MisoString
 -> Maybe Dimensions
 -> Maybe Bool
 -> SetAttributes
 -> Maybe NodeHandleBounds
 -> Maybe XYPosition
 -> WireNodeChange)
-> Parser MisoString
-> Parser
     (Maybe Dimensions
      -> Maybe Bool
      -> SetAttributes
      -> Maybe NodeHandleBounds
      -> Maybe XYPosition
      -> WireNodeChange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> MisoString -> Parser MisoString
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"id"
          Parser
  (Maybe Dimensions
   -> Maybe Bool
   -> SetAttributes
   -> Maybe NodeHandleBounds
   -> Maybe XYPosition
   -> WireNodeChange)
-> Parser (Maybe Dimensions)
-> Parser
     (Maybe Bool
      -> SetAttributes
      -> Maybe NodeHandleBounds
      -> Maybe XYPosition
      -> WireNodeChange)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe Dimensions)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"dimensions"
          Parser
  (Maybe Bool
   -> SetAttributes
   -> Maybe NodeHandleBounds
   -> Maybe XYPosition
   -> WireNodeChange)
-> Parser (Maybe Bool)
-> Parser
     (SetAttributes
      -> Maybe NodeHandleBounds -> Maybe XYPosition -> WireNodeChange)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"resizing"
          Parser
  (SetAttributes
   -> Maybe NodeHandleBounds -> Maybe XYPosition -> WireNodeChange)
-> Parser SetAttributes
-> Parser
     (Maybe NodeHandleBounds -> Maybe XYPosition -> WireNodeChange)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Value -> SetAttributes
parseSetAttributes (Maybe Value -> SetAttributes)
-> Parser (Maybe Value) -> Parser SetAttributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> MisoString -> Parser (Maybe Value)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"setAttributes")
          Parser
  (Maybe NodeHandleBounds -> Maybe XYPosition -> WireNodeChange)
-> Parser (Maybe NodeHandleBounds)
-> Parser (Maybe XYPosition -> WireNodeChange)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe NodeHandleBounds)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"handleBounds"
          Parser (Maybe XYPosition -> WireNodeChange)
-> Parser (Maybe XYPosition) -> Parser WireNodeChange
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe XYPosition)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"positionAbsolute"
      MisoString
"select" ->
        MisoString -> Bool -> WireNodeChange
WireSelectionChange (MisoString -> Bool -> WireNodeChange)
-> Parser MisoString -> Parser (Bool -> WireNodeChange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> MisoString -> Parser MisoString
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"id" Parser (Bool -> WireNodeChange)
-> Parser Bool -> Parser WireNodeChange
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser Bool
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"selected"
      MisoString
"remove" ->
        MisoString -> WireNodeChange
WireRemoveChange (MisoString -> WireNodeChange)
-> Parser MisoString -> Parser WireNodeChange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> MisoString -> Parser MisoString
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"id"
      MisoString
_ -> String -> Parser WireNodeChange
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown node change type"
    where
      parseSetAttributes :: Maybe Value -> SetAttributes
parseSetAttributes = \case
        Maybe Value
Nothing -> SetAttributes
SetAttributesNone
        Just (Bool Bool
True) -> SetAttributes
SetAttributesBoth
        Just (Bool Bool
False) -> SetAttributes
SetAttributesNone
        Just (String MisoString
"width") -> SetAttributes
SetAttributesWidth
        Just (String MisoString
"height") -> SetAttributes
SetAttributesHeight
        Just Value
_ -> SetAttributes
SetAttributesNone
-----------------------------------------------------------------------------
-- | Connection state as serialized by the bridge: nodes are referred to
-- by id (resolve them against your 'NodeLookup' via
-- 'wireConnectionState'). Mirroring @\@xyflow\/system@, 'cwFrom' is in
-- flow coordinates while 'cwTo' and 'cwPointer' arrive in pane (screen)
-- coordinates — convert them with
-- 'Miso.Flow.Utils.General.pointToRendererPoint' before rendering.
data ConnectionStateWire = ConnectionStateWire
  { ConnectionStateWire -> Bool
cwInProgress   :: Bool
  , ConnectionStateWire -> Maybe Bool
cwIsValid      :: Maybe Bool
  , ConnectionStateWire -> Maybe XYPosition
cwFrom         :: Maybe XYPosition
  , ConnectionStateWire -> Maybe Handle
cwFromHandle   :: Maybe Handle
  , ConnectionStateWire -> Maybe Position
cwFromPosition :: Maybe Position
  , ConnectionStateWire -> Maybe MisoString
cwFromNode     :: Maybe NodeId
  , ConnectionStateWire -> Maybe XYPosition
cwTo           :: Maybe XYPosition
  , ConnectionStateWire -> Maybe Handle
cwToHandle     :: Maybe Handle
  , ConnectionStateWire -> Maybe Position
cwToPosition   :: Maybe Position
  , ConnectionStateWire -> Maybe MisoString
cwToNode       :: Maybe NodeId
  , ConnectionStateWire -> Maybe XYPosition
cwPointer      :: Maybe XYPosition
  } deriving (Int -> ConnectionStateWire -> ShowS
[ConnectionStateWire] -> ShowS
ConnectionStateWire -> String
(Int -> ConnectionStateWire -> ShowS)
-> (ConnectionStateWire -> String)
-> ([ConnectionStateWire] -> ShowS)
-> Show ConnectionStateWire
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionStateWire -> ShowS
showsPrec :: Int -> ConnectionStateWire -> ShowS
$cshow :: ConnectionStateWire -> String
show :: ConnectionStateWire -> String
$cshowList :: [ConnectionStateWire] -> ShowS
showList :: [ConnectionStateWire] -> ShowS
Show, ConnectionStateWire -> ConnectionStateWire -> Bool
(ConnectionStateWire -> ConnectionStateWire -> Bool)
-> (ConnectionStateWire -> ConnectionStateWire -> Bool)
-> Eq ConnectionStateWire
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionStateWire -> ConnectionStateWire -> Bool
== :: ConnectionStateWire -> ConnectionStateWire -> Bool
$c/= :: ConnectionStateWire -> ConnectionStateWire -> Bool
/= :: ConnectionStateWire -> ConnectionStateWire -> Bool
Eq)
-----------------------------------------------------------------------------
instance FromJSON ConnectionStateWire where
  parseJSON :: Value -> Parser ConnectionStateWire
parseJSON = MisoString
-> (Object -> Parser ConnectionStateWire)
-> Value
-> Parser ConnectionStateWire
forall a. MisoString -> (Object -> Parser a) -> Value -> Parser a
withObject MisoString
"ConnectionStateWire" ((Object -> Parser ConnectionStateWire)
 -> Value -> Parser ConnectionStateWire)
-> (Object -> Parser ConnectionStateWire)
-> Value
-> Parser ConnectionStateWire
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Bool
-> Maybe Bool
-> Maybe XYPosition
-> Maybe Handle
-> Maybe Position
-> Maybe MisoString
-> Maybe XYPosition
-> Maybe Handle
-> Maybe Position
-> Maybe MisoString
-> Maybe XYPosition
-> ConnectionStateWire
ConnectionStateWire
      (Bool
 -> Maybe Bool
 -> Maybe XYPosition
 -> Maybe Handle
 -> Maybe Position
 -> Maybe MisoString
 -> Maybe XYPosition
 -> Maybe Handle
 -> Maybe Position
 -> Maybe MisoString
 -> Maybe XYPosition
 -> ConnectionStateWire)
-> Parser Bool
-> Parser
     (Maybe Bool
      -> Maybe XYPosition
      -> Maybe Handle
      -> Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> Maybe Handle
      -> Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> ConnectionStateWire)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> MisoString -> Parser Bool
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"inProgress" Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
      Parser
  (Maybe Bool
   -> Maybe XYPosition
   -> Maybe Handle
   -> Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> Maybe Handle
   -> Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> ConnectionStateWire)
-> Parser (Maybe Bool)
-> Parser
     (Maybe XYPosition
      -> Maybe Handle
      -> Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> Maybe Handle
      -> Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> ConnectionStateWire)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"isValid"
      Parser
  (Maybe XYPosition
   -> Maybe Handle
   -> Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> Maybe Handle
   -> Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> ConnectionStateWire)
-> Parser (Maybe XYPosition)
-> Parser
     (Maybe Handle
      -> Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> Maybe Handle
      -> Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> ConnectionStateWire)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe XYPosition)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"from"
      Parser
  (Maybe Handle
   -> Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> Maybe Handle
   -> Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> ConnectionStateWire)
-> Parser (Maybe Handle)
-> Parser
     (Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> Maybe Handle
      -> Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> ConnectionStateWire)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe Handle)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"fromHandle"
      Parser
  (Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> Maybe Handle
   -> Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> ConnectionStateWire)
-> Parser (Maybe Position)
-> Parser
     (Maybe MisoString
      -> Maybe XYPosition
      -> Maybe Handle
      -> Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> ConnectionStateWire)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe Position)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"fromPosition"
      Parser
  (Maybe MisoString
   -> Maybe XYPosition
   -> Maybe Handle
   -> Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> ConnectionStateWire)
-> Parser (Maybe MisoString)
-> Parser
     (Maybe XYPosition
      -> Maybe Handle
      -> Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> ConnectionStateWire)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe MisoString)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"fromNode"
      Parser
  (Maybe XYPosition
   -> Maybe Handle
   -> Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> ConnectionStateWire)
-> Parser (Maybe XYPosition)
-> Parser
     (Maybe Handle
      -> Maybe Position
      -> Maybe MisoString
      -> Maybe XYPosition
      -> ConnectionStateWire)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe XYPosition)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"to"
      Parser
  (Maybe Handle
   -> Maybe Position
   -> Maybe MisoString
   -> Maybe XYPosition
   -> ConnectionStateWire)
-> Parser (Maybe Handle)
-> Parser
     (Maybe Position
      -> Maybe MisoString -> Maybe XYPosition -> ConnectionStateWire)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe Handle)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"toHandle"
      Parser
  (Maybe Position
   -> Maybe MisoString -> Maybe XYPosition -> ConnectionStateWire)
-> Parser (Maybe Position)
-> Parser
     (Maybe MisoString -> Maybe XYPosition -> ConnectionStateWire)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe Position)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"toPosition"
      Parser
  (Maybe MisoString -> Maybe XYPosition -> ConnectionStateWire)
-> Parser (Maybe MisoString)
-> Parser (Maybe XYPosition -> ConnectionStateWire)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe MisoString)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"toNode"
      Parser (Maybe XYPosition -> ConnectionStateWire)
-> Parser (Maybe XYPosition) -> Parser ConnectionStateWire
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser (Maybe XYPosition)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"pointer"
-----------------------------------------------------------------------------
-- | Resolve a 'ConnectionStateWire' into a 'ConnectionState' using a
-- node resolver (typically a 'Data.Map.Strict.lookup' into your
-- 'NodeLookup').
wireConnectionState
  :: (NodeId -> Maybe (InternalNode n))
  -> ConnectionStateWire
  -> ConnectionState n
wireConnectionState :: forall n.
(MisoString -> Maybe (InternalNode n))
-> ConnectionStateWire -> ConnectionState n
wireConnectionState MisoString -> Maybe (InternalNode n)
resolve ConnectionStateWire {Bool
Maybe Bool
Maybe MisoString
Maybe Handle
Maybe Position
Maybe XYPosition
cwFrom :: ConnectionStateWire -> Maybe XYPosition
cwTo :: ConnectionStateWire -> Maybe XYPosition
cwPointer :: ConnectionStateWire -> Maybe XYPosition
cwInProgress :: ConnectionStateWire -> Bool
cwIsValid :: ConnectionStateWire -> Maybe Bool
cwFromHandle :: ConnectionStateWire -> Maybe Handle
cwFromPosition :: ConnectionStateWire -> Maybe Position
cwFromNode :: ConnectionStateWire -> Maybe MisoString
cwToHandle :: ConnectionStateWire -> Maybe Handle
cwToPosition :: ConnectionStateWire -> Maybe Position
cwToNode :: ConnectionStateWire -> Maybe MisoString
cwInProgress :: Bool
cwIsValid :: Maybe Bool
cwFrom :: Maybe XYPosition
cwFromHandle :: Maybe Handle
cwFromPosition :: Maybe Position
cwFromNode :: Maybe MisoString
cwTo :: Maybe XYPosition
cwToHandle :: Maybe Handle
cwToPosition :: Maybe Position
cwToNode :: Maybe MisoString
cwPointer :: Maybe XYPosition
..}
  | Bool
cwInProgress
  , Just XYPosition
from <- Maybe XYPosition
cwFrom
  , Just Handle
fromHandle <- Maybe Handle
cwFromHandle
  , Just Position
fromPosition <- Maybe Position
cwFromPosition
  , Just InternalNode n
fromNode <- MisoString -> Maybe (InternalNode n)
resolve (MisoString -> Maybe (InternalNode n))
-> Maybe MisoString -> Maybe (InternalNode n)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe MisoString
cwFromNode
  , Just XYPosition
to <- Maybe XYPosition
cwTo
  , Just Position
toPosition <- Maybe Position
cwToPosition
  , Just XYPosition
pointer <- Maybe XYPosition
cwPointer
  = ConnectionInProgress n -> ConnectionState n
forall n. ConnectionInProgress n -> ConnectionState n
InProgress ConnectionInProgress
      { cipIsValid :: Maybe Bool
cipIsValid = Maybe Bool
cwIsValid
      , cipFrom :: XYPosition
cipFrom = XYPosition
from
      , cipFromHandle :: Handle
cipFromHandle = Handle
fromHandle
      , cipFromPosition :: Position
cipFromPosition = Position
fromPosition
      , cipFromNode :: InternalNode n
cipFromNode = InternalNode n
fromNode
      , cipTo :: XYPosition
cipTo = XYPosition
to
      , cipToHandle :: Maybe Handle
cipToHandle = Maybe Handle
cwToHandle
      , cipToPosition :: Position
cipToPosition = Position
toPosition
      , cipToNode :: Maybe (InternalNode n)
cipToNode = MisoString -> Maybe (InternalNode n)
resolve (MisoString -> Maybe (InternalNode n))
-> Maybe MisoString -> Maybe (InternalNode n)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe MisoString
cwToNode
      , cipPointer :: XYPosition
cipPointer = XYPosition
pointer
      }
  | Bool
otherwise = ConnectionState n
forall n. ConnectionState n
NoConnection
-----------------------------------------------------------------------------
-- | Haskell handlers for events raised by the gesture system. Payloads
-- arrive parsed; hook the ones you need and leave the rest as no-ops
-- (see 'emptyBridgeCallbacks').
data BridgeCallbacks = BridgeCallbacks
  { BridgeCallbacks -> Viewport -> IO ()
bcViewport         :: Viewport -> IO ()
  , BridgeCallbacks -> Viewport -> IO ()
bcViewportStart    :: Viewport -> IO ()
  , BridgeCallbacks -> Viewport -> IO ()
bcViewportEnd      :: Viewport -> IO ()
  , BridgeCallbacks -> [WireNodeChange] -> IO ()
bcNodeChanges      :: [WireNodeChange] -> IO ()
  , BridgeCallbacks -> ConnectionStateWire -> IO ()
bcConnectionUpdate :: ConnectionStateWire -> IO ()
  , BridgeCallbacks -> OnConnectStartParams -> IO ()
bcConnectStart     :: OnConnectStartParams -> IO ()
  , BridgeCallbacks -> Connection -> IO ()
bcConnect          :: Connection -> IO ()
  , BridgeCallbacks -> ConnectionStateWire -> IO ()
bcConnectEnd       :: ConnectionStateWire -> IO ()
  , BridgeCallbacks -> MisoString -> Bool -> IO ()
bcNodeMouseDown    :: NodeId -> Bool -> IO ()
    -- ^ id and whether a multi-selection modifier was held
  , BridgeCallbacks -> IO ()
bcUnselectAll      :: IO ()
  , BridgeCallbacks -> IO ()
bcPaneClick        :: IO ()
  , BridgeCallbacks -> MisoString -> IO ()
bcNodeDragStart    :: NodeId -> IO ()
  , BridgeCallbacks -> MisoString -> IO ()
bcNodeDragStop     :: NodeId -> IO ()
  , BridgeCallbacks -> [WireNodeChange] -> IO ()
bcResizeChanges    :: [WireNodeChange] -> IO ()
  , BridgeCallbacks -> Dimensions -> IO ()
bcDimensions       :: Dimensions -> IO ()
    -- ^ container size, on creation and on resize
  , BridgeCallbacks -> Rect -> IO ()
bcSelectionRect    :: Rect -> IO ()
    -- ^ selection box changed (container coordinates)
  , BridgeCallbacks -> Rect -> IO ()
bcSelectionEnd     :: Rect -> IO ()
    -- ^ selection box released
  , BridgeCallbacks -> MisoString -> Connection -> IO ()
bcReconnect        :: EdgeId -> Connection -> IO ()
    -- ^ an edge anchor was dragged onto a new valid handle
  , BridgeCallbacks -> MisoString -> IO ()
bcResizeStart      :: NodeId -> IO ()
  , BridgeCallbacks -> MisoString -> IO ()
bcResizeEnd        :: NodeId -> IO ()
  , BridgeCallbacks -> XYPosition -> IO ()
bcMinimapClick     :: XYPosition -> IO ()
    -- ^ click on the minimap, in flow coordinates
  , BridgeCallbacks -> IO ()
bcDeleteKey        :: IO ()
    -- ^ Delete\/Backspace pressed outside an input
  , BridgeCallbacks -> MisoString -> MisoString -> IO ()
bcError            :: MisoString -> MisoString -> IO ()
  }
-----------------------------------------------------------------------------
emptyBridgeCallbacks :: BridgeCallbacks
emptyBridgeCallbacks :: BridgeCallbacks
emptyBridgeCallbacks = BridgeCallbacks
  { bcViewport :: Viewport -> IO ()
bcViewport = \Viewport
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcViewportStart :: Viewport -> IO ()
bcViewportStart = \Viewport
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcViewportEnd :: Viewport -> IO ()
bcViewportEnd = \Viewport
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcNodeChanges :: [WireNodeChange] -> IO ()
bcNodeChanges = \[WireNodeChange]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcConnectionUpdate :: ConnectionStateWire -> IO ()
bcConnectionUpdate = \ConnectionStateWire
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcConnectStart :: OnConnectStartParams -> IO ()
bcConnectStart = \OnConnectStartParams
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcConnect :: Connection -> IO ()
bcConnect = \Connection
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcConnectEnd :: ConnectionStateWire -> IO ()
bcConnectEnd = \ConnectionStateWire
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcNodeMouseDown :: MisoString -> Bool -> IO ()
bcNodeMouseDown = \MisoString
_ Bool
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcUnselectAll :: IO ()
bcUnselectAll = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcPaneClick :: IO ()
bcPaneClick = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcNodeDragStart :: MisoString -> IO ()
bcNodeDragStart = \MisoString
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcNodeDragStop :: MisoString -> IO ()
bcNodeDragStop = \MisoString
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcResizeChanges :: [WireNodeChange] -> IO ()
bcResizeChanges = \[WireNodeChange]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcDimensions :: Dimensions -> IO ()
bcDimensions = \Dimensions
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcSelectionRect :: Rect -> IO ()
bcSelectionRect = \Rect
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcSelectionEnd :: Rect -> IO ()
bcSelectionEnd = \Rect
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcReconnect :: MisoString -> Connection -> IO ()
bcReconnect = \MisoString
_ Connection
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcResizeStart :: MisoString -> IO ()
bcResizeStart = \MisoString
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcResizeEnd :: MisoString -> IO ()
bcResizeEnd = \MisoString
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcMinimapClick :: XYPosition -> IO ()
bcMinimapClick = \XYPosition
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcDeleteKey :: IO ()
bcDeleteKey = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  , bcError :: MisoString -> MisoString -> IO ()
bcError = \MisoString
_ MisoString
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  }
-----------------------------------------------------------------------------
-- | Wrap a JSON-payload handler as a JS callback.
jsonCallback :: FromJSON a => (a -> IO ()) -> IO JSVal
jsonCallback :: forall a. FromJSON a => (a -> IO ()) -> IO JSVal
jsonCallback a -> IO ()
handler =
  (JSVal -> IO ()) -> IO JSVal
asyncCallback1 ((JSVal -> IO ()) -> IO JSVal) -> (JSVal -> IO ()) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ \JSVal
payload -> do
    mStr <- JSVal -> IO (Maybe MisoString)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal JSVal
payload
    case decode =<< mStr of
      Just a
parsed -> a -> IO ()
handler a
parsed
      Maybe a
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
-----------------------------------------------------------------------------
newtype IdPayload = IdPayload NodeId
-----------------------------------------------------------------------------
instance FromJSON IdPayload where
  parseJSON :: Value -> Parser IdPayload
parseJSON = MisoString
-> (Object -> Parser IdPayload) -> Value -> Parser IdPayload
forall a. MisoString -> (Object -> Parser a) -> Value -> Parser a
withObject MisoString
"IdPayload" ((Object -> Parser IdPayload) -> Value -> Parser IdPayload)
-> (Object -> Parser IdPayload) -> Value -> Parser IdPayload
forall a b. (a -> b) -> a -> b
$ \Object
o -> MisoString -> IdPayload
IdPayload (MisoString -> IdPayload) -> Parser MisoString -> Parser IdPayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> MisoString -> Parser MisoString
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"id"
-----------------------------------------------------------------------------
data MouseDownPayload = MouseDownPayload NodeId Bool
-----------------------------------------------------------------------------
instance FromJSON MouseDownPayload where
  parseJSON :: Value -> Parser MouseDownPayload
parseJSON = MisoString
-> (Object -> Parser MouseDownPayload)
-> Value
-> Parser MouseDownPayload
forall a. MisoString -> (Object -> Parser a) -> Value -> Parser a
withObject MisoString
"MouseDownPayload" ((Object -> Parser MouseDownPayload)
 -> Value -> Parser MouseDownPayload)
-> (Object -> Parser MouseDownPayload)
-> Value
-> Parser MouseDownPayload
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    MisoString -> Bool -> MouseDownPayload
MouseDownPayload
      (MisoString -> Bool -> MouseDownPayload)
-> Parser MisoString -> Parser (Bool -> MouseDownPayload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> MisoString -> Parser MisoString
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"id"
      Parser (Bool -> MouseDownPayload)
-> Parser Bool -> Parser MouseDownPayload
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> MisoString -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> MisoString -> Parser (Maybe a)
.:? MisoString
"multi")
-----------------------------------------------------------------------------
data ReconnectPayload = ReconnectPayload EdgeId Connection
-----------------------------------------------------------------------------
instance FromJSON ReconnectPayload where
  parseJSON :: Value -> Parser ReconnectPayload
parseJSON = MisoString
-> (Object -> Parser ReconnectPayload)
-> Value
-> Parser ReconnectPayload
forall a. MisoString -> (Object -> Parser a) -> Value -> Parser a
withObject MisoString
"ReconnectPayload" ((Object -> Parser ReconnectPayload)
 -> Value -> Parser ReconnectPayload)
-> (Object -> Parser ReconnectPayload)
-> Value
-> Parser ReconnectPayload
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    MisoString -> Connection -> ReconnectPayload
ReconnectPayload
      (MisoString -> Connection -> ReconnectPayload)
-> Parser MisoString -> Parser (Connection -> ReconnectPayload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> MisoString -> Parser MisoString
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"edgeId"
      Parser (Connection -> ReconnectPayload)
-> Parser Connection -> Parser ReconnectPayload
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> MisoString -> Parser Connection
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"connection"
-----------------------------------------------------------------------------
#ifdef WASM
-- The WASM linker has no @js-sources@ support, so the bridge is spliced
-- in as a JSFFI snippet and evaluated once, on the first store.
bridgeLoaded :: IORef Bool
{-# NOINLINE bridgeLoaded #-}
bridgeLoaded = unsafePerformIO (newIORef False)
#endif

-- | Create a JavaScript store over the flow's root element. Expects the
-- element to contain a pane (@.\<lib\>-flow__pane@) and a viewport
-- (@.xyflow__viewport@), as rendered by 'Miso.Flow.View.flowView'.
--
-- Requires @js\/miso-flow.js@ (it defines @globalThis.MisoFlow@). On
-- the GHCJS\/JS backends the library's @js-sources@ links it into the
-- compiled output; on WASM it is spliced in at compile time and
-- evaluated here on first use.
createFlowStore
  :: DOMRef
  -> StoreOptions
  -> Maybe (Connection -> Bool)
  -- ^ synchronous connection validator (XYHandle consults it while the
  -- pointer moves, so it cannot go through the action queue)
  -> BridgeCallbacks
  -> IO FlowStore
createFlowStore :: JSVal
-> StoreOptions
-> Maybe (Connection -> Bool)
-> BridgeCallbacks
-> IO FlowStore
createFlowStore JSVal
domRef StoreOptions
options Maybe (Connection -> Bool)
mValidate BridgeCallbacks {IO ()
[WireNodeChange] -> IO ()
MisoString -> IO ()
MisoString -> Bool -> IO ()
MisoString -> MisoString -> IO ()
MisoString -> Connection -> IO ()
Connection -> IO ()
Dimensions -> IO ()
OnConnectStartParams -> IO ()
Rect -> IO ()
Viewport -> IO ()
XYPosition -> IO ()
ConnectionStateWire -> IO ()
bcViewport :: BridgeCallbacks -> Viewport -> IO ()
bcViewportStart :: BridgeCallbacks -> Viewport -> IO ()
bcViewportEnd :: BridgeCallbacks -> Viewport -> IO ()
bcNodeChanges :: BridgeCallbacks -> [WireNodeChange] -> IO ()
bcConnectionUpdate :: BridgeCallbacks -> ConnectionStateWire -> IO ()
bcConnectStart :: BridgeCallbacks -> OnConnectStartParams -> IO ()
bcConnect :: BridgeCallbacks -> Connection -> IO ()
bcConnectEnd :: BridgeCallbacks -> ConnectionStateWire -> IO ()
bcNodeMouseDown :: BridgeCallbacks -> MisoString -> Bool -> IO ()
bcUnselectAll :: BridgeCallbacks -> IO ()
bcPaneClick :: BridgeCallbacks -> IO ()
bcNodeDragStart :: BridgeCallbacks -> MisoString -> IO ()
bcNodeDragStop :: BridgeCallbacks -> MisoString -> IO ()
bcResizeChanges :: BridgeCallbacks -> [WireNodeChange] -> IO ()
bcDimensions :: BridgeCallbacks -> Dimensions -> IO ()
bcSelectionRect :: BridgeCallbacks -> Rect -> IO ()
bcSelectionEnd :: BridgeCallbacks -> Rect -> IO ()
bcReconnect :: BridgeCallbacks -> MisoString -> Connection -> IO ()
bcResizeStart :: BridgeCallbacks -> MisoString -> IO ()
bcResizeEnd :: BridgeCallbacks -> MisoString -> IO ()
bcMinimapClick :: BridgeCallbacks -> XYPosition -> IO ()
bcDeleteKey :: BridgeCallbacks -> IO ()
bcError :: BridgeCallbacks -> MisoString -> MisoString -> IO ()
bcViewport :: Viewport -> IO ()
bcViewportStart :: Viewport -> IO ()
bcViewportEnd :: Viewport -> IO ()
bcNodeChanges :: [WireNodeChange] -> IO ()
bcConnectionUpdate :: ConnectionStateWire -> IO ()
bcConnectStart :: OnConnectStartParams -> IO ()
bcConnect :: Connection -> IO ()
bcConnectEnd :: ConnectionStateWire -> IO ()
bcNodeMouseDown :: MisoString -> Bool -> IO ()
bcUnselectAll :: IO ()
bcPaneClick :: IO ()
bcNodeDragStart :: MisoString -> IO ()
bcNodeDragStop :: MisoString -> IO ()
bcResizeChanges :: [WireNodeChange] -> IO ()
bcDimensions :: Dimensions -> IO ()
bcSelectionRect :: Rect -> IO ()
bcSelectionEnd :: Rect -> IO ()
bcReconnect :: MisoString -> Connection -> IO ()
bcResizeStart :: MisoString -> IO ()
bcResizeEnd :: MisoString -> IO ()
bcMinimapClick :: XYPosition -> IO ()
bcDeleteKey :: IO ()
bcError :: MisoString -> MisoString -> IO ()
..} = do
#ifdef WASM
  loaded <- readIORef bridgeLoaded
  unless loaded $(evalFile "js/miso-flow.js")
  atomicWriteIORef bridgeLoaded True
#endif
  onViewport <- (Viewport -> IO ()) -> IO JSVal
forall a. FromJSON a => (a -> IO ()) -> IO JSVal
jsonCallback Viewport -> IO ()
bcViewport
  onViewportStart <- jsonCallback bcViewportStart
  onViewportEnd <- jsonCallback bcViewportEnd
  onNodeChanges <- jsonCallback bcNodeChanges
  onConnectionUpdate <- jsonCallback bcConnectionUpdate
  onConnectStart <- jsonCallback bcConnectStart
  onConnect <- jsonCallback bcConnect
  onConnectEnd <- jsonCallback bcConnectEnd
  onNodeMouseDown <- jsonCallback (\(MouseDownPayload MisoString
i Bool
multi) -> MisoString -> Bool -> IO ()
bcNodeMouseDown MisoString
i Bool
multi)
  onUnselect <- asyncCallback1 (\JSVal
_ -> IO ()
bcUnselectAll)
  onPaneClick <- asyncCallback1 (\JSVal
_ -> IO ()
bcPaneClick)
  onNodeDragStart <- jsonCallback (\(IdPayload MisoString
i) -> MisoString -> IO ()
bcNodeDragStart MisoString
i)
  onNodeDragStop <- jsonCallback (\(IdPayload MisoString
i) -> MisoString -> IO ()
bcNodeDragStop MisoString
i)
  onResizeChanges <- jsonCallback bcResizeChanges
  onDimensions <- jsonCallback bcDimensions
  onSelectionRect <- jsonCallback bcSelectionRect
  onSelectionEnd <- jsonCallback bcSelectionEnd
  onReconnect <- jsonCallback (\(ReconnectPayload MisoString
eid Connection
c) -> MisoString -> Connection -> IO ()
bcReconnect MisoString
eid Connection
c)
  onResizeStart <- jsonCallback (\(IdPayload MisoString
i) -> MisoString -> IO ()
bcResizeStart MisoString
i)
  onResizeEnd <- jsonCallback (\(IdPayload MisoString
i) -> MisoString -> IO ()
bcResizeEnd MisoString
i)
  onMinimapClick <- jsonCallback bcMinimapClick
  onDeleteKey <- asyncCallback1 (\JSVal
_ -> IO ()
bcDeleteKey)
  validator <- case mValidate of
    Maybe (Connection -> Bool)
Nothing -> Maybe JSVal -> IO (Maybe JSVal)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe JSVal
forall a. Maybe a
Nothing
    Just Connection -> Bool
f ->
      (JSVal -> Maybe JSVal) -> IO JSVal -> IO (Maybe JSVal)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JSVal -> Maybe JSVal
forall a. a -> Maybe a
Just (IO JSVal -> IO (Maybe JSVal)) -> IO JSVal -> IO (Maybe JSVal)
forall a b. (a -> b) -> a -> b
$ (JSVal -> IO JSVal) -> IO JSVal
syncCallback1' ((JSVal -> IO JSVal) -> IO JSVal)
-> (JSVal -> IO JSVal) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ \JSVal
payload -> do
        mStr <- JSVal -> IO (Maybe MisoString)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal JSVal
payload
        toJSVal $ case decode =<< mStr of
          Just Connection
conn -> Connection -> Bool
f Connection
conn
          Maybe Connection
Nothing -> Bool
True
  onError <- asyncCallback2 $ \JSVal
code JSVal
msg -> do
    mCode <- JSVal -> IO (Maybe MisoString)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal JSVal
code
    mMsg <- fromJSVal msg
    case (mCode, mMsg) of
      (Just MisoString
c, Just MisoString
m) -> MisoString -> MisoString -> IO ()
bcError MisoString
c MisoString
m
      (Maybe MisoString, Maybe MisoString)
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  callbacks <- createWith
    [ ("onViewport", onViewport)
    , ("onViewportStart", onViewportStart)
    , ("onViewportEnd", onViewportEnd)
    , ("onNodeChanges", onNodeChanges)
    , ("onConnectionUpdate", onConnectionUpdate)
    , ("onConnectStart", onConnectStart)
    , ("onConnect", onConnect)
    , ("onConnectEnd", onConnectEnd)
    , ("onNodeMouseDown", onNodeMouseDown)
    , ("onUnselectNodesAndEdges", onUnselect)
    , ("onPaneClick", onPaneClick)
    , ("onNodeDragStart", onNodeDragStart)
    , ("onNodeDragStop", onNodeDragStop)
    , ("onResizeChanges", onResizeChanges)
    , ("onDimensions", onDimensions)
    , ("onSelectionRect", onSelectionRect)
    , ("onSelectionEnd", onSelectionEnd)
    , ("onReconnect", onReconnect)
    , ("onResizeStart", onResizeStart)
    , ("onResizeEnd", onResizeEnd)
    , ("onMinimapClick", onMinimapClick)
    , ("onDeleteKey", onDeleteKey)
    , ("onError", onError)
    ]
  case validator of
    Maybe JSVal
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just JSVal
cb -> Object -> MisoString -> JSVal -> IO ()
forall o v.
(ToObject o, ToJSVal v) =>
o -> MisoString -> v -> IO ()
setField Object
callbacks MisoString
"isValidConnection" JSVal
cb
  misoFlow <- jsg "MisoFlow"
  optionsVal <- toJSVal (encode options)
  callbacksVal <- toJSVal callbacks
  FlowStore <$> (misoFlow # "createStore" $ [ domRef, optionsVal, callbacksVal ])
-----------------------------------------------------------------------------
call0 :: FlowStore -> MisoString -> IO ()
call0 :: FlowStore -> MisoString -> IO ()
call0 (FlowStore JSVal
s) MisoString
method = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal
s JSVal -> MisoString -> () -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
method (() -> IO JSVal) -> () -> IO JSVal
forall a b. (a -> b) -> a -> b
$ ())
-----------------------------------------------------------------------------
callJSON :: ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON :: forall a. ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON (FlowStore JSVal
s) MisoString
method a
payload =
  IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal
s JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
method ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [ a -> MisoString
forall a. ToJSON a => a -> MisoString
encode a
payload ])
-----------------------------------------------------------------------------
callJSON2 :: (ToJSON a, ToJSON b) => FlowStore -> MisoString -> a -> b -> IO ()
callJSON2 :: forall a b.
(ToJSON a, ToJSON b) =>
FlowStore -> MisoString -> a -> b -> IO ()
callJSON2 (FlowStore JSVal
s) MisoString
method a
p1 b
p2 =
  IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal
s JSVal -> MisoString -> (MisoString, MisoString) -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
method ((MisoString, MisoString) -> IO JSVal)
-> (MisoString, MisoString) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ (a -> MisoString
forall a. ToJSON a => a -> MisoString
encode a
p1, b -> MisoString
forall a. ToJSON a => a -> MisoString
encode b
p2))
-----------------------------------------------------------------------------
callRef :: FlowStore -> MisoString -> DOMRef -> IO ()
callRef :: FlowStore -> MisoString -> JSVal -> IO ()
callRef (FlowStore JSVal
s) MisoString
method JSVal
ref = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal
s JSVal -> MisoString -> [JSVal] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
method ([JSVal] -> IO JSVal) -> [JSVal] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [ JSVal
ref ])
-----------------------------------------------------------------------------
storeDestroy :: FlowStore -> IO ()
storeDestroy :: FlowStore -> IO ()
storeDestroy FlowStore
s = FlowStore -> MisoString -> IO ()
call0 FlowStore
s MisoString
"destroy"
-----------------------------------------------------------------------------
storeSetNodes :: FlowStore -> [Node n] -> IO ()
storeSetNodes :: forall n. FlowStore -> [Node n] -> IO ()
storeSetNodes FlowStore
s = FlowStore -> MisoString -> [Node n] -> IO ()
forall a. ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON FlowStore
s MisoString
"setNodes"
-----------------------------------------------------------------------------
storeSetEdges :: FlowStore -> [Edge e] -> IO ()
storeSetEdges :: forall e. FlowStore -> [Edge e] -> IO ()
storeSetEdges FlowStore
s = FlowStore -> MisoString -> [Edge e] -> IO ()
forall a. ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON FlowStore
s MisoString
"setEdges"
-----------------------------------------------------------------------------
storeUpdateOptions :: FlowStore -> StoreOptions -> IO ()
storeUpdateOptions :: FlowStore -> StoreOptions -> IO ()
storeUpdateOptions FlowStore
s = FlowStore -> MisoString -> StoreOptions -> IO ()
forall a. ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON FlowStore
s MisoString
"updateOptions"
-----------------------------------------------------------------------------
storeGetViewport :: FlowStore -> IO (Maybe Viewport)
storeGetViewport :: FlowStore -> IO (Maybe Viewport)
storeGetViewport (FlowStore JSVal
s) = do
  res <- JSVal
s JSVal -> MisoString -> () -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"getViewport" (() -> IO JSVal) -> () -> IO JSVal
forall a b. (a -> b) -> a -> b
$ ()
  mStr <- fromJSVal res
  pure (decode =<< mStr)
-----------------------------------------------------------------------------
storeSetViewport :: FlowStore -> Viewport -> ViewportHelperOptions -> IO ()
storeSetViewport :: FlowStore -> Viewport -> ViewportHelperOptions -> IO ()
storeSetViewport FlowStore
s Viewport
vp ViewportHelperOptions
opts = FlowStore -> MisoString -> Viewport -> Value -> IO ()
forall a b.
(ToJSON a, ToJSON b) =>
FlowStore -> MisoString -> a -> b -> IO ()
callJSON2 FlowStore
s MisoString
"setViewport" Viewport
vp (ViewportHelperOptions -> Value
helperOptions ViewportHelperOptions
opts)
-----------------------------------------------------------------------------
storeSyncViewport :: FlowStore -> Viewport -> IO ()
storeSyncViewport :: FlowStore -> Viewport -> IO ()
storeSyncViewport FlowStore
s = FlowStore -> MisoString -> Viewport -> IO ()
forall a. ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON FlowStore
s MisoString
"syncViewport"
-----------------------------------------------------------------------------
helperOptions :: ViewportHelperOptions -> Value
helperOptions :: ViewportHelperOptions -> Value
helperOptions (ViewportHelperOptions Maybe Double
duration Interpolation
interpolate) = [Pair] -> Value
object
  [ MisoString
"duration" MisoString -> Maybe Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Maybe Double
duration
  , MisoString
"interpolate" MisoString -> Interpolation -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Interpolation
interpolate
  ]
-----------------------------------------------------------------------------
storeZoomIn :: FlowStore -> ViewportHelperOptions -> IO ()
storeZoomIn :: FlowStore -> ViewportHelperOptions -> IO ()
storeZoomIn FlowStore
s ViewportHelperOptions
opts = FlowStore -> MisoString -> Value -> IO ()
forall a. ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON FlowStore
s MisoString
"zoomIn" (ViewportHelperOptions -> Value
helperOptions ViewportHelperOptions
opts)
-----------------------------------------------------------------------------
storeZoomOut :: FlowStore -> ViewportHelperOptions -> IO ()
storeZoomOut :: FlowStore -> ViewportHelperOptions -> IO ()
storeZoomOut FlowStore
s ViewportHelperOptions
opts = FlowStore -> MisoString -> Value -> IO ()
forall a. ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON FlowStore
s MisoString
"zoomOut" (ViewportHelperOptions -> Value
helperOptions ViewportHelperOptions
opts)
-----------------------------------------------------------------------------
storeZoomTo :: FlowStore -> Double -> ViewportHelperOptions -> IO ()
storeZoomTo :: FlowStore -> Double -> ViewportHelperOptions -> IO ()
storeZoomTo (FlowStore JSVal
s) Double
zoom ViewportHelperOptions
opts =
  IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal
s JSVal -> MisoString -> (Double, MisoString) -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"zoomTo" ((Double, MisoString) -> IO JSVal)
-> (Double, MisoString) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ (Double
zoom, Value -> MisoString
forall a. ToJSON a => a -> MisoString
encode (ViewportHelperOptions -> Value
helperOptions ViewportHelperOptions
opts)))
-----------------------------------------------------------------------------
storeScaleBy :: FlowStore -> Double -> ViewportHelperOptions -> IO ()
storeScaleBy :: FlowStore -> Double -> ViewportHelperOptions -> IO ()
storeScaleBy (FlowStore JSVal
s) Double
factor ViewportHelperOptions
opts =
  IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal
s JSVal -> MisoString -> (Double, MisoString) -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"scaleBy" ((Double, MisoString) -> IO JSVal)
-> (Double, MisoString) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ (Double
factor, Value -> MisoString
forall a. ToJSON a => a -> MisoString
encode (ViewportHelperOptions -> Value
helperOptions ViewportHelperOptions
opts)))
-----------------------------------------------------------------------------
storeSetCenter :: FlowStore -> Double -> Double -> SetCenterOptions -> IO ()
storeSetCenter :: FlowStore -> Double -> Double -> SetCenterOptions -> IO ()
storeSetCenter (FlowStore JSVal
s) Double
x Double
y (SetCenterOptions Maybe Double
zoom ViewportHelperOptions
opts) = do
  let ViewportHelperOptions Maybe Double
duration Interpolation
interpolate = ViewportHelperOptions
opts
  IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$ JSVal
s JSVal -> MisoString -> (Double, Double, MisoString) -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"setCenter" ((Double, Double, MisoString) -> IO JSVal)
-> (Double, Double, MisoString) -> IO JSVal
forall a b. (a -> b) -> a -> b
$
    ( Double
x
    , Double
y
    , Value -> MisoString
forall a. ToJSON a => a -> MisoString
encode (Value -> MisoString) -> Value -> MisoString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
        [ MisoString
"zoom" MisoString -> Maybe Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Maybe Double
zoom
        , MisoString
"duration" MisoString -> Maybe Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Maybe Double
duration
        , MisoString
"interpolate" MisoString -> Interpolation -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Interpolation
interpolate
        ]
    )
-----------------------------------------------------------------------------
storeFitView :: FlowStore -> FitViewOptions -> IO ()
storeFitView :: FlowStore -> FitViewOptions -> IO ()
storeFitView FlowStore
s FitViewOptions {Bool
Maybe Double
Maybe [MisoString]
Interpolation
Padding
fitViewPadding :: Padding
fitViewIncludeHiddenNodes :: Bool
fitViewMinZoom :: Maybe Double
fitViewMaxZoom :: Maybe Double
fitViewDuration :: Maybe Double
fitViewInterpolate :: Interpolation
fitViewNodes :: Maybe [MisoString]
fitViewDuration :: FitViewOptions -> Maybe Double
fitViewIncludeHiddenNodes :: FitViewOptions -> Bool
fitViewInterpolate :: FitViewOptions -> Interpolation
fitViewMaxZoom :: FitViewOptions -> Maybe Double
fitViewMinZoom :: FitViewOptions -> Maybe Double
fitViewNodes :: FitViewOptions -> Maybe [MisoString]
fitViewPadding :: FitViewOptions -> Padding
..} =
  FlowStore -> MisoString -> Value -> IO ()
forall a. ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON FlowStore
s MisoString
"fitView" (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
    [ MisoString
"padding" MisoString -> Value -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Padding -> Value
paddingValue Padding
fitViewPadding
    , MisoString
"includeHiddenNodes" MisoString -> Bool -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Bool
fitViewIncludeHiddenNodes
    , MisoString
"minZoom" MisoString -> Maybe Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Maybe Double
fitViewMinZoom
    , MisoString
"maxZoom" MisoString -> Maybe Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Maybe Double
fitViewMaxZoom
    , MisoString
"duration" MisoString -> Maybe Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Maybe Double
fitViewDuration
    , MisoString
"interpolate" MisoString -> Interpolation -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Interpolation
fitViewInterpolate
    , MisoString
"nodes" MisoString -> Maybe [Value] -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= ((MisoString -> Value) -> [MisoString] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (\MisoString
i -> [Pair] -> Value
object [ MisoString
"id" MisoString -> MisoString -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= MisoString
i ]) ([MisoString] -> [Value]) -> Maybe [MisoString] -> Maybe [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [MisoString]
fitViewNodes)
    ]
-----------------------------------------------------------------------------
paddingValue :: Padding -> Value
paddingValue :: Padding -> Value
paddingValue = \case
  PaddingUniform PaddingWithUnit
p -> PaddingWithUnit -> Value
paddingWithUnitValue PaddingWithUnit
p
  PaddingSides Maybe PaddingWithUnit
top Maybe PaddingWithUnit
right Maybe PaddingWithUnit
bottom Maybe PaddingWithUnit
left Maybe PaddingWithUnit
px Maybe PaddingWithUnit
py -> [Pair] -> Value
object
    [ MisoString
"top" MisoString -> Maybe Value -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= (PaddingWithUnit -> Value
paddingWithUnitValue (PaddingWithUnit -> Value) -> Maybe PaddingWithUnit -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PaddingWithUnit
top)
    , MisoString
"right" MisoString -> Maybe Value -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= (PaddingWithUnit -> Value
paddingWithUnitValue (PaddingWithUnit -> Value) -> Maybe PaddingWithUnit -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PaddingWithUnit
right)
    , MisoString
"bottom" MisoString -> Maybe Value -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= (PaddingWithUnit -> Value
paddingWithUnitValue (PaddingWithUnit -> Value) -> Maybe PaddingWithUnit -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PaddingWithUnit
bottom)
    , MisoString
"left" MisoString -> Maybe Value -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= (PaddingWithUnit -> Value
paddingWithUnitValue (PaddingWithUnit -> Value) -> Maybe PaddingWithUnit -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PaddingWithUnit
left)
    , MisoString
"x" MisoString -> Maybe Value -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= (PaddingWithUnit -> Value
paddingWithUnitValue (PaddingWithUnit -> Value) -> Maybe PaddingWithUnit -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PaddingWithUnit
px)
    , MisoString
"y" MisoString -> Maybe Value -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= (PaddingWithUnit -> Value
paddingWithUnitValue (PaddingWithUnit -> Value) -> Maybe PaddingWithUnit -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PaddingWithUnit
py)
    ]
-----------------------------------------------------------------------------
paddingWithUnitValue :: PaddingWithUnit -> Value
paddingWithUnitValue :: PaddingWithUnit -> Value
paddingWithUnitValue = \case
  PaddingRatio Double
r -> Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
r
  PaddingPx Double
v -> MisoString -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> MisoString
jsShow Double
v MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> (MisoString
"px" :: MisoString))
  PaddingPercent Double
v -> MisoString -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> MisoString
jsShow Double
v MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> (MisoString
"%" :: MisoString))
-----------------------------------------------------------------------------
storeFitBounds :: FlowStore -> Rect -> FitBoundsOptions -> IO ()
storeFitBounds :: FlowStore -> Rect -> FitBoundsOptions -> IO ()
storeFitBounds FlowStore
s Rect
bounds (FitBoundsOptions Double
padding ViewportHelperOptions
opts) =
  FlowStore -> MisoString -> Rect -> Value -> IO ()
forall a b.
(ToJSON a, ToJSON b) =>
FlowStore -> MisoString -> a -> b -> IO ()
callJSON2 FlowStore
s MisoString
"fitBounds" Rect
bounds (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
    [ MisoString
"padding" MisoString -> Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= Double
padding
    , MisoString
"duration" MisoString -> Maybe Double -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= ViewportHelperOptions -> Maybe Double
vhoDuration ViewportHelperOptions
opts
    , MisoString
"interpolate" MisoString -> Interpolation -> Pair
forall v. ToJSON v => MisoString -> v -> Pair
.= ViewportHelperOptions -> Interpolation
vhoInterpolate ViewportHelperOptions
opts
    ]
-----------------------------------------------------------------------------
storePanBy :: FlowStore -> XYPosition -> IO ()
storePanBy :: FlowStore -> XYPosition -> IO ()
storePanBy FlowStore
s = FlowStore -> MisoString -> XYPosition -> IO ()
forall a. ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON FlowStore
s MisoString
"panBy"
-----------------------------------------------------------------------------
storeObserveNode :: FlowStore -> DOMRef -> IO ()
storeObserveNode :: FlowStore -> JSVal -> IO ()
storeObserveNode FlowStore
s = FlowStore -> MisoString -> JSVal -> IO ()
callRef FlowStore
s MisoString
"observeNode"
-----------------------------------------------------------------------------
storeUnobserveNode :: FlowStore -> DOMRef -> IO ()
storeUnobserveNode :: FlowStore -> JSVal -> IO ()
storeUnobserveNode FlowStore
s = FlowStore -> MisoString -> JSVal -> IO ()
callRef FlowStore
s MisoString
"unobserveNode"
-----------------------------------------------------------------------------
storeRequestNodeMeasure :: FlowStore -> NodeId -> IO ()
storeRequestNodeMeasure :: FlowStore -> MisoString -> IO ()
storeRequestNodeMeasure (FlowStore JSVal
s) MisoString
nid =
  IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal
s JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"requestNodeMeasure" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [ MisoString
nid ])
-----------------------------------------------------------------------------
storeAttachNodeDrag :: FlowStore -> DOMRef -> NodeId -> IO ()
storeAttachNodeDrag :: FlowStore -> JSVal -> MisoString -> IO ()
storeAttachNodeDrag (FlowStore JSVal
s) JSVal
el MisoString
nid = do
  nidVal <- MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal MisoString
nid
  void (s # "attachNodeDrag" $ [ el, nidVal ])
-----------------------------------------------------------------------------
storeUpdateNodeDrag :: FlowStore -> DOMRef -> NodeId -> IO ()
storeUpdateNodeDrag :: FlowStore -> JSVal -> MisoString -> IO ()
storeUpdateNodeDrag (FlowStore JSVal
s) JSVal
el MisoString
nid = do
  nidVal <- MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal MisoString
nid
  void (s # "updateNodeDrag" $ [ el, nidVal ])
-----------------------------------------------------------------------------
storeDetachNodeDrag :: FlowStore -> NodeId -> IO ()
storeDetachNodeDrag :: FlowStore -> MisoString -> IO ()
storeDetachNodeDrag (FlowStore JSVal
s) MisoString
nid =
  IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal
s JSVal -> MisoString -> [MisoString] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO JSVal
# MisoString
"detachNodeDrag" ([MisoString] -> IO JSVal) -> [MisoString] -> IO JSVal
forall a b. (a -> b) -> a -> b
$ [ MisoString
nid ])
-----------------------------------------------------------------------------
storeAttachHandle :: FlowStore -> DOMRef -> IO ()
storeAttachHandle :: FlowStore -> JSVal -> IO ()
storeAttachHandle FlowStore
s = FlowStore -> MisoString -> JSVal -> IO ()
callRef FlowStore
s MisoString
"attachHandle"
-----------------------------------------------------------------------------
storeAttachReconnectAnchor :: FlowStore -> DOMRef -> IO ()
storeAttachReconnectAnchor :: FlowStore -> JSVal -> IO ()
storeAttachReconnectAnchor FlowStore
s = FlowStore -> MisoString -> JSVal -> IO ()
callRef FlowStore
s MisoString
"attachReconnectAnchor"
-----------------------------------------------------------------------------
storeAttachResizer :: FlowStore -> DOMRef -> NodeId -> Value -> IO ()
storeAttachResizer :: FlowStore -> JSVal -> MisoString -> Value -> IO ()
storeAttachResizer (FlowStore JSVal
s) JSVal
el MisoString
nid Value
params = do
  nidVal <- MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal MisoString
nid
  paramsVal <- toJSVal (encode params)
  void (s # "attachResizer" $ [ el, nidVal, paramsVal ])
-----------------------------------------------------------------------------
storeUpdateResizer :: FlowStore -> NodeId -> DOMRef -> Value -> IO ()
storeUpdateResizer :: FlowStore -> MisoString -> JSVal -> Value -> IO ()
storeUpdateResizer (FlowStore JSVal
s) MisoString
nid JSVal
el Value
params = do
  nidVal <- MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal MisoString
nid
  paramsVal <- toJSVal (encode params)
  void (s # "updateResizer" $ [ nidVal, el, paramsVal ])
-----------------------------------------------------------------------------
storeDetachResizer :: FlowStore -> NodeId -> DOMRef -> IO ()
storeDetachResizer :: FlowStore -> MisoString -> JSVal -> IO ()
storeDetachResizer (FlowStore JSVal
s) MisoString
nid JSVal
el = do
  nidVal <- MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal MisoString
nid
  void (s # "detachResizer" $ [ nidVal, el ])
-----------------------------------------------------------------------------
storeAttachMinimap :: FlowStore -> DOMRef -> Value -> IO ()
storeAttachMinimap :: FlowStore -> JSVal -> Value -> IO ()
storeAttachMinimap (FlowStore JSVal
s) JSVal
el Value
params = do
  paramsVal <- MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (Value -> MisoString
forall a. ToJSON a => a -> MisoString
encode Value
params)
  void (s # "attachMinimap" $ [ el, paramsVal ])
-----------------------------------------------------------------------------
storeUpdateMinimap :: FlowStore -> Value -> IO ()
storeUpdateMinimap :: FlowStore -> Value -> IO ()
storeUpdateMinimap FlowStore
s Value
params = FlowStore -> MisoString -> Value -> IO ()
forall a. ToJSON a => FlowStore -> MisoString -> a -> IO ()
callJSON FlowStore
s MisoString
"updateMinimap" Value
params
-----------------------------------------------------------------------------