feat: A function to add a connection to a state

src/Component/Editor.purs

@@ -41,7 +41,7 @@ import Lunarbox.Data.Editor.Node.NodeDescriptor (onlyEditable)
 import Lunarbox.Data.Editor.Node.NodeId (NodeId(..))
 import Lunarbox.Data.Editor.Node.PinLocation (Pin(..))
 import Lunarbox.Data.Editor.Project (_projectNodeGroup, compileProject, createFunction, emptyProject)
-import Lunarbox.Data.Editor.State (State, Tab(..), _atColorMap, _atNode, _atNodeData, _currentFunction, _currentTab, _function, _functions, _isSelected, _lastMousePosition, _nextId, _nodeData, _panelIsOpen, _project, _typeMap, tabIcon)
+import Lunarbox.Data.Editor.State (State, Tab(..), _atColorMap, _atNode, _atNodeData, _currentFunction, _currentTab, _function, _functions, _isSelected, _lastMousePosition, _nextId, _nodeData, _panelIsOpen, _partialFrom, _partialTo, _project, _typeMap, tabIcon)
 import Lunarbox.Data.Graph as G
 import Lunarbox.Data.Vector (Vec2)
 import Lunarbox.Page.Editor.EmptyEditor (emptyEditor)
@@ -212,10 +212,10 @@ component =
       maybeCurrentFunction <- gets $ view _currentFunction
       for_ maybeCurrentFunction \currentFunction -> do
         modify_ $ set (_isSelected currentFunction id) true
-    SelectInput _ _ -> do
-      pure unit
+    SelectInput id index -> do
+      modify_ $ set _partialTo $ Just $ Tuple id index
     SelectOutput id -> do
-      pure unit
+      modify_ $ set _partialFrom $ Just id
 
   handleTreeOutput :: TreeC.Output -> Maybe Action
   handleTreeOutput = case _ of
@@ -312,6 +312,8 @@ component =
             , mouseMove: Just <<< SceneMouseMove
             , mouseUp: Just SceneMouseUp
             , selectNode: Just <<< SelectNode
+            , selectInput: (Just <<< _) <<< SelectInput
+            , selectOutput: Just <<< SelectOutput
             }
 
   render :: State -> HH.HTML _ Action

src/Component/Editor/Scene.purs

@@ -60,7 +60,7 @@ type Actions a
     , mouseDown :: Vec2 Number -> Maybe a
     , selectNode :: NodeId -> Maybe a
     , mouseUp :: Maybe a
-    , selectInput :: Tuple NodeId Int -> Maybe a
+    , selectInput :: NodeId -> Int -> Maybe a
     , selectOutput :: NodeId -> Maybe a
     }
 
@@ -135,7 +135,7 @@ createNodeComponent { functionName
         , hasOutput: not $ is _OutputNode node
         }
         { select: selectNode id
-        , selectInput: selectInput <<< Tuple id
+        , selectInput: selectInput id
         , selectOutput: selectOutput id
         }
 

src/Data/Editor/Node.purs

@@ -3,15 +3,17 @@ module Lunarbox.Data.Editor.Node
   , ComplexNodeData
   , compileNode
   , hasOutput
+  , getInputs
   , _ComplexNodeFunction
   , _ComplexNodeInputs
   , _OutputNode
+  , _nodeInputs
   ) where
 
 import Prelude
-import Data.Lens (Prism', Traversal', is, prism')
+import Data.Lens (Iso', Lens', Prism', Traversal', is, iso, lens, prism', review, set, view)
 import Data.Lens.Record (prop)
-import Data.List (List, foldl, mapWithIndex)
+import Data.List (List(..), (:), (!!), foldl, mapWithIndex)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Symbol (SProxy(..))
 import Lunarbox.Data.Dataflow.Expression (Expression(..), VarName(..), wrap)
@@ -40,6 +42,13 @@ data Node
 hasOutput :: Node -> Boolean
 hasOutput = not <<< is _OutputNode
 
+-- Get all inputs of a node
+getInputs :: Node -> List (Maybe NodeId)
+getInputs = case _ of
+  ComplexNode { inputs } -> inputs
+  OutputNode input -> Just <$> view _maybeToList input
+  InputNode -> Nil
+
 functionCall :: forall l l'. ExtendedLocation l l' -> Expression (ExtendedLocation l l') -> List (Expression (ExtendedLocation l l')) -> Expression (ExtendedLocation l l')
 functionCall location calee = wrap location <<< foldl (FunctionCall Nowhere) calee
 
@@ -86,3 +95,13 @@ _OutputNode =
   prism' OutputNode case _ of
     OutputNode v -> Just v
     _ -> Nothing
+
+_maybeToList :: forall a. Iso' (Maybe a) (List a)
+_maybeToList = iso (maybe Nil (_ : Nil)) (_ !! 0)
+
+_nodeInputs :: Lens' Node (List (Maybe NodeId))
+_nodeInputs =
+  lens getInputs \node -> case node of
+    InputNode -> const node
+    OutputNode inner -> OutputNode <<< join <<< review _maybeToList
+    ComplexNode _ -> flip (set _ComplexNodeInputs) node

src/Data/Editor/State.purs

@@ -27,26 +27,29 @@ module Lunarbox.Data.Editor.State
   ) where
 
 import Prelude
-import Data.Lens (Lens', Traversal', _Just)
+import Data.Lens (Lens', Traversal', _Just, lens, over, preview, set, view)
 import Data.Lens.At (at)
+import Data.Lens.Index (ix)
 import Data.Lens.Record (prop)
 import Data.Map (Map)
-import Data.Maybe (Maybe)
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Symbol (SProxy(..))
 import Data.Tuple (Tuple(..))
+import Data.Typelevel.Undefined (undefined)
 import Lunarbox.Data.Dataflow.Expression (Expression)
 import Lunarbox.Data.Dataflow.Type (Type)
 import Lunarbox.Data.Editor.DataflowFunction (DataflowFunction)
 import Lunarbox.Data.Editor.FunctionData (FunctionData)
 import Lunarbox.Data.Editor.FunctionName (FunctionName)
 import Lunarbox.Data.Editor.Location (Location)
-import Lunarbox.Data.Editor.Node (Node)
+import Lunarbox.Data.Editor.Node (Node, _nodeInputs)
 import Lunarbox.Data.Editor.Node.NodeData (NodeData, _NodeDataSelected)
 import Lunarbox.Data.Editor.Node.NodeId (NodeId)
-import Lunarbox.Data.Editor.NodeGroup (NodeGroup)
+import Lunarbox.Data.Editor.NodeGroup (NodeGroup, _NodeGroupNodes)
 import Lunarbox.Data.Editor.PartialConnection (PartialConnection, _from, _to)
 import Lunarbox.Data.Editor.Project (Project, _ProjectFunctions, _atProjectFunction, _atProjectNode, _projectNodeGroup)
 import Lunarbox.Data.Graph as G
+import Lunarbox.Data.Lens (listToArrayIso)
 import Lunarbox.Data.Vector (Vec2)
 import Svg.Attributes (Color)
 
@@ -149,3 +152,46 @@ _partialFrom = _partialConnection <<< _from
 
 _partialTo :: Lens' State (Maybe (Tuple NodeId Int))
 _partialTo = _partialConnection <<< _to
+
+_currentNodeGroup :: Lens' State (Maybe NodeGroup)
+_currentNodeGroup =
+  ( lens
+      ( \state -> do
+          currentFunction <- view _currentFunction state
+          preview (_nodeGroup currentFunction) state
+      )
+      ( \state maybeValue ->
+          fromMaybe state do
+            value <- maybeValue
+            currentFunction <- view _currentFunction state
+            pure $ set (_nodeGroup currentFunction) value state
+      )
+  )
+
+_currentNodes :: Traversal' State (G.Graph NodeId Node)
+_currentNodes = _currentNodeGroup <<< _Just <<< _NodeGroupNodes
+
+_atCurrentNode :: NodeId -> Traversal' State (Maybe Node)
+_atCurrentNode id = _currentNodes <<< at id
+
+-- Helpers
+tryConnecting :: State -> State
+tryConnecting state =
+  fromMaybe state do
+    from <- view _partialFrom state
+    Tuple toId toIndex <- view _partialTo state
+    currentNodeGroup <- view _currentNodeGroup state
+    let
+      state' = over _currentNodes (G.insertEdge from toId) state
+
+      state'' =
+        set
+          ( _atCurrentNode toId
+              <<< _Just
+              <<< _nodeInputs
+              <<< listToArrayIso
+              <<< ix toIndex
+          )
+          (Just from)
+          state
+    undefined

src/Data/Lens.purs

@@ -1,8 +1,17 @@
-module Lunarbox.Data.Lens where
+module Lunarbox.Data.Lens
+  ( listToArrayIso
+  , newtypeIso
+  ) where
 
-import Data.Lens (Lens', iso)
+import Data.Array as Array
+import Data.Lens (Lens', Iso', iso)
+import Data.List as List
 import Data.Newtype (class Newtype, unwrap, wrap)
 
 -- Generic iso which can be used for any data type with a newtype instance
 newtypeIso :: forall a b. Newtype a b => Lens' a b
 newtypeIso = iso unwrap wrap
+
+-- I usually use this when I want to focus on a single element of a lsit
+listToArrayIso :: forall a. Iso' (List.List a) (Array a)
+listToArrayIso = iso List.toUnfoldable Array.toUnfoldable