-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Flow.Changes
-- License     :  BSD3-style (see the file LICENSE)
--
-- Applying 'NodeChange' \/ 'EdgeChange' lists to your model, plus
-- selection-change helpers. The change types themselves live in
-- "Miso.Flow.Types" (port of @types\/changes.ts@); the application logic
-- follows the framework packages' @applyChanges@.
----------------------------------------------------------------------------
module Miso.Flow.Changes
  ( applyNodeChanges
  , applyEdgeChanges
  , nodeChangeId
  , edgeChangeId
  , getSelectionChanges
  , selectNodes
  , unselectNodesAndEdges
  ) where
-----------------------------------------------------------------------------
import qualified Data.Set as S
import           Prelude
-----------------------------------------------------------------------------
import           Miso.Flow.Types
-----------------------------------------------------------------------------
-- | The node id a change refers to (the new item's id for adds).
nodeChangeId :: NodeChange n -> NodeId
nodeChangeId :: forall n. NodeChange n -> NodeId
nodeChangeId = \case
  NodeDimensionChange NodeId
i Maybe Dimensions
_ Maybe Bool
_ SetAttributes
_ -> NodeId
i
  NodePositionChange NodeId
i Maybe XYPosition
_ Maybe XYPosition
_ Maybe Bool
_ -> NodeId
i
  NodeSelectionChange NodeId
i Bool
_ -> NodeId
i
  NodeRemoveChange NodeId
i -> NodeId
i
  NodeAddChange Node n
item Maybe Int
_ -> Node n -> NodeId
forall n. Node n -> NodeId
nodeId Node n
item
  NodeReplaceChange NodeId
i Node n
_ -> NodeId
i
-----------------------------------------------------------------------------
-- | The edge id a change refers to (the new item's id for adds).
edgeChangeId :: EdgeChange e -> EdgeId
edgeChangeId :: forall e. EdgeChange e -> NodeId
edgeChangeId = \case
  EdgeSelectionChange NodeId
i Bool
_ -> NodeId
i
  EdgeRemoveChange NodeId
i -> NodeId
i
  EdgeAddChange Edge e
item Maybe Int
_ -> Edge e -> NodeId
forall e. Edge e -> NodeId
edgeId Edge e
item
  EdgeReplaceChange NodeId
i Edge e
_ -> NodeId
i
-----------------------------------------------------------------------------
-- | Apply a list of node changes to a node array; mirrors
-- @applyNodeChanges@ from the framework packages.
applyNodeChanges :: [NodeChange n] -> [Node n] -> [Node n]
applyNodeChanges :: forall n. [NodeChange n] -> [Node n] -> [Node n]
applyNodeChanges [NodeChange n]
changes [Node n]
nodes = ([Node n] -> NodeChange n -> [Node n])
-> [Node n] -> [NodeChange n] -> [Node n]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((NodeChange n -> [Node n] -> [Node n])
-> [Node n] -> NodeChange n -> [Node n]
forall a b c. (a -> b -> c) -> b -> a -> c
flip NodeChange n -> [Node n] -> [Node n]
forall {n}. NodeChange n -> [Node n] -> [Node n]
applyOne) [Node n]
nodes [NodeChange n]
changes
  where
    applyOne :: NodeChange n -> [Node n] -> [Node n]
applyOne (NodeAddChange Node n
item Maybe Int
mIndex) [Node n]
ns =
      case Maybe Int
mIndex of
        Maybe Int
Nothing -> [Node n]
ns [Node n] -> [Node n] -> [Node n]
forall a. Semigroup a => a -> a -> a
<> [Node n
item]
        Just Int
i -> Int -> [Node n] -> [Node n]
forall a. Int -> [a] -> [a]
take Int
i [Node n]
ns [Node n] -> [Node n] -> [Node n]
forall a. Semigroup a => a -> a -> a
<> [Node n
item] [Node n] -> [Node n] -> [Node n]
forall a. Semigroup a => a -> a -> a
<> Int -> [Node n] -> [Node n]
forall a. Int -> [a] -> [a]
drop Int
i [Node n]
ns
    applyOne (NodeRemoveChange NodeId
i) [Node n]
ns =
      [ Node n
n | Node n
n <- [Node n]
ns, Node n -> NodeId
forall n. Node n -> NodeId
nodeId Node n
n NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
/= NodeId
i ]
    applyOne (NodeReplaceChange NodeId
i Node n
item) [Node n]
ns =
      [ if Node n -> NodeId
forall n. Node n -> NodeId
nodeId Node n
n NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== NodeId
i then Node n
item else Node n
n | Node n
n <- [Node n]
ns ]
    applyOne NodeChange n
c [Node n]
ns =
      [ if Node n -> NodeId
forall n. Node n -> NodeId
nodeId Node n
n NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== NodeChange n -> NodeId
forall n. NodeChange n -> NodeId
nodeChangeId NodeChange n
c then NodeChange n -> Node n -> Node n
forall {n} {n}. NodeChange n -> Node n -> Node n
patch NodeChange n
c Node n
n else Node n
n | Node n
n <- [Node n]
ns ]
    patch :: NodeChange n -> Node n -> Node n
patch (NodeSelectionChange NodeId
_ Bool
selected) Node n
n = Node n
n { nodeSelected = selected }
    patch (NodePositionChange NodeId
_ Maybe XYPosition
mPos Maybe XYPosition
_ Maybe Bool
mDragging) Node n
n = Node n
n
      { nodePosition = maybe (nodePosition n) id mPos
      , nodeDragging = maybe (nodeDragging n) id mDragging
      }
    patch (NodeDimensionChange NodeId
_ Maybe Dimensions
mDims Maybe Bool
mResizing SetAttributes
setAttrs) Node n
n =
      case Maybe Dimensions
mDims of
        Maybe Dimensions
Nothing -> Node n
resized
        Just (Dimensions Double
w Double
h) -> Node n
resized
          { nodeMeasured = Just (Measured (Just w) (Just h))
          , nodeWidth = case setAttrs of
              SetAttributes
SetAttributesBoth -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
              SetAttributes
SetAttributesWidth -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
w
              SetAttributes
_ -> Node n -> Maybe Double
forall n. Node n -> Maybe Double
nodeWidth Node n
n
          , nodeHeight = case setAttrs of
              SetAttributes
SetAttributesBoth -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
h
              SetAttributes
SetAttributesHeight -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
h
              SetAttributes
_ -> Node n -> Maybe Double
forall n. Node n -> Maybe Double
nodeHeight Node n
n
          }
      where
        resized :: Node n
resized = Node n -> (Bool -> Node n) -> Maybe Bool -> Node n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Node n
n (\Bool
r -> Node n
n { nodeResizing = r }) Maybe Bool
mResizing
    patch NodeChange n
_ Node n
n = Node n
n
-----------------------------------------------------------------------------
-- | Apply a list of edge changes to an edge array; mirrors
-- @applyEdgeChanges@ from the framework packages.
applyEdgeChanges :: [EdgeChange e] -> [Edge e] -> [Edge e]
applyEdgeChanges :: forall e. [EdgeChange e] -> [Edge e] -> [Edge e]
applyEdgeChanges [EdgeChange e]
changes [Edge e]
edges = ([Edge e] -> EdgeChange e -> [Edge e])
-> [Edge e] -> [EdgeChange e] -> [Edge e]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((EdgeChange e -> [Edge e] -> [Edge e])
-> [Edge e] -> EdgeChange e -> [Edge e]
forall a b c. (a -> b -> c) -> b -> a -> c
flip EdgeChange e -> [Edge e] -> [Edge e]
forall {e}. EdgeChange e -> [Edge e] -> [Edge e]
applyOne) [Edge e]
edges [EdgeChange e]
changes
  where
    applyOne :: EdgeChange e -> [Edge e] -> [Edge e]
applyOne (EdgeAddChange Edge e
item Maybe Int
mIndex) [Edge e]
es =
      case Maybe Int
mIndex of
        Maybe Int
Nothing -> [Edge e]
es [Edge e] -> [Edge e] -> [Edge e]
forall a. Semigroup a => a -> a -> a
<> [Edge e
item]
        Just Int
i -> Int -> [Edge e] -> [Edge e]
forall a. Int -> [a] -> [a]
take Int
i [Edge e]
es [Edge e] -> [Edge e] -> [Edge e]
forall a. Semigroup a => a -> a -> a
<> [Edge e
item] [Edge e] -> [Edge e] -> [Edge e]
forall a. Semigroup a => a -> a -> a
<> Int -> [Edge e] -> [Edge e]
forall a. Int -> [a] -> [a]
drop Int
i [Edge e]
es
    applyOne (EdgeRemoveChange NodeId
i) [Edge e]
es =
      [ Edge e
e | Edge e
e <- [Edge e]
es, Edge e -> NodeId
forall e. Edge e -> NodeId
edgeId Edge e
e NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
/= NodeId
i ]
    applyOne (EdgeReplaceChange NodeId
i Edge e
item) [Edge e]
es =
      [ if Edge e -> NodeId
forall e. Edge e -> NodeId
edgeId Edge e
e NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== NodeId
i then Edge e
item else Edge e
e | Edge e
e <- [Edge e]
es ]
    applyOne (EdgeSelectionChange NodeId
i Bool
selected) [Edge e]
es =
      [ if Edge e -> NodeId
forall e. Edge e -> NodeId
edgeId Edge e
e NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== NodeId
i then Edge e
e { edgeSelected = selected } else Edge e
e | Edge e
e <- [Edge e]
es ]
-----------------------------------------------------------------------------
-- | Selection changes needed to make exactly the given ids selected;
-- mirrors @getSelectionChanges@.
getSelectionChanges
  :: [(NodeId, Bool)]
  -- ^ (id, currently selected) for every element
  -> S.Set NodeId
  -- ^ ids that should be selected
  -> [NodeChange n]
getSelectionChanges :: forall n. [(NodeId, Bool)] -> Set NodeId -> [NodeChange n]
getSelectionChanges [(NodeId, Bool)]
elements Set NodeId
selectedIds =
  [ NodeId -> Bool -> NodeChange n
forall n. NodeId -> Bool -> NodeChange n
NodeSelectionChange NodeId
i Bool
willBeSelected
  | (NodeId
i, Bool
isSelected) <- [(NodeId, Bool)]
elements
  , let willBeSelected :: Bool
willBeSelected = NodeId
i NodeId -> Set NodeId -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set NodeId
selectedIds
  , Bool
isSelected Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
willBeSelected
  ]
-----------------------------------------------------------------------------
-- | Mark exactly the given node ids as selected.
selectNodes :: S.Set NodeId -> [Node n] -> [Node n]
selectNodes :: forall n. Set NodeId -> [Node n] -> [Node n]
selectNodes Set NodeId
ids =
  (Node n -> Node n) -> [Node n] -> [Node n]
forall a b. (a -> b) -> [a] -> [b]
map (\Node n
n -> Node n
n { nodeSelected = nodeId n `S.member` ids })
-----------------------------------------------------------------------------
-- | Deselect all (or the given) nodes and edges; mirrors
-- @unselectNodesAndEdges@.
unselectNodesAndEdges
  :: Maybe [NodeId]
  -> Maybe [EdgeId]
  -> ([Node n], [Edge e])
  -> ([Node n], [Edge e])
unselectNodesAndEdges :: forall n e.
Maybe [NodeId]
-> Maybe [NodeId] -> ([Node n], [Edge e]) -> ([Node n], [Edge e])
unselectNodesAndEdges Maybe [NodeId]
mNodeIds Maybe [NodeId]
mEdgeIds ([Node n]
nodes, [Edge e]
edges) =
  ( [ if Node n -> Bool
forall n. Node n -> Bool
keepNode Node n
n then Node n
n { nodeSelected = False } else Node n
n | Node n
n <- [Node n]
nodes ]
  , [ if Edge e -> Bool
forall {e}. Edge e -> Bool
keepEdge Edge e
e then Edge e
e { edgeSelected = False } else Edge e
e | Edge e
e <- [Edge e]
edges ]
  )
  where
    keepNode :: Node n -> Bool
keepNode Node n
n = Bool -> ([NodeId] -> Bool) -> Maybe [NodeId] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (NodeId -> [NodeId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Node n -> NodeId
forall n. Node n -> NodeId
nodeId Node n
n)) Maybe [NodeId]
mNodeIds
    keepEdge :: Edge e -> Bool
keepEdge Edge e
e = Bool -> ([NodeId] -> Bool) -> Maybe [NodeId] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (NodeId -> [NodeId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Edge e -> NodeId
forall e. Edge e -> NodeId
edgeId Edge e
e)) Maybe [NodeId]
mEdgeIds
-----------------------------------------------------------------------------