feat: always have a current function

Until now you could be in situations where you didn't edit anything. BREAKING CHANGE: the save structure stores the current function directly instead of a Maybe.
lunarcast · Jul 7, 2020 · dce09ad · dce09ad
1 parent d086246
commit dce09ad
Show file tree

Hide file tree

Showing 5 changed files with 92 additions and 76 deletions.
diff --git a/src/Component/Editor.purs b/src/Component/Editor.purs
@@ -14,6 +14,7 @@ import Control.MonadZero (guard)
 import Data.Argonaut (Json)
 import Data.Array ((!!))
 import Data.Foldable (for_, traverse_)
+import Data.List ((:))
 import Data.Lens (over, set, view)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), isNothing, maybe)
@@ -72,7 +73,7 @@ data Action
   | HandleKey SubscriptionId KeyboardEvent
   | ChangeTab Tab
   | CreateFunction FunctionName
-  | SelectFunction (Maybe FunctionName)
+  | SelectFunction FunctionName
   | CreateNode FunctionName
   | StartFunctionCreation
   | RemoveConnection NodeId Int
@@ -200,7 +201,10 @@ component =
         functionGraph <- gets $ toGraph <<< _.project
         let
           bestMatch = sortedFunctions !! 0
-        when (maybe false not $ wouldCreateCycle <$> bestMatch <*> currentFunction <*> pure functionGraph)
+        when
+          ( maybe false not $ wouldCreateCycle <$> bestMatch <*> Just currentFunction
+              <*> Just functionGraph
+          )
           $ for_ bestMatch (handleAction <<< CreateNode)
       | KE.ctrlKey event && KE.shiftKey event && KE.key event == " " -> do
         inputElement <- getHTMLElementRef searchNodeInputRef
@@ -215,12 +219,12 @@ component =
             initializeFunction inputFunctionName state >>= put
           else
             if exists then
-              handleAction $ SelectFunction $ Just inputFunctionName
+              handleAction $ SelectFunction inputFunctionName
             else
               pure unit
       | KE.ctrlKey event && KE.key event == " " -> do
         sortedFunctions <- gets searchNode
-        handleAction $ SelectFunction $ sortedFunctions !! 0
+        for_ (sortedFunctions !! 0) $ handleAction <<< SelectFunction
       | otherwise -> liftEffect $ stopPropagation $ KE.toEvent event
     CreateNode name -> do
       createNode name
@@ -438,8 +442,8 @@ component =
         , content:
           [ HH.slot (SProxy :: _ "tree") unit TreeC.component
               { functions:
-                (maybe mempty pure currentFunction)
-                  <> ( Set.toUnfoldable $ Map.keys $ onlyEditable currentFunction project
+                currentFunction
+                  : ( Set.toUnfoldable $ Map.keys $ onlyEditable currentFunction project
                     )
               , selected: currentFunction
               }
@@ -481,7 +485,7 @@ component =
               , inputCountMap
               , nodeSearchTerm
               }
-              { edit: Just <<< SelectFunction <<< Just
+              { edit: Just <<< SelectFunction
               , addNode: Just <<< CreateNode
               , changeInputCount: (Just <<< _) <<< ChangeInputCount
               , delete: Just <<< DeleteFunction

diff --git a/src/Component/Editor/Add.purs b/src/Component/Editor/Add.purs
@@ -32,7 +32,7 @@ import Lunarbox.Data.Ord (sortBySearch)
 
 type Input
   = { project :: Project
-    , currentFunction :: Maybe FunctionName
+    , currentFunction :: FunctionName
     , functionData :: Map.Map FunctionName FunctionData
     , typeMap :: Map.Map Location Type
     , inputCountMap :: Map.Map FunctionName Int

diff --git a/src/Component/Editor/Tree.purs b/src/Component/Editor/Tree.purs
@@ -36,7 +36,7 @@ validationErrorToHtml Empty = HH.text "Function names cannot be empty"
 type State
   = { functions :: List FunctionName
     , creating :: Boolean
-    , selected :: Maybe FunctionName
+    , selected :: FunctionName
     , validationError :: Maybe ValidationError
     }
 
@@ -57,18 +57,19 @@ data Query a
 type ChildSlots
   = ()
 
+-- TODO: make State extend this
 type Input
   -- The initial function list and selected function
   = { functions :: List FunctionName
-    , selected :: Maybe FunctionName
+    , selected :: FunctionName
     }
 
 data Output
   -- This notifies the parent when  new function was created
   = CreatedFunction
     FunctionName
   -- This notifies the parent when the selected function changed
-  | SelectedFunction (Maybe FunctionName)
+  | SelectedFunction FunctionName
 
 component :: forall m. MonadEffect m => MonadReader Config m => Component HH.HTML Query Input Output m
 component =
@@ -112,8 +113,8 @@ component =
       shouldCancel <- shouldCancelOnBlur
       when shouldCancel $ modify_ (_ { creating = false })
     SelectFunction name -> do
-      modify_ (_ { selected = Just name })
-      raise $ SelectedFunction $ Just name
+      modify_ (_ { selected = name })
+      raise $ SelectedFunction name
     ValidateFunctionName -> validate
     CreateFunction -> do
       -- validate in case the user pressed enter right away
@@ -135,7 +136,13 @@ component =
                 liftEffect $ traverse_ blur maybeElement
                 -- this saves the new function in the list
                 -- we also automatically select the new function
-                modify_ (_ { creating = false, functions = functions <> (pure functionName), selected = Just functionName })
+                modify_
+                  ( _
+                      { creating = false
+                      , functions = functions <> (pure functionName)
+                      , selected = functionName
+                      }
+                  )
                 -- this notifies the parent element we just created a new function
                 -- the parent ususally has to add the function to the graph
                 raise $ CreatedFunction functionName
@@ -153,14 +160,14 @@ component =
 
   -- renders an element in the list
   -- I'll have to update it when I'll add support for recursive functions
-  displayFunction :: forall a. Maybe FunctionName -> StaticHtml FunctionName a Action
+  displayFunction :: forall a. FunctionName -> StaticHtml FunctionName a Action
   displayFunction selected name =
     HH.div
       [ onClick $ const $ Just $ SelectFunction name
       , classes $ ClassName
           <$> [ "explorer__function" ]
           <> ( "explorer__function--selected"
-                <$ guard (Just name == selected)
+                <$ guard (name == selected)
             )
       ]
       [ icon "code"

diff --git a/src/Data/Editor/Node/NodeDescriptor.purs b/src/Data/Editor/Node/NodeDescriptor.purs
@@ -8,7 +8,7 @@ import Prelude
 import Data.Lens (is)
 import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe(..), isJust, maybe)
+import Data.Maybe (Maybe(..))
 import Lunarbox.Data.Class.GraphRep (toGraph)
 import Lunarbox.Data.Editor.DataflowFunction (_VisualFunction)
 import Lunarbox.Data.Editor.FunctionName (FunctionName)
@@ -21,11 +21,11 @@ type NodeDescriptor
     , canBeDeleted :: Boolean
     }
 
-describe :: Maybe FunctionName -> Project -> Map FunctionName NodeDescriptor
+describe :: FunctionName -> Project -> Map FunctionName NodeDescriptor
 describe currentFunction project@(Project { functions, main }) =
   flip (Map.mapMaybeWithKey) functions \name function ->
     let
-      isCurrent = currentFunction == Just name
+      isCurrent = currentFunction == name
 
       -- TODO: make this actually check the NodeData
       isExternal = false
@@ -37,13 +37,13 @@ describe currentFunction project@(Project { functions, main }) =
           && not isExternal
           && isVisual
 
-      wouldCycle = maybe false (flip (G.wouldCreateCycle name) $ toGraph project) currentFunction
+      wouldCycle = G.wouldCreateCycle name currentFunction $ toGraph project
 
-      isUsable = isJust currentFunction && not wouldCycle
+      isUsable = not wouldCycle
 
       canBeDeleted = isVisual && main /= name
     in
       Just { isUsable, isEditable, canBeDeleted }
 
-onlyEditable :: Maybe FunctionName -> Project -> Map FunctionName NodeDescriptor
-onlyEditable c p = Map.filter (_.isEditable) $ describe c p
+onlyEditable :: FunctionName -> Project -> Map FunctionName NodeDescriptor
+onlyEditable c p = Map.filter _.isEditable $ describe c p
diff --git a/src/Data/Editor/State.purs b/src/Data/Editor/State.purs
@@ -49,7 +49,7 @@ import Lunarbox.Data.Editor.Node (Node(..), _OutputNode, _nodeInput, _nodeInputs
 import Lunarbox.Data.Editor.Node.NodeId (NodeId(..))
 import Lunarbox.Data.Editor.Node.PinLocation (Pin(..), ScopedLocation(..))
 import Lunarbox.Data.Editor.NodeGroup (NodeGroup(..), _NodeGroupInputs, _NodeGroupNodes, _NodeGroupOutput)
-import Lunarbox.Data.Editor.Project (Project(..), _ProjectFunctions, _atProjectFunction, _atProjectNode, _projectNodeGroup, compileProject, createFunction)
+import Lunarbox.Data.Editor.Project (Project(..), _ProjectFunctions, _ProjectMain, _atProjectFunction, _atProjectNode, _projectNodeGroup, compileProject, createFunction)
 import Lunarbox.Data.Graph as G
 import Lunarbox.Data.Ord (sortBySearch)
 import Lunarbox.Foreign.Render (GeometryCache, emptyGeometryCache)
@@ -89,7 +89,7 @@ type StatePermanentData r
     , nextId :: Int
     , geometries :: Map FunctionName GeometryCache
     , runtimeOverwrites :: ValueMap Location
-    , currentFunction :: Maybe FunctionName
+    , currentFunction :: FunctionName
     | r
     )
 
@@ -128,7 +128,7 @@ emptyState :: forall a s m f. MonadEffect f => f (State a s m)
 emptyState =
   initializeFunction (FunctionName "main")
     { currentTab: Settings
-    , currentFunction: Nothing
+    , currentFunction: FunctionName "main"
     , nextId: 0
     , panelIsOpen: false
     , typeMap: mempty
@@ -359,9 +359,10 @@ canConnect from (Tuple toId toIndex) state =
   fromMaybe false do
     let
       typeMap = view _typeMap state
+
+      currentFunction = view _currentFunction state
     nodes <- preview _currentNodes state
     guard $ not $ G.wouldCreateCycle from toId $ toGraph nodes
-    currentFunction <- view _currentFunction state
     fromType <- getOutputType currentFunction from state
     toType <- Map.lookup (InsideFunction currentFunction $ PinLocation toId $ InputPin toIndex) typeMap
     guard $ canUnify toType fromType
@@ -377,7 +378,7 @@ createConnection from toId 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
+setCurrentFunction :: forall a s m. FunctionName -> State a s m -> State a s m
 setCurrentFunction = set _currentFunction
 
 -- Creates a function, adds an output node and set it as the current edited function
@@ -389,7 +390,7 @@ initializeFunction name state =
     cache <- liftEffect emptyGeometryCache
     liftEffect $ Native.createNode cache id 1 false Nullable.null
     modify_ $ over _project $ createFunction name id
-    modify_ $ setCurrentFunction (Just name)
+    modify_ $ setCurrentFunction name
     modify_ $ set _currentGeometryCache $ Just cache
     modify_ $ set (_atFunctionData name) $ Just $ internal [] { name: show name <> "-output", description: "The output of a custom functions" }
     modify_ compile
@@ -440,31 +441,33 @@ deleteFunctionReferences toDelete functionName graph state =
 -- Delete a function from the state
 deleteFunction :: forall a s m. FunctionName -> State a s m -> State a s m
 deleteFunction toDelete state =
-  flip execState state do
-    let
-      visualFunctions =
-        filterMap
-          ( \(Tuple name function) ->
-              Tuple name
-                <$> preview _VisualFunction function
-          )
-          $ ( Map.toUnfoldable
-                $ view _functions state ::
-                List _
-            )
-    put
-      $ foldr
-          (\(Tuple functionName nodeGroup) -> deleteFunctionReferences toDelete functionName $ view _NodeGroupNodes nodeGroup)
-          state
-          visualFunctions
-    modify_ $ set (_atFunctionData toDelete) Nothing
-    modify_ $ set (_function toDelete) Nothing
-    -- TODO: make this work with the new foreign system
-    -- modify_ $ over _nodeData $ Map.filterKeys $ (_ /= toDelete) <<< fst
-    modify_ $ over _runtimeOverwrites $ Newtype.over ValueMap $ Map.filterKeys $ (_ /= Just toDelete) <<< view _Function
-    modify_ $ set (_atInputCount toDelete) Nothing
-    when (view _currentFunction state == Just toDelete) $ modify_ $ set _currentFunction Nothing
-    modify_ compile
+  flip execState state
+    $ unless (main == toDelete) do
+        let
+          visualFunctions =
+            filterMap
+              ( \(Tuple name function) ->
+                  Tuple name
+                    <$> preview _VisualFunction function
+              )
+              $ ( Map.toUnfoldable
+                    $ view _functions state ::
+                    List _
+                )
+        put
+          $ foldr
+              (\(Tuple functionName nodeGroup) -> deleteFunctionReferences toDelete functionName $ view _NodeGroupNodes nodeGroup)
+              state
+              visualFunctions
+        modify_ $ set (_atFunctionData toDelete) Nothing
+        modify_ $ set (_function toDelete) Nothing
+        modify_ $ over _runtimeOverwrites $ Newtype.over ValueMap $ Map.filterKeys $ (_ /= Just toDelete) <<< view _Function
+        modify_ $ set (_atInputCount toDelete) Nothing
+        modify_ $ set (_atGeometry toDelete) Nothing
+        when (view _currentFunction state == toDelete) $ modify_ $ set _currentFunction main
+        modify_ compile
+  where
+  main = view _ProjectMain state.project
 
 -- Sets the runtime value at a location to any runtime value
 setRuntimeValue :: forall a s m. FunctionName -> NodeId -> RuntimeValue -> State a s m -> State a s m
@@ -503,8 +506,8 @@ preventDefaults :: forall q i o m a s. MonadEffect m => Event -> HalogenM (State
 preventDefaults event = liftEffect $ Event.preventDefault event *> Event.stopPropagation event
 
 -- | Run an action which needs access to the current function
-withCurrentFunction :: forall f a s m r. MonadState (State a s m) f => (FunctionName -> f r) -> f (Maybe r)
-withCurrentFunction f = gets (view _currentFunction) >>= traverse f
+withCurrentFunction :: forall f a s m r. MonadState (State a s m) f => (FunctionName -> f r) -> f r
+withCurrentFunction f = gets (view _currentFunction) >>= f
 
 -- | Run an action which need access to the current function and which returns nothing
 withCurrentFunction_ :: forall f a s m r. MonadState (State a s m) f => (FunctionName -> f r) -> f Unit
@@ -540,15 +543,11 @@ getNodeValue currentFunction (ValueMap vmap) id = case _ of
 -- Update all nodes in the current geometry
 updateAll :: forall a s m n. MonadState (State a s n) m => MonadEffect m => m (Maybe GeometryCache)
 updateAll =
-  gets (view _currentFunction)
-    >>= traverse
-        ( \name -> do
-            cache <- gets $ view $ _atGeometry name
-            (map (maybe mempty Map.keys) $ gets $ preview $ _nodes name)
-              >>= traverse_ updateNode
-            pure cache
-        )
-    <#> join
+  withCurrentFunction \name -> do
+    cache <- gets $ view $ _atGeometry name
+    (map (maybe mempty Map.keys) $ gets $ preview $ _nodes name)
+      >>= traverse_ updateNode
+    pure cache
 
 -- Lenses
 _inputCountMap :: forall a s m. Lens' (State a s m) (Map FunctionName Int)
@@ -602,7 +601,7 @@ _atNode name id = _project <<< _atProjectNode name id
 _function :: forall a s m. FunctionName -> Traversal' (State a s m) (Maybe DataflowFunction)
 _function name = _project <<< _atProjectFunction name
 
-_currentFunction :: forall a s m. Lens' (State a s m) (Maybe FunctionName)
+_currentFunction :: forall a s m. Lens' (State a s m) FunctionName
 _currentFunction = prop (SProxy :: _ "currentFunction")
 
 _panelIsOpen :: forall a s m. Lens' (State a s m) Boolean
@@ -614,29 +613,35 @@ _currentTab = prop (SProxy :: _ "currentTab")
 _currentNodeGroup :: forall a s m. Lens' (State a s m) (Maybe NodeGroup)
 _currentNodeGroup =
   ( lens
-      ( \state -> do
-          currentFunction <- view _currentFunction state
-          preview (_nodeGroup currentFunction) state
+      ( \state ->
+          let
+            current = view _currentFunction state
+          in
+            preview (_nodeGroup current) state
       )
       ( \state maybeValue ->
           fromMaybe state do
+            let
+              currentFunction = view _currentFunction state
             value <- maybeValue
-            currentFunction <- view _currentFunction state
             pure $ set (_nodeGroup currentFunction) value state
       )
   )
 
 _currentGeometryCache :: forall a s m. Lens' (State a s m) (Maybe GeometryCache)
 _currentGeometryCache =
   ( lens
-      ( \state -> do
-          currentFunction <- view _currentFunction state
-          view (_atGeometry currentFunction) state
+      ( \state ->
+          let
+            currentFunction = view _currentFunction state
+          in
+            view (_atGeometry currentFunction) state
       )
       ( \state maybeValue ->
-          fromMaybe state do
-            currentFunction <- view _currentFunction state
-            pure $ set (_atGeometry currentFunction) maybeValue state
+          let
+            currentFunction = view _currentFunction state
+          in
+            set (_atGeometry currentFunction) maybeValue state
       )
   )