Add CollapseToFunction request. enso-org#28

libs/luna-studio-common/src/LunaStudio/API/Graph/CollapseToFunction.hs

@@ -0,0 +1,37 @@
+module LunaStudio.API.Graph.CollapseToFunction where
+
+import           Data.Binary                   (Binary)
+import qualified LunaStudio.API.Graph.Request  as G
+import           LunaStudio.API.Graph.Result   (Result)
+import qualified LunaStudio.API.Request        as R
+import qualified LunaStudio.API.Response       as Response
+import qualified LunaStudio.API.Topic          as T
+import           LunaStudio.Data.Connection    (Connection)
+import           LunaStudio.Data.GraphLocation (GraphLocation)
+import           LunaStudio.Data.Node          (ExpressionNode)
+import           LunaStudio.Data.NodeLoc       (NodeLoc)
+import           Prologue                      hiding (TypeRep)
+
+
+data Request = Request { _location :: GraphLocation
+                       , _nodeLocs :: [NodeLoc]
+                       } deriving (Eq, Generic, NFData, Show)
+
+data Inverse = Inverse { _nodes       :: [ExpressionNode]
+                       , _connections :: [Connection]
+                       } deriving (Eq, Generic, NFData, Show)
+
+makeLenses ''Request
+makeLenses ''Inverse
+instance Binary Request
+instance Binary Inverse
+instance G.GraphRequest Request where location = location
+
+
+type Response = Response.Response Request Inverse Result
+instance Response.ResponseResult Request Inverse Result
+
+topicPrefix :: T.Topic
+topicPrefix = "empire.graph.node.collapsetofunction"
+instance T.MessageTopic (R.Request Request) where topic _ = topicPrefix <> T.request
+instance T.MessageTopic Response            where topic _ = topicPrefix <> T.response

libs/luna-studio-common/src/LunaStudio/API/JSONInstances.hs

@@ -18,6 +18,7 @@ import           LunaStudio.API.Graph.AddPort               as AddPort
 import           LunaStudio.API.Graph.AddSubgraph           as AddSubgraph
 import           LunaStudio.API.Graph.AutolayoutNodes       as AutolayoutNodes
 import           LunaStudio.API.Graph.CollaborationUpdate   as CollaborationUpdate
+import           LunaStudio.API.Graph.CollapseToFunction    as CollapseToFunction
 import           LunaStudio.API.Graph.DumpGraphViz          as DumpGraphViz
 import           LunaStudio.API.Graph.GetProgram            as GetProgram
 import           LunaStudio.API.Graph.GetSubgraphs          as GetSubgraphs
@@ -128,6 +129,8 @@ instance ToJSON Breadcrumb.BreadcrumbItem
 instance ToJSON CloseFile.Request
 instance ToJSON CollaborationUpdate.Event
 instance ToJSON CollaborationUpdate.Update
+instance ToJSON CollapseToFunction.Inverse
+instance ToJSON CollapseToFunction.Request
 instance ToJSON Connection.Connection
 instance ToJSON CreateLibrary.Request
 instance ToJSON CreateLibrary.Result

luna-studio/atom/keymaps/luna-studio.cson

@@ -128,6 +128,7 @@
   'enter'             : 'luna-studio:expand-selected-nodes'       # ExpandSelectedNodes
   'ctrl-enter'        : 'luna-studio:edit-selected-nodes'         # EditSelectedNodes
   'cmd-enter'         : 'luna-studio:edit-selected-nodes'         # EditSelectedNodes
+  'f'                 : 'luna-studio:collapse-to-function'        # CollapseToFunction
   'ctrl-space'        : 'luna-studio:zoom-visualization'          # ZoomVisualization
   'space'             : 'luna-studio:open-visualization-preview'  # OpenVisualizationPreview
   '^space'            : 'luna-studio:close-visualization-preview' # CloseVisualizationPreview

luna-studio/atom/lib/main.coffee

@@ -130,16 +130,17 @@ module.exports = LunaStudio =
     @subs.add atom.commands.add '.luna-studio', 'luna-studio:go-right':      -> pushShortcutEvent("GoRight")
     @subs.add atom.commands.add '.luna-studio', 'luna-studio:go-up':         -> pushShortcutEvent("GoUp")
     # nodes
-    @subs.add atom.commands.add '.luna-studio', 'luna-studio:edit-selected-nodes':         -> pushShortcutEvent("EditSelectedNodes")
-    @subs.add atom.commands.add '.luna-studio', 'luna-studio:zoom-visualization':          -> pushShortcutEvent("ZoomVisualization")
-    @subs.add atom.commands.add '.luna-studio', 'luna-studio:open-visualization-preview':  -> pushShortcutEvent("OpenVisualizationPreview")
+    @subs.add atom.commands.add '.luna-studio', 'luna-studio:autolayout-all-nodes':        -> pushShortcutEvent("AutolayoutAllNodes")
+    @subs.add atom.commands.add '.luna-studio', 'luna-studio:autolayout-selected-nodes':   -> pushShortcutEvent("AutolayoutSelectedNodes")
     @subs.add atom.commands.add '.luna-studio', 'luna-studio:close-visualization-preview': -> pushShortcutEvent("CloseVisualizationPreview")
+    @subs.add atom.commands.add '.luna-studio', 'luna-studio:collapse-to-function':        -> pushShortcutEvent("CollapseToFunction")
+    @subs.add atom.commands.add '.luna-studio', 'luna-studio:edit-selected-nodes':         -> pushShortcutEvent("EditSelectedNodes")
     @subs.add atom.commands.add '.luna-studio', 'luna-studio:expand-selected-nodes':       -> pushShortcutEvent("ExpandSelectedNodes")
+    @subs.add atom.commands.add '.luna-studio', 'luna-studio:open-visualization-preview':  -> pushShortcutEvent("OpenVisualizationPreview")
     @subs.add atom.commands.add '.luna-studio', 'luna-studio:remove-selected-nodes':       -> pushShortcutEvent("RemoveSelectedNodes")
     @subs.add atom.commands.add '.luna-studio', 'luna-studio:select-all':                  -> pushShortcutEvent("SelectAll")
     @subs.add atom.commands.add '.luna-studio', 'luna-studio:unfold-selected-nodes':       -> pushShortcutEvent("UnfoldSelectedNodes")
-    @subs.add atom.commands.add '.luna-studio', 'luna-studio:autolayout-selected-nodes':   -> pushShortcutEvent("AutolayoutSelectedNodes")
-    @subs.add atom.commands.add '.luna-studio', 'luna-studio:autolayout-all-nodes':        -> pushShortcutEvent("AutolayoutAllNodes")
+    @subs.add atom.commands.add '.luna-studio', 'luna-studio:zoom-visualization':          -> pushShortcutEvent("ZoomVisualization")
     # searcher
     @subs.add atom.commands.add '.luna-studio',   'luna-studio:searcher-open':         -> pushShortcutEvent("SearcherOpen")
     @subs.add atom.commands.add '.luna-searcher', 'luna-studio:searcher-accept-0':     -> pushSearcherEvent("HintShortcut", 0)

luna-studio/node-editor/src/NodeEditor/Action/Basic.hs

@@ -2,6 +2,7 @@ module NodeEditor.Action.Basic
     ( addPort
     , addSubgraph
     , centerGraph
+    , collapseToFunction
     , connect
     , createGraph
     , createNode
@@ -108,6 +109,7 @@ import           NodeEditor.Action.Basic.AddPort             (addPort, localAddP
 import           NodeEditor.Action.Basic.AddSubgraph         (addSubgraph, localAddSubgraph, localUpdateSubgraph)
 import           NodeEditor.Action.Basic.Atom                (setFile, unsetFile)
 import           NodeEditor.Action.Basic.CenterGraph         (centerGraph)
+import           NodeEditor.Action.Basic.CollapseToFunction  (collapseToFunction)
 import           NodeEditor.Action.Basic.CreateGraph         (createGraph, updateGraph)
 import           NodeEditor.Action.Basic.EnterBreadcrumb     (enterBreadcrumb, enterBreadcrumbs, enterNode, exitBreadcrumb)
 import           NodeEditor.Action.Basic.FocusNode           (focusNode, focusNodes, updateNodeZOrder)

luna-studio/node-editor/src/NodeEditor/Action/Basic/CollapseToFunction.hs

@@ -0,0 +1,13 @@
+module NodeEditor.Action.Basic.CollapseToFunction where
+
+import           Common.Prelude
+import qualified NodeEditor.Action.Batch            as Batch
+import           NodeEditor.Action.Command          (Command)
+import           NodeEditor.Action.State.NodeEditor (getSelectedNodes)
+import           NodeEditor.React.Model.Node        (nodeLoc)
+import           NodeEditor.State.Global            (State)
+
+
+
+collapseToFunction :: Command State ()
+collapseToFunction = Batch.collapseToFunction =<< view nodeLoc `fmap2` getSelectedNodes

luna-studio/node-editor/src/NodeEditor/Action/Batch.hs

@@ -67,6 +67,10 @@ autolayoutNodes :: [NodeLoc] -> Command State ()
 autolayoutNodes []  = return ()
 autolayoutNodes nls = withWorkspace $ BatchCmd.autolayoutNodes nls
 
+collapseToFunction :: [NodeLoc] -> Command State ()
+collapseToFunction []  = return ()
+collapseToFunction nls = withWorkspace $ BatchCmd.collapseToFunction nls
+
 getSubgraph :: NodeLoc -> Command State ()
 getSubgraph nl = withWorkspace (BatchCmd.getSubgraph nl)
 

luna-studio/node-editor/src/NodeEditor/Batch/Connector/Commands.hs

@@ -12,6 +12,7 @@ import qualified LunaStudio.API.Graph.AddSubgraph         as AddSubgraph
 import qualified LunaStudio.API.Graph.AutolayoutNodes     as AutolayoutNodes
 import           LunaStudio.API.Graph.CollaborationUpdate (ClientId)
 import qualified LunaStudio.API.Graph.CollaborationUpdate as CollaborationUpdate
+import qualified LunaStudio.API.Graph.CollapseToFunction  as CollapseToFunction
 import qualified LunaStudio.API.Graph.DumpGraphViz        as DumpGraphViz
 import qualified LunaStudio.API.Graph.GetProgram          as GetProgram
 import qualified LunaStudio.API.Graph.GetSubgraphs        as GetSubgraphs
@@ -105,6 +106,10 @@ addSubgraph nodes connections workspace uuid guiID = sendRequest $ Message uuid
 autolayoutNodes :: [NodeLoc] -> Workspace -> UUID -> Maybe UUID -> IO ()
 autolayoutNodes nls workspace uuid guiID = sendRequest $ Message uuid guiID $ (withLibrary workspace AutolayoutNodes.Request) nls
 
+collapseToFunction :: [NodeLoc] -> Workspace -> UUID -> Maybe UUID ->  IO ()
+collapseToFunction nodeLocs workspace uuid guiID = sendRequest $ Message uuid guiID $ withLibrary workspace' CollapseToFunction.Request nodeLocs' where
+    (workspace', nodeLocs') = normalise' workspace nodeLocs
+
 getSubgraph :: NodeLoc -> Workspace -> UUID -> Maybe UUID -> IO ()
 getSubgraph nodeLoc workspace uuid guiID = sendRequest $ Message uuid guiID $ withLibrary workspace $ GetSubgraphs.Request . (GraphLocation.breadcrumb .~ NodeLoc.toBreadcrumb (NodeLoc.prependPath workspace nodeLoc))
 

luna-studio/node-editor/src/NodeEditor/Event/Batch.hs

@@ -11,6 +11,7 @@ import qualified LunaStudio.API.Graph.AddPort               as AddPort
 import qualified LunaStudio.API.Graph.AddSubgraph           as AddSubgraph
 import qualified LunaStudio.API.Graph.AutolayoutNodes       as AutolayoutNodes
 import qualified LunaStudio.API.Graph.CollaborationUpdate   as CollaborationUpdate
+import qualified LunaStudio.API.Graph.CollapseToFunction    as CollapseToFunction
 import qualified LunaStudio.API.Graph.DumpGraphViz          as DumpGraphViz
 import qualified LunaStudio.API.Graph.GetProgram            as GetProgram
 import qualified LunaStudio.API.Graph.GetSubgraphs          as GetSubgraphs
@@ -44,6 +45,7 @@ data Event = UnknownEvent String
            | AddSubgraphResponse                   AddSubgraph.Response
            | AutolayoutNodesResponse           AutolayoutNodes.Response
            | CollaborationUpdate           CollaborationUpdate.Update
+           | CollapseToFunctionResponse     CollapseToFunction.Response
            | ConnectionDropped
            | ConnectionOpened
            | DumpGraphVizResponse                 DumpGraphViz.Response

luna-studio/node-editor/src/NodeEditor/Event/Keys.hs

@@ -2,7 +2,7 @@ module NodeEditor.Event.Keys where
 
 import           Common.Prelude
 
-import           React.Flux          (KeyboardEvent (KeyboardEvent))
+import           React.Flux     (KeyboardEvent (KeyboardEvent))
 
 
 backspace, tab, enter, esc, space, leftArrow, upArrow, rightArrow, downArrow, del :: Int
@@ -17,11 +17,12 @@ rightArrow = 39
 downArrow  = 40
 del        = 46
 
-zero, nine, a, e, h, l, y, z, plus, minus :: Int
+zero, nine, a, e, f, h, l, y, z, plus, minus :: Int
 zero  = 48
 nine  = 57
 a     = 65
 e     = 69
+f     = 70
 h     = 72
 l     = 76
 y     = 89

luna-studio/node-editor/src/NodeEditor/Event/Preprocessor/Shortcut.hs

@@ -56,13 +56,14 @@ handleKeyApp evt
     -- nodes
     | Keys.withCtrl         evt Keys.a          = Just SelectAll
     | Keys.withCtrl         evt Keys.e          = Just UnfoldSelectedNodes
+    | Keys.withCtrl         evt Keys.enter      = Just EditSelectedNodes
+    | Keys.withCtrl         evt Keys.l          = Just AutolayoutAllNodes
+    | Keys.withCtrl         evt Keys.space      = Just ZoomVisualization
     | Keys.withoutMods      evt Keys.backspace  = Just RemoveSelectedNodes
     | Keys.withoutMods      evt Keys.del        = Just RemoveSelectedNodes
     | Keys.withoutMods      evt Keys.enter      = Just ExpandSelectedNodes
-    | Keys.withCtrl         evt Keys.enter      = Just EditSelectedNodes
-    | Keys.withCtrl         evt Keys.space      = Just ZoomVisualization
+    | Keys.withoutMods      evt Keys.f          = Just CollapseToFunction
     | Keys.withoutMods      evt Keys.l          = Just AutolayoutSelectedNodes
-    | Keys.withCtrl         evt Keys.l          = Just AutolayoutAllNodes
     -- searcher
     | Keys.withoutMods evt Keys.tab             = Just SearcherOpen
     -- undo / redo

luna-studio/node-editor/src/NodeEditor/Event/Shortcut.hs

@@ -34,16 +34,17 @@ data Command = Cancel
              | GoRight
              | GoUp
              -- node
-             | SelectAll
-             | RemoveSelectedNodes
+             | AutolayoutAllNodes
+             | AutolayoutSelectedNodes
+             | CloseVisualizationPreview
+             | CollapseToFunction
+             | EditSelectedNodes
              | ExpandSelectedNodes
+             | OpenVisualizationPreview
+             | RemoveSelectedNodes
+             | SelectAll
              | UnfoldSelectedNodes
-             | EditSelectedNodes
              | ZoomVisualization
-             | OpenVisualizationPreview
-             | CloseVisualizationPreview
-             | AutolayoutSelectedNodes
-             | AutolayoutAllNodes
              -- searcher
              | SearcherOpen
              -- undo/redo

luna-studio/node-editor/src/NodeEditor/Handler/Backend/Graph.hs

@@ -12,6 +12,7 @@ import qualified LunaStudio.API.Graph.AddPort                as AddPort
 import qualified LunaStudio.API.Graph.AddSubgraph            as AddSubgraph
 import qualified LunaStudio.API.Graph.AutolayoutNodes        as AutolayoutNodes
 import qualified LunaStudio.API.Graph.CollaborationUpdate    as CollaborationUpdate
+import qualified LunaStudio.API.Graph.CollapseToFunction     as CollapseToFunction
 import qualified LunaStudio.API.Graph.GetProgram             as GetProgram
 import qualified LunaStudio.API.Graph.GetSubgraphs           as GetSubgraphs
 import qualified LunaStudio.API.Graph.MonadsUpdate           as MonadsUpdate
@@ -175,6 +176,12 @@ handle (Event.Batch ev) = Just $ case ev of
                 CollaborationUpdate.CancelTouch nodeLocs -> touchNodes nodeLocs $  Node.collaboration . Node.touch  . at clientId .= Nothing
                 CollaborationUpdate.Refresh             -> touchCurrentlySelected
 
+    CollapseToFunctionResponse response -> handleResponse response success doNothing where
+        requestId       = response ^. Response.requestId
+        request         = response ^. Response.request
+        location        = request  ^. CollapseToFunction.location
+        success         = applyResult location
+
     DumpGraphVizResponse response -> handleResponse response doNothing doNothing
 
     --TODO[LJK, PM]: Review this Handler

luna-studio/node-editor/src/NodeEditor/Handler/Node.hs

@@ -2,9 +2,9 @@ module NodeEditor.Handler.Node where
 
 import           Common.Prelude
 import           Data.ScreenPosition                        (ScreenPosition)
-import           NodeEditor.Action.Basic                    (enterNode, localSetPortDefault, removeSelectedNodes, selectAll,
-                                                             setNodeExpression, setPortDefault, toggleSelect, toggleSelectedNodesMode,
-                                                             toggleSelectedNodesUnfold)
+import           NodeEditor.Action.Basic                    (collapseToFunction, enterNode, localSetPortDefault, removeSelectedNodes,
+                                                             selectAll, setNodeExpression, setPortDefault, toggleSelect,
+                                                             toggleSelectedNodesMode, toggleSelectedNodesUnfold)
 import           NodeEditor.Action.Batch                    (autolayoutNodes)
 import           NodeEditor.Action.Command                  (Command)
 import qualified NodeEditor.Action.Node                     as Node
@@ -45,13 +45,14 @@ handle _ = Nothing
 
 handleCommand :: Shortcut.Command -> Command State ()
 handleCommand = \case
-    Shortcut.SelectAll               -> selectAll
-    Shortcut.RemoveSelectedNodes     -> removeSelectedNodes
-    Shortcut.ExpandSelectedNodes     -> toggleSelectedNodesMode $ Node.Expanded Node.Controls
+    Shortcut.AutolayoutAllNodes      -> map (view Node.nodeLoc) <$> getExpressionNodes >>= autolayoutNodes
+    Shortcut.AutolayoutSelectedNodes -> map (view Node.nodeLoc) <$> getSelectedNodes   >>= autolayoutNodes
+    Shortcut.CollapseToFunction      -> collapseToFunction
     -- Shortcut.EditSelectedNodes       -> toggleSelectedNodesMode $ Node.Expanded Node.Editor --TEMPORARILY DISABLED
+    Shortcut.ExpandSelectedNodes     -> toggleSelectedNodesMode $ Node.Expanded Node.Controls
+    Shortcut.RemoveSelectedNodes     -> removeSelectedNodes
+    Shortcut.SelectAll               -> selectAll
     Shortcut.UnfoldSelectedNodes     -> toggleSelectedNodesUnfold
-    Shortcut.AutolayoutSelectedNodes -> map (view Node.nodeLoc) <$> getSelectedNodes   >>= autolayoutNodes
-    Shortcut.AutolayoutAllNodes      -> map (view Node.nodeLoc) <$> getExpressionNodes >>= autolayoutNodes
     _                                -> return ()
 
 handleMouseDown :: MouseEvent -> NodeLoc -> Command State ()