From 5340e177d04b11df50bae4d48587d6ed09787ee6 Mon Sep 17 00:00:00 2001 From: Matei Adriel Date: Wed, 24 Jun 2020 16:31:52 +0300 Subject: [PATCH] fix: only store the data related to NodeGroups in 1 place --- src/Component/Editor.purs | 5 +- src/Data/Class/GraphRep.purs | 12 +++-- src/Data/Editor/Node.purs | 8 ++++ src/Data/Editor/NodeGroup.purs | 19 ++++---- src/Data/Editor/Project.purs | 10 +--- src/Data/Editor/State.purs | 83 ++++++++++------------------------ 6 files changed, 51 insertions(+), 86 deletions(-) diff --git a/src/Component/Editor.purs b/src/Component/Editor.purs index 4c5ef55..b207e8f 100644 --- a/src/Component/Editor.purs +++ b/src/Component/Editor.purs @@ -50,7 +50,6 @@ import Lunarbox.Data.Editor.Node.PinLocation (Pin(..)) import Lunarbox.Data.Editor.Save (stateToJson) import Lunarbox.Data.Editor.State (State, Tab(..), _atGeometry, _atInputCount, _currentFunction, _currentTab, _isAdmin, _isExample, _isVisible, _name, _nodeSearchTerm, _nodes, _panelIsOpen, _partialFrom, _partialTo, _unconnectablePins, compile, createNode, deleteFunction, functionExists, initializeFunction, makeUnconnetacbleList, preventDefaults, removeConnection, searchNode, setCurrentFunction, setRuntimeValue, tabIcon, tryConnecting, updateNode) import Lunarbox.Data.Graph (wouldCreateCycle) -import Lunarbox.Data.Graph as G import Lunarbox.Data.Route (Route(..)) import Web.Event.Event (Event, preventDefault, stopPropagation) import Web.Event.Event as Event @@ -253,9 +252,9 @@ component = >>= traverse ( \name -> do cache <- gets $ view $ _atGeometry name - (map (maybe mempty G.keys) $ gets $ preview $ _nodes name) + (map (maybe mempty Map.keys) $ gets $ preview $ _nodes name) >>= traverse_ updateNode - pure $ cache + pure cache ) <#> join >>= traverse_ diff --git a/src/Data/Class/GraphRep.purs b/src/Data/Class/GraphRep.purs index 3ef27b0..6b26f33 100644 --- a/src/Data/Class/GraphRep.purs +++ b/src/Data/Class/GraphRep.purs @@ -2,16 +2,18 @@ module Lunarbox.Data.Class.GraphRep where import Prelude import Data.Map (Map) -import Data.Set (Set) -import Data.Tuple (Tuple) -import Lunarbox.Data.Graph (Graph(..)) +import Data.Tuple (Tuple(..)) +import Lunarbox.Data.Editor.Class.Depends (class Depends, getDependencies) +import Lunarbox.Data.Graph (Graph(..), invert) -- Generic typeclass for everything which can be represented as a graph class GraphRep f k v | f -> k, f -> v where toGraph :: f -> Graph k v -instance graphRepMap :: GraphRep (Map k (Tuple v (Set k))) k v where - toGraph = Graph +instance graphRepDependencyMap :: (Ord k, Depends v k) => GraphRep (Map k v) k v where + toGraph functions = invert $ Graph $ go <$> functions + where + go function = Tuple function $ getDependencies function instance graphRepGraph :: GraphRep (Graph k v) k v where toGraph = identity diff --git a/src/Data/Editor/Node.purs b/src/Data/Editor/Node.purs index 1cf2fc7..ebb7a49 100644 --- a/src/Data/Editor/Node.purs +++ b/src/Data/Editor/Node.purs @@ -18,6 +18,7 @@ import Prelude import Data.Argonaut (class DecodeJson, class EncodeJson) import Data.Argonaut.Decode.Generic.Rep (genericDecodeJson) import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson) +import Data.Compactable (compact) import Data.Generic.Rep (class Generic) import Data.Lens (Lens', Prism', Traversal', is, lens, prism', set) import Data.Lens.Index (ix) @@ -25,9 +26,11 @@ import Data.Lens.Record (prop) import Data.List (List(..), foldl, mapWithIndex, (!!)) import Data.List as List import Data.Maybe (Maybe(..), maybe) +import Data.Set as Set import Data.Symbol (SProxy(..)) import Data.Tuple (Tuple(..), uncurry) import Lunarbox.Data.Dataflow.Expression (Expression(..), VarName(..), wrap) +import Lunarbox.Data.Editor.Class.Depends (class Depends) import Lunarbox.Data.Editor.ExtendedLocation (ExtendedLocation(..), nothing) import Lunarbox.Data.Editor.FunctionName (FunctionName(..)) import Lunarbox.Data.Editor.Node.NodeId (NodeId) @@ -66,6 +69,11 @@ instance showNode :: Show Node where show (OutputNode id) = "Output " <> maybe "???" show id show (ComplexNode data') = show data' +instance dependsNode :: Depends Node NodeId where + getDependencies (OutputNode (Just id)) = Set.singleton id + getDependencies (ComplexNode { inputs }) = Set.fromFoldable $ compact inputs + getDependencies _ = mempty + -- Check if a node has an output pin hasOutput :: Node -> Boolean hasOutput = not <<< is _OutputNode diff --git a/src/Data/Editor/NodeGroup.purs b/src/Data/Editor/NodeGroup.purs index 56f13e8..d4b7a00 100644 --- a/src/Data/Editor/NodeGroup.purs +++ b/src/Data/Editor/NodeGroup.purs @@ -1,6 +1,5 @@ module Lunarbox.Data.Editor.NodeGroup ( NodeGroup(..) - , orderNodes , compileNodeGroup , _NodeGroupInputs , _NodeGroupOutput @@ -12,9 +11,11 @@ import Data.Argonaut (class DecodeJson, class EncodeJson) import Data.Lens (Lens', view) import Data.Lens.Record (prop) import Data.List (List, foldMap, foldr, (:), (\\)) +import Data.Map (Map) import Data.Newtype (class Newtype, unwrap) import Data.Set as Set import Data.Symbol (SProxy(..)) +import Lunarbox.Data.Class.GraphRep (toGraph) import Lunarbox.Data.Dataflow.Expression (Expression, VarName(..), functionDeclaration) import Lunarbox.Data.Editor.Class.Depends (class Depends) import Lunarbox.Data.Editor.ExtendedLocation (ExtendedLocation(..), nothing) @@ -22,14 +23,14 @@ import Lunarbox.Data.Editor.FunctionName (FunctionName) import Lunarbox.Data.Editor.Node (Node(..), compileNode) import Lunarbox.Data.Editor.Node.NodeId (NodeId) import Lunarbox.Data.Editor.Node.PinLocation (NodeOrPinLocation) -import Lunarbox.Data.Graph (Graph, topologicalSort) +import Lunarbox.Data.Graph (topologicalSort) import Lunarbox.Data.Lens (newtypeIso) -- Represents a graph of nodes newtype NodeGroup = NodeGroup { inputs :: List NodeId - , nodes :: Graph NodeId Node + , nodes :: Map NodeId Node , output :: NodeId } @@ -49,20 +50,18 @@ instance dependencyNodeGroup :: Depends NodeGroup FunctionName where ComplexNode { function } -> Set.singleton function _ -> mempty --- Take a graph of nodes and return a list of nodes sorted in topological order -orderNodes :: NodeGroup -> List NodeId -orderNodes (NodeGroup function) = topologicalSort function.nodes - compileNodeGroup :: NodeGroup -> Expression NodeOrPinLocation compileNodeGroup group@(NodeGroup { nodes, output, inputs }) = let - ordered = orderNodes group + graph = toGraph nodes + + ordered = topologicalSort graph bodyNodes = (ordered \\ (output : inputs)) <> pure output return = foldr - (compileNode nodes) + (compileNode graph) nothing bodyNodes in @@ -72,7 +71,7 @@ compileNodeGroup group@(NodeGroup { nodes, output, inputs }) = _NodeGroupInputs :: Lens' NodeGroup (List NodeId) _NodeGroupInputs = newtypeIso <<< prop (SProxy :: _ "inputs") -_NodeGroupNodes :: Lens' NodeGroup (Graph NodeId Node) +_NodeGroupNodes :: Lens' NodeGroup (Map NodeId Node) _NodeGroupNodes = newtypeIso <<< prop (SProxy :: _ "nodes") _NodeGroupOutput :: Lens' NodeGroup NodeId diff --git a/src/Data/Editor/Project.purs b/src/Data/Editor/Project.purs index 5cafc1a..021cc78 100644 --- a/src/Data/Editor/Project.purs +++ b/src/Data/Editor/Project.purs @@ -22,19 +22,16 @@ import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) import Data.Set as Set import Data.Symbol (SProxy(..)) -import Data.Tuple (Tuple(..)) import Data.Unfoldable (class Unfoldable) import Lunarbox.Data.Class.GraphRep (class GraphRep, toGraph) import Lunarbox.Data.Dataflow.Expression (Expression, optimize) import Lunarbox.Data.Dataflow.Graph (compileGraph) -import Lunarbox.Data.Editor.Class.Depends (getDependencies) import Lunarbox.Data.Editor.DataflowFunction (DataflowFunction(..), _VisualFunction, compileDataflowFunction) import Lunarbox.Data.Editor.FunctionName (FunctionName(..)) import Lunarbox.Data.Editor.Location (Location) import Lunarbox.Data.Editor.Node (Node(..)) import Lunarbox.Data.Editor.Node.NodeId (NodeId) import Lunarbox.Data.Editor.NodeGroup (NodeGroup(..), _NodeGroupNodes) -import Lunarbox.Data.Graph as G import Lunarbox.Data.Lens (newtypeIso) newtype Project @@ -50,10 +47,7 @@ derive newtype instance encodeJsonProject :: EncodeJson Project derive newtype instance decodeJsonProject :: DecodeJson Project instance graphRepProject :: GraphRep Project FunctionName DataflowFunction where - toGraph (Project { functions }) = G.invert $ toGraph $ go <$> functions - where - go :: DataflowFunction -> Tuple DataflowFunction (Set.Set FunctionName) - go function = Tuple function $ getDependencies function + toGraph (Project { functions }) = toGraph functions _ProjectFunctions :: Lens' Project (Map.Map FunctionName DataflowFunction) _ProjectFunctions = newtypeIso <<< prop (SProxy :: _ "functions") @@ -69,7 +63,7 @@ createEmptyFunction id = VisualFunction $ NodeGroup { inputs: mempty - , nodes: G.singleton id $ OutputNode Nothing + , nodes: Map.singleton id $ OutputNode Nothing , output: id } diff --git a/src/Data/Editor/State.purs b/src/Data/Editor/State.purs index 7def30b..4d47718 100644 --- a/src/Data/Editor/State.purs +++ b/src/Data/Editor/State.purs @@ -33,6 +33,7 @@ import Lunarbox.Control.Monad.Dataflow.Interpreter (InterpreterContext(..), runI import Lunarbox.Control.Monad.Dataflow.Interpreter.Interpret (interpret) import Lunarbox.Control.Monad.Dataflow.Solve.SolveExpression (solveExpression) import Lunarbox.Control.Monad.Dataflow.Solve.Unify (canUnify) +import Lunarbox.Data.Class.GraphRep (toGraph) import Lunarbox.Data.Dataflow.Expression (Expression) import Lunarbox.Data.Dataflow.Runtime (RuntimeValue) import Lunarbox.Data.Dataflow.Runtime.ValueMap (ValueMap(..)) @@ -49,7 +50,6 @@ import Lunarbox.Data.Editor.Node.PinLocation (Pin(..)) import Lunarbox.Data.Editor.NodeGroup (NodeGroup(..), _NodeGroupInputs, _NodeGroupNodes, _NodeGroupOutput) import Lunarbox.Data.Editor.PartialConnection (PartialConnection, _from, _to) import Lunarbox.Data.Editor.Project (Project(..), _ProjectFunctions, _atProjectFunction, _atProjectNode, _projectNodeGroup, compileProject, createFunction) -import Lunarbox.Data.Graph (emptyGraph) import Lunarbox.Data.Graph as G import Lunarbox.Data.Lens (newtypeIso) import Lunarbox.Data.Ord (sortBySearch) @@ -234,27 +234,25 @@ getOutputType functionName id state = do -- Get all the input pins in the current function currentInputSet :: forall a s m. State a s m -> Set.Set (Tuple NodeId Int) currentInputSet state = - let - nodeGroup = fromMaybe G.emptyGraph $ preview _currentNodes state - in - Set.fromFoldable - $ ( \(Tuple id node) -> - let - inputs = view _nodeInputs node - in - List.mapWithIndex (\index -> const $ Tuple id index) inputs - ) - =<< G.toUnfoldable nodeGroup + Set.fromFoldable + $ ( \(Tuple id node) -> + let + inputs = view _nodeInputs node + in + List.mapWithIndex (const <<< Tuple id) inputs + ) + =<< nodeGroup + where + nodeGroup :: List _ + nodeGroup = maybe mempty Map.toUnfoldable $ preview _currentNodes state -- Ger a list of all the outputs currentOutputList :: forall a s m. State a s m -> Set.Set NodeId currentOutputList state = let - nodes = fromMaybe G.emptyGraph $ preview _currentNodes state + keys = maybe mempty Map.keys $ preview _currentNodes state output = preview (_currentNodeGroup <<< _Just <<< _NodeGroupOutput) state - - keys = G.keys nodes in case output of Just id -> Set.difference keys $ Set.singleton id @@ -363,7 +361,7 @@ canConnect from (Tuple toId toIndex) state = let typeMap = view _typeMap state nodes <- preview _currentNodes state - guard $ not $ G.wouldCreateCycle from toId nodes + guard $ not $ G.wouldCreateCycle from toId $ toGraph nodes currentFunction <- view _currentFunction state fromType <- getOutputType currentFunction from state toType <- Map.lookup (DeepLocation currentFunction $ DeepLocation toId $ InputPin toIndex) typeMap @@ -392,22 +390,16 @@ tryConnecting state = ) state - state' = case previousConnection of - Just id -> over _currentNodes (G.removeEdge id toId) state - Nothing -> state - - state'' = over _currentNodes (G.insertEdge from toId) state' - - state''' = + state' = set ( _atCurrentNode toId <<< _nodeInput toIndex ) (Just from) - state'' + state - state'''' = set _partialTo Nothing $ set _partialFrom Nothing state''' - pure $ compile state'''' + state'' = set _partialTo Nothing $ set _partialFrom Nothing state' + pure $ compile state'' -- Set the function the user is editing at the moment setCurrentFunction :: forall a s m. Maybe FunctionName -> State a s m -> State a s m @@ -429,35 +421,10 @@ initializeFunction name state = -- Remove a conenction from the current function removeConnection :: forall a s m. NodeId -> Tuple NodeId Int -> State a s m -> State a s m -removeConnection from (Tuple toId toIndex) state = compile state'' +removeConnection from (Tuple toId toIndex) state = compile state' where state' = set (_atCurrentNode toId <<< _nodeInput toIndex) Nothing state - toInputs = view (_atCurrentNode toId <<< _nodeInputs) state' - - inputsToSource :: List _ - inputsToSource = - foldMap - ( \maybeInput -> - maybe mempty pure - $ do - input <- maybeInput - guard $ input == from - pure input - ) - toInputs - - state'' = - -- We only remove the connections if there are no dependencies left - if List.null inputsToSource then - over _currentNodes (G.removeEdge from toId) state' - else - state' - --- Counts how many times a function is used inside another function -countFunctionRefs :: FunctionName -> G.Graph NodeId Node -> Int -countFunctionRefs name = G.size <<< G.filterVertices ((_ == name) <<< getFunctionName) - -- Deletes a node form a given function deleteNode :: forall a s m. FunctionName -> NodeId -> State a s m -> State a s m deleteNode functionName id state = @@ -468,15 +435,11 @@ deleteNode functionName id state = -- The function the node runs nodeFunction = fromMaybe (FunctionName "") $ getFunctionName <$> node - - -- If this is the last reference to the used function in the current function we remove the edge from the dependency graph - functionRefCount = countFunctionRefs nodeFunction (fromMaybe emptyGraph $ preview (_nodes functionName) state) modify_ $ over (_nodes functionName) $ map $ over _nodeInputs $ map \input -> if input == Just id then Nothing else input - modify_ $ over (_nodes functionName) $ G.delete id -- TODO: make this work with the new foreign system -- modify_ $ set (_atNodeData functionName id) Nothing modify_ $ over (_currentNodeGroup <<< _Just <<< _NodeGroupInputs) $ filter (id /= _) @@ -487,7 +450,7 @@ deleteNode functionName id state = isOutput = maybe false (is _OutputNode) node -- Delete all the nodes runnign a certain functions inside another functions -deleteFunctionReferences :: forall a s m. FunctionName -> FunctionName -> G.Graph NodeId Node -> State a s m -> State a s m +deleteFunctionReferences :: forall a s m. FunctionName -> FunctionName -> Map NodeId Node -> State a s m -> State a s m deleteFunctionReferences toDelete functionName graph state = foldr (deleteNode functionName) state $ filterMap @@ -497,7 +460,7 @@ deleteFunctionReferences toDelete functionName graph state = else Nothing ) - $ (G.toUnfoldable graph :: List _) + $ (Map.toUnfoldable graph :: List _) -- Delete a function from the state deleteFunction :: forall a s m. FunctionName -> State a s m -> State a s m @@ -612,7 +575,7 @@ _functions = _project <<< _ProjectFunctions _nodeGroup :: forall a s m. FunctionName -> Traversal' (State a s m) NodeGroup _nodeGroup name = _project <<< _projectNodeGroup name -_nodes :: forall a s m. FunctionName -> Traversal' (State a s m) (G.Graph NodeId Node) +_nodes :: forall a s m. FunctionName -> Traversal' (State a s m) (Map NodeId Node) _nodes name = _nodeGroup name <<< _NodeGroupNodes _atNode :: forall a s m. FunctionName -> NodeId -> Traversal' (State a s m) (Maybe Node) @@ -668,7 +631,7 @@ _currentGeometryCache = ) ) -_currentNodes :: forall a s m. Traversal' (State a s m) (G.Graph NodeId Node) +_currentNodes :: forall a s m. Traversal' (State a s m) (Map NodeId Node) _currentNodes = _currentNodeGroup <<< _Just <<< _NodeGroupNodes _atCurrentNode :: forall a s m. NodeId -> Traversal' (State a s m) Node