feat: more expressive location system

src/Component/Editor.purs

@@ -51,7 +51,7 @@ import Lunarbox.Data.Editor.FunctionName (FunctionName(..))
 import Lunarbox.Data.Editor.Node.NodeDescriptor (onlyEditable)
 import Lunarbox.Data.Editor.Node.NodeId (NodeId)
 import Lunarbox.Data.Editor.Save (stateToJson)
-import Lunarbox.Data.Editor.State (State, Tab(..), _atInputCount, _currentFunction, _currentTab, _isAdmin, _isExample, _isVisible, _name, _nodeSearchTerm, _panelIsOpen, compile, createConnection, createNode, deleteFunction, functionExists, generateUnconnectableInputs, generateUnconnectableOutputs, initializeFunction, preventDefaults, removeConnection, searchNode, setCurrentFunction, setRuntimeValue, showLocation, tabIcon, tryCompiling, updateAll, withCurrentGeometries)
+import Lunarbox.Data.Editor.State (State, Tab(..), _atInputCount, _currentFunction, _currentTab, _isAdmin, _isExample, _isVisible, _name, _nodeSearchTerm, _panelIsOpen, compile, createConnection, createNode, deleteFunction, functionExists, generateUnconnectableInputs, generateUnconnectableOutputs, initializeFunction, preventDefaults, removeConnection, searchNode, setCurrentFunction, setRuntimeValue, tabIcon, tryCompiling, updateAll, withCurrentGeometries)
 import Lunarbox.Data.Graph (wouldCreateCycle)
 import Lunarbox.Data.Route (Route(..))
 import Lunarbox.Data.Set (toNative) as Set
@@ -267,7 +267,7 @@ component =
       if String.length name >= 2 then do
         { errors, expression } <- get
         printString $ printSource expression
-        for_ errors $ printString <<< printError showLocation
+        for_ errors $ printString <<< printError show
         newState <- gets stateToJson
         raise $ Save newState
         handleAction $ Autosave newState

src/Component/Editor/Add.purs

@@ -23,10 +23,9 @@ import Lunarbox.Component.Icon (icon)
 import Lunarbox.Component.Utils (className, container, whenElem)
 import Lunarbox.Data.Dataflow.Type (Type, inputs, output)
 import Lunarbox.Data.Editor.Constants (arcWidth, nodeRadius)
-import Lunarbox.Data.Editor.ExtendedLocation (ExtendedLocation(..))
 import Lunarbox.Data.Editor.FunctionData (FunctionData, _FunctionDataInputs)
 import Lunarbox.Data.Editor.FunctionName (FunctionName)
-import Lunarbox.Data.Editor.Location (Location)
+import Lunarbox.Data.Editor.Location (Location(..))
 import Lunarbox.Data.Editor.Node (Node(..), hasOutput)
 import Lunarbox.Data.Editor.Node.NodeDescriptor (NodeDescriptor, describe)
 import Lunarbox.Data.Editor.Node.PinLocation (Pin(..))
@@ -69,7 +68,7 @@ nodeInput inputCount typeMap name functionData =
   , mousePosition: zero
   , colorMap:
     generateColorMap
-      (\pin -> Map.lookup (Location name) typeMap >>= resolvePin pin)
+      (\pin -> Map.lookup (AtFunction name) typeMap >>= resolvePin pin)
       node
   , value: Nothing
   , ui: Nothing
@@ -128,7 +127,7 @@ makeNode { edit, addNode, changeInputCount, delete } { isUsable, isEditable, can
                 $ pure
                 <<< highlightTypeToHTML
                 <<< prettify
-                <$> Map.lookup (Location name) typeMap
+                <$> Map.lookup (AtFunction name) typeMap
             , container "curry-node"
                 [ container "curry-text" [ HH.text "inputs:" ]
                 , HH.input

src/Data/Editor/DataflowFunction.purs

@@ -10,9 +10,8 @@ import Data.Lens (Prism', prism')
 import Data.Maybe (Maybe(..))
 import Lunarbox.Data.Dataflow.Expression (Expression(..), NativeExpression)
 import Lunarbox.Data.Editor.Class.Depends (class Depends, getDependencies)
-import Lunarbox.Data.Editor.ExtendedLocation (ExtendedLocation(..))
 import Lunarbox.Data.Editor.FunctionName (FunctionName)
-import Lunarbox.Data.Editor.Node.PinLocation (NodeOrPinLocation)
+import Lunarbox.Data.Editor.Node.PinLocation (ScopedLocation(..))
 import Lunarbox.Data.Editor.NodeGroup (NodeGroup, compileNodeGroup)
 
 -- A dataflow function can either be:
@@ -36,9 +35,9 @@ instance dependencyDataflowFunction :: Depends DataflowFunction FunctionName whe
   getDependencies (NativeFunction _) = mempty
   getDependencies (VisualFunction g) = getDependencies g
 
-compileDataflowFunction :: DataflowFunction -> Expression NodeOrPinLocation
+compileDataflowFunction :: DataflowFunction -> Expression ScopedLocation
 compileDataflowFunction = case _ of
-  NativeFunction f -> Native Nowhere f
+  NativeFunction f -> Native InsideNative f
   VisualFunction g -> compileNodeGroup g
 
 _VisualFunction :: Prism' DataflowFunction NodeGroup

src/Data/Editor/Location.purs

@@ -1,9 +1,82 @@
-module Lunarbox.Data.Editor.Location (Location) where
+module Lunarbox.Data.Editor.Location
+  ( Location(..)
+  , _UnknownLocation
+  , _Function
+  , _ScopedLocation
+  ) where
 
-import Lunarbox.Data.Editor.ExtendedLocation (ExtendedLocation)
+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.Default (class Default)
+import Data.Generic.Rep (class Generic)
+import Data.Lens (Lens', Prism', lens, prism')
+import Data.Maybe (Maybe(..))
 import Lunarbox.Data.Editor.FunctionName (FunctionName)
-import Lunarbox.Data.Editor.Node.PinLocation (NodeOrPinLocation)
+import Lunarbox.Data.Editor.Node.PinLocation (ScopedLocation(..))
 
 -- Location for stuff in Projects
-type Location
-  = ExtendedLocation FunctionName NodeOrPinLocation
+data Location
+  = AtFunction FunctionName
+  | InsideFunction FunctionName ScopedLocation
+  | UnknownLocation
+
+-- Lenses
+_UnknownLocation :: Prism' Location Unit
+_UnknownLocation =
+  prism' (const UnknownLocation) case _ of
+    UnknownLocation -> Just unit
+    _ -> Nothing
+
+_Function :: Lens' Location (Maybe FunctionName)
+_Function =
+  lens
+    ( case _ of
+        AtFunction name -> Just name
+        InsideFunction name _ -> Just name
+        _ -> Nothing
+    )
+    ( \function maybeName -> case maybeName of
+        Just name -> case function of
+          UnknownLocation -> UnknownLocation
+          InsideFunction _ next -> InsideFunction name next
+          AtFunction _ -> AtFunction name
+        Nothing -> function
+    )
+
+_ScopedLocation :: Lens' Location (Maybe ScopedLocation)
+_ScopedLocation =
+  lens
+    ( case _ of
+        InsideFunction _ location -> Just location
+        _ -> Nothing
+    )
+    ( \other -> case other of
+        InsideFunction name _ -> case _ of
+          Just location -> InsideFunction name location
+          Nothing -> other
+        _ -> const other
+    )
+
+-- Typeclass instances
+derive instance eqLocation :: Eq Location
+
+derive instance ordLocation :: Ord Location
+
+derive instance genericLocation :: Generic Location _
+
+instance encodeJsonLocation :: EncodeJson Location where
+  encodeJson = genericEncodeJson
+
+instance decodeJsonLocation :: DecodeJson Location where
+  decodeJson = genericDecodeJson
+
+instance defaultLocation :: Default Location where
+  def = UnknownLocation
+
+instance showLocation :: Show Location where
+  show (AtFunction name) = "inside function" <> show name
+  show (InsideFunction name FunctionDeclaration) = "at the declaration of function " <> show name
+  show (InsideFunction name location) = show location <> " at function " <> show name
+  show UnknownLocation = "at an unknown location"

src/Data/Editor/Node.purs

@@ -31,10 +31,9 @@ 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)
-import Lunarbox.Data.Editor.Node.PinLocation (NodeOrPinLocation, Pin(..), inputNode, outputNode)
+import Lunarbox.Data.Editor.Node.PinLocation (Pin(..), ScopedLocation(..), inputNode, outputNode)
 import Lunarbox.Data.Functor (indexed)
 import Lunarbox.Data.Graph as G
 import Lunarbox.Data.Lens (listToArrayIso)
@@ -97,37 +96,39 @@ connectedInputs :: Node -> List (Tuple Int NodeId)
 connectedInputs = List.catMaybes <<< map (uncurry $ (<$>) <<< Tuple) <<< indexed <<< getInputs
 
 -- Declare a call on a curried function with any number of arguments
-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
+functionCall :: ScopedLocation -> Expression ScopedLocation -> List (Expression ScopedLocation) -> Expression ScopedLocation
+functionCall location calee = wrap location <<< foldl (FunctionCall AtApplication) calee
 
 -- Compile a node into an expression
-compileNode :: G.Graph NodeId Node -> NodeId -> Expression NodeOrPinLocation -> Expression NodeOrPinLocation
+compileNode :: G.Graph NodeId Node -> NodeId -> Expression ScopedLocation -> Expression ScopedLocation
 compileNode nodes id child =
-  flip (maybe nothing) (G.lookup id nodes) case _ of
+  flip (maybe $ TypedHole $ UnexistingNode id) (G.lookup id nodes) case _ of
     InputNode -> inputNode id child
     OutputNode outputId ->
       outputNode id case outputId of
-        Just outputId' -> Variable Nowhere $ VarName $ show outputId'
-        Nothing -> nothing
-    ComplexNode { inputs, function } -> Let Nowhere name value child
+        Just outputId' -> Variable location $ VarName $ show outputId'
+        Nothing -> TypedHole location
+      where
+      location = PinLocation id $ InputPin 1
+    ComplexNode { inputs, function } -> Let (NodeDefinition id) name value child
       where
       name = VarName $ show id
 
-      calee = Variable Nowhere $ VarName $ show function
+      calee = Variable (FunctionUsage function) $ VarName $ show function
 
       arguments =
         mapWithIndex
           ( \index id' ->
               let
-                location = DeepLocation id $ InputPin index
+                location = PinLocation id $ InputPin index
               in
                 case id' of
                   Just id'' -> Variable location $ VarName $ show id''
                   Nothing -> TypedHole location
           )
           inputs
 
-      value = wrap (Location id) $ functionCall (DeepLocation id OutputPin) calee arguments
+      value = wrap (NodeLocation id) $ functionCall (PinLocation id OutputPin) calee arguments
 
 -- Lenses
 _ComplexNode :: Prism' Node ComplexNodeData