feat: more work on waffs issue

.gitignore

@@ -11,5 +11,6 @@ yarn-error.log
 output
 dce-output
 dist
+public/index.js
 
 .env.*

public/index.ts

@@ -1,5 +1,5 @@
 import "./styles/index.scss"
-import { main as mainImpl } from "../dce-output/Main"
+import { main as mainImpl } from "../output/Main"
 
 type Effect<T> = (v: T) => void
 

src/Component/Editor.purs

@@ -13,6 +13,7 @@ import Control.Monad.State (get, gets, modify_, put)
 import Control.MonadZero (guard)
 import Data.Argonaut (Json)
 import Data.Array ((!!))
+import Data.Either (Either(..))
 import Data.Foldable (for_, traverse_)
 import Data.Lens (over, preview, set, view)
 import Data.Map as Map
@@ -42,14 +43,15 @@ import Lunarbox.Component.Modal as Modal
 import Lunarbox.Component.Switch (switch)
 import Lunarbox.Component.Utils (className, container, whenElem)
 import Lunarbox.Config (Config, _autosaveInterval)
+import Lunarbox.Control.Monad.Effect (printString)
 import Lunarbox.Data.Class.GraphRep (toGraph)
 import Lunarbox.Data.Dataflow.Native.Prelude (loadPrelude)
 import Lunarbox.Data.Dataflow.Runtime (RuntimeValue)
 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(..), _atGeometry, _atInputCount, _currentFunction, _currentTab, _isAdmin, _isExample, _isVisible, _name, _nodeSearchTerm, _nodes, _panelIsOpen, compile, createConnection, createNode, deleteFunction, functionExists, generateUnconnectableInputs, generateUnconnectableOutputs, initializeFunction, preventDefaults, removeConnection, searchNode, setCurrentFunction, setRuntimeValue, tabIcon, updateNode, withCurrentGeometries)
+import Lunarbox.Data.Editor.State (State, Tab(..), _atGeometry, _atInputCount, _currentFunction, _currentTab, _isAdmin, _isExample, _isVisible, _name, _nodeSearchTerm, _nodes, _panelIsOpen, compile, createConnection, createNode, deleteFunction, functionExists, generateUnconnectableInputs, generateUnconnectableOutputs, initializeFunction, preventDefaults, removeConnection, searchNode, setCurrentFunction, setRuntimeValue, tabIcon, tryCompiling, updateNode, withCurrentGeometries)
 import Lunarbox.Data.Graph (wouldCreateCycle)
 import Lunarbox.Data.Route (Route(..))
 import Lunarbox.Data.Set (toNative) as Set
@@ -93,6 +95,7 @@ data Action
   | CreateConnection NodeId NodeId Int
   | SelectInput NodeId Int
   | SelectOutput NodeId
+  | HandleConnectionConfirmation ConfirmConnectionAction
 
 data Output
   = Save Json
@@ -282,14 +285,23 @@ component =
                 <<< Scene.LoadScene
             )
     CreateConnection from toId toIndex -> do
-      modify_ $ createConnection from toId toIndex
-      gets (view _currentFunction)
-        >>= traverse_
-            ( \name -> do
-                cache <- gets $ view $ _atGeometry name
-                (map (maybe mempty Map.keys) $ gets $ preview $ _nodes name)
-                  >>= traverse_ updateNode
-            )
+      state <- createConnection from toId toIndex <$> get
+      let
+        { expression, typeMap } = tryCompiling state
+      case typeMap of
+        Left _ -> do
+          modify_ _ { pendingConnection = Just { from, toId, toIndex } }
+          void $ query (SProxy :: SProxy "confirmConnection") unit $ tell Modal.Open
+        Right typeMap' -> do
+          put $ state { expression = expression, typeMap = typeMap' }
+          printString "wth"
+          gets (view _currentFunction)
+            >>= traverse_
+                ( \name -> do
+                    cache <- gets $ view $ _atGeometry name
+                    (map (maybe mempty Map.keys) $ gets $ preview $ _nodes name)
+                      >>= traverse_ updateNode
+                )
     SelectInput id index ->
       void
         $ withCurrentGeometries \cache -> do
@@ -305,6 +317,12 @@ component =
             liftEffect $ setUnconnectableInputs cache $ Set.toNative
               $ generateUnconnectableInputs id state
             handleAction Rerender
+    HandleConnectionConfirmation CancelConnection -> modify_ _ { pendingConnection = Nothing }
+    HandleConnectionConfirmation ConfirmConnection ->
+      gets _.pendingConnection
+        >>= traverse_ \{ from, toId, toIndex } -> do
+            printString "yay"
+            modify_ _ { pendingConnection = Nothing }
 
   handleTreeOutput :: TreeC.Output -> Maybe Action
   handleTreeOutput = case _ of
@@ -318,11 +336,6 @@ component =
     Native.SelectInput id index -> Just $ SelectInput id index
     _ -> Nothing
 
-  handleConnectionConfirmation :: ConfirmConnectionAction -> Maybe Action
-  handleConnectionConfirmation CancelConnection = Nothing
-
-  handleConnectionConfirmation ConfirmConnection = Nothing
-
   sidebarIcon activeTab current =
     HH.div
       [ classes $ ClassName <$> [ "sidebar-icon" ] <> (guard isActive $> "active")
@@ -450,5 +463,7 @@ component =
           ]
       , HH.slot (SProxy :: SProxy "confirmConnection") unit Modal.component
           confirmConnectionModal
-          (handleConnectionConfirmation <<< unwrap)
+          handleConnectionConfirmation
       ]
+    where
+    handleConnectionConfirmation = Just <<< HandleConnectionConfirmation <<< unwrap

src/Component/Foreign/Modal.js

@@ -1,6 +1,8 @@
 "use strict"
 
-const micromodal = require("micromodal")
+const micromodal = require("micromodal").default
+
+console.log(micromodal)
 
 // Reexporting those for use from withing purescript
 exports.showModal = (name) => () =>

src/Component/Foreign/Modal.purs

@@ -9,7 +9,7 @@ module Lunarbox.Component.Modal
   ) where
 
 import Prelude
-import Control.Monad.State (gets, modify_)
+import Control.Monad.State (get, gets)
 import Control.MonadZero (guard)
 import Control.Promise (Promise, toAff)
 import Data.Lens (Lens')
@@ -26,8 +26,6 @@ import Halogen.HTML.Events (onClick)
 import Halogen.HTML.Properties as HP
 import Halogen.HTML.Properties.ARIA as AP
 import Lunarbox.Component.Utils (className)
-import Lunarbox.Control.Monad.Effect (printString)
-import Record as Record
 import Web.HTML (HTMLElement)
 
 foreign import showModal :: String -> Effect (Promise HTMLElement)
@@ -40,7 +38,6 @@ data Action v
 data Query a
   = Close a
   | Open a
-  | IsOpen (Boolean -> a)
 
 type ButtonConfig v
   = { text :: String
@@ -59,9 +56,7 @@ type Input h a v r
     )
 
 type State h a v
-  = Input h a v
-      ( open :: Boolean
-      )
+  = Input h a v ()
 
 _open :: forall r. Lens' { open :: Boolean | r } Boolean
 _open = prop (SProxy :: SProxy "open")
@@ -88,7 +83,7 @@ component ::
   MonadAff m => Component HH.HTML Query (InputType v m) (Output v) m
 component =
   mkComponent
-    { initialState: Record.merge { open: false }
+    { initialState: identity
     , render
     , eval:
       mkEval
@@ -104,29 +99,21 @@ component =
     case action of
       CloseModal value -> do
         liftEffect $ closeModal id
-        modify_ _ { open = false }
         raise $ ClosedWith value
 
   handleQuery :: forall a. Query a -> HalogenM { | State _ _ v } (Action v) ChildSlots (Output v) m (Maybe a)
   handleQuery = case _ of
     Open return -> do
-      printString "opening the modal"
-      id <- gets _.id
-      modify_ _ { open = true }
+      { id, onClose } <- get
       void
         $ fork do
-            onClose <- gets _.onClose
-            promise <- liftEffect $ showModal id
-            void $ liftAff $ toAff promise
-            modify_ _ { open = false }
+            void $ liftAff $ map toAff $ liftEffect $ showModal id
             raise $ ClosedWith onClose
-      pure $ Just $ return
+      pure $ Just return
     Close a -> do
       id <- gets _.id
-      modify_ _ { open = false }
       liftEffect $ closeModal id
       pure $ Just a
-    IsOpen return -> Just <$> return <$> gets _.open
 
   render { id, title, content, buttons } =
     HH.div

src/Data/Editor/State.purs

@@ -5,7 +5,6 @@ import Control.Monad.State (class MonadState, execState, execStateT, gets, put,
 import Control.Monad.State as StateM
 import Control.MonadZero (guard)
 import Data.Array as Array
-import Data.Default (def)
 import Data.Either (Either(..))
 import Data.Filterable (filter, filterMap)
 import Data.Foldable (foldMap, foldr, length, traverse_)
@@ -42,7 +41,7 @@ import Lunarbox.Data.Dataflow.Type (Type, inputs)
 import Lunarbox.Data.Dataflow.TypeError (TypeError)
 import Lunarbox.Data.Editor.DataflowFunction (DataflowFunction(..), _VisualFunction)
 import Lunarbox.Data.Editor.ExtendedLocation (ExtendedLocation(..), _ExtendedLocation, nothing)
-import Lunarbox.Data.Editor.FunctionData (FunctionData, _FunctionDataInputs)
+import Lunarbox.Data.Editor.FunctionData (FunctionData, _FunctionDataInputs, internal)
 import Lunarbox.Data.Editor.FunctionName (FunctionName(..))
 import Lunarbox.Data.Editor.FunctionUi (FunctionUi)
 import Lunarbox.Data.Editor.Location (Location)
@@ -90,6 +89,12 @@ type State a s m
     , functionUis :: Map FunctionName (FunctionUi a s m)
     , runtimeOverwrites :: ValueMap Location
     , inputCountMap :: Map FunctionName Int
+    , pendingConnection ::
+      Maybe
+        { from :: NodeId
+        , toId :: NodeId
+        , toIndex :: Int
+        }
     , name :: String
     , isExample :: Boolean
     , isAdmin :: Boolean
@@ -119,6 +124,7 @@ emptyState =
     , isExample: false
     , isAdmin: false
     , isVisible: false
+    , pendingConnection: Nothing
     }
 
 -- Helpers
@@ -209,7 +215,11 @@ createNode name = do
       gets (view _currentFunction)
         >>= traverse_ \currentFunction -> do
             modify_ $ set (_atNode currentFunction id) $ Just node
-            when isInput $ modify_ $ over (_currentNodeGroup <<< _Just <<< _NodeGroupInputs) $ (_ <> pure id)
+            when isInput do
+              modify_
+                $ over (_atFunctionData currentFunction <<< _Just <<< _FunctionDataInputs)
+                    (_ <> [ { name: "input", description: "The input of a custom function" } ])
+              modify_ $ over (_currentNodeGroup <<< _Just <<< _NodeGroupInputs) $ (_ <> pure id)
             modify_ compile
       pure $ Tuple id inputCount
   Tuple (Tuple id inputs) newState <- gets $ runState create
@@ -322,15 +332,12 @@ canConnect from (Tuple toId toIndex) state =
 
 -- Creates a connection from a node id to a node id an an input index
 createConnection :: forall a s m. NodeId -> NodeId -> Int -> State a s m -> State a s m
-createConnection from toId toIndex state = compile state'
-  where
-  state' =
-    set
-      ( _atCurrentNode toId
-          <<< _nodeInput toIndex
-      )
-      (Just from)
-      state
+createConnection from toId toIndex =
+  set
+    ( _atCurrentNode toId
+        <<< _nodeInput toIndex
+    )
+    (Just from)
 
 -- 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
@@ -347,7 +354,7 @@ initializeFunction name state =
     modify_ $ over _project $ createFunction name id
     modify_ $ setCurrentFunction (Just name)
     modify_ $ set _currentGeometryCache $ Just cache
-    modify_ $ set (_atFunctionData name) (Just def)
+    modify_ $ set (_atFunctionData name) $ Just $ internal [] { name: show name <> "-output", description: "The output of a custom functions" }
     modify_ compile
 
 -- Remove a conenction from the current function

src/Math/SeededRandom.js

@@ -1,11 +1,14 @@
 "use strict"
 
+const seedrandom = require("seedrandom")
+
 /**
  * Generate a seeded random int inside the interval [min, max).
  *
  * @param seed The seed to use for the generation.
  * @param min THe minimum value.
  * @param max The maximum value.
+ * @type { (seed: string) => (min: number) => (max: number) => number }
  */
 exports.seededInt = (seed) => (min) => (max) => {
   const generator = seedrandom(seed)