diff --git a/libs/luna-empire/src/Empire/ASTOps/Read.hs b/libs/luna-empire/src/Empire/ASTOps/Read.hs index c3023834e777..c9102e5649c1 100644 --- a/libs/luna-empire/src/Empire/ASTOps/Read.hs +++ b/libs/luna-empire/src/Empire/ASTOps/Read.hs @@ -323,6 +323,9 @@ isCons expr = isJust <$> IRExpr.narrowTerm @IR.Cons expr isVar :: GraphOp m => NodeRef -> m Bool isVar expr = isJust <$> IRExpr.narrowTerm @IR.Var expr +isASGFunction :: GraphOp m => NodeRef -> m Bool +isASGFunction expr = isJust <$> IRExpr.narrowTerm @IR.ASGFunction expr + dumpPatternVars :: GraphOp m => NodeRef -> m [NodeRef] dumpPatternVars ref = match ref $ \case Var _ -> return [ref] diff --git a/libs/luna-empire/src/Empire/Commands/GraphBuilder.hs b/libs/luna-empire/src/Empire/Commands/GraphBuilder.hs index 98bded7d8a19..6fabd53ecc52 100644 --- a/libs/luna-empire/src/Empire/Commands/GraphBuilder.hs +++ b/libs/luna-empire/src/Empire/Commands/GraphBuilder.hs @@ -415,16 +415,17 @@ buildConnections = do buildInputSidebarTypecheckUpdate :: GraphOp m => NodeId -> m API.NodeTypecheckerUpdate buildInputSidebarTypecheckUpdate nid = do - API.InputSidebar nid ps <- buildInputSidebar nid + API.InputSidebar nid ps _ <- buildInputSidebar nid pure $ API.InputSidebarUpdate nid ps buildInputSidebar :: GraphOp m => NodeId -> m API.InputSidebar buildInputSidebar nid = do ref <- ASTRead.getCurrentASTTarget + isDef <- ASTRead.isASGFunction ref args <- ASTDeconstruct.extractFunctionPorts ref argTrees <- zipWithM buildOutPortTree (pure . Projection <$> [0..]) args - pure $ API.InputSidebar nid argTrees + pure $ API.InputSidebar nid argTrees isDef buildOutputSidebarTypecheckUpdate :: GraphOp m => NodeId -> m API.NodeTypecheckerUpdate buildOutputSidebarTypecheckUpdate nid = do diff --git a/libs/luna-empire/test/EmpireSpec.hs b/libs/luna-empire/test/EmpireSpec.hs index d93d590c2e4c..593ae050bdab 100644 --- a/libs/luna-empire/test/EmpireSpec.hs +++ b/libs/luna-empire/test/EmpireSpec.hs @@ -76,6 +76,7 @@ spec = around withChannels $ parallel $ do length topLevel `shouldBe` 1 topLevel `shouldContain` [u1] i `shouldSatisfy` isJust + i ^? _Just . Node.isDef `shouldBe` Just False o `shouldSatisfy` isJust n1LevelNodes `shouldSatisfy` null it "asserts things about `foo = a: a`" $ \env -> do diff --git a/libs/luna-empire/test/FileLoadSpec.hs b/libs/luna-empire/test/FileLoadSpec.hs index e28ea8e05711..3ee97a6f2630 100644 --- a/libs/luna-empire/test/FileLoadSpec.hs +++ b/libs/luna-empire/test/FileLoadSpec.hs @@ -173,7 +173,7 @@ spec = around withChannels $ parallel $ do let loc' = GraphLocation "TestPath" $ Breadcrumb [Definition (main ^. Node.nodeId)] graph <- Graph.withGraph loc' $ runASTOp $ GraphBuilder.buildGraph return graph - withResult res $ \(Graph.Graph nodes connections _ _ _) -> do + withResult res $ \(Graph.Graph nodes connections i _ _) -> do let Just pi = find (\node -> node ^. Node.name == Just "pi") nodes pi ^. Node.code `shouldBe` "3.14" pi ^. Node.canEnter `shouldBe` False @@ -189,6 +189,7 @@ spec = around withChannels $ parallel $ do let Just c = find (\node -> node ^. Node.name == Just "c") nodes c ^. Node.code `shouldBe` "3" c ^. Node.canEnter `shouldBe` False + i ^? _Just . Node.isDef `shouldBe` Just True connections `shouldMatchList` [ (outPortRef (pi ^. Node.nodeId) [], inPortRef (anon ^. Node.nodeId) [Port.Arg 0]) , (outPortRef (foo ^. Node.nodeId) [], inPortRef (bar ^. Node.nodeId) [Port.Head]) @@ -1402,7 +1403,7 @@ spec = around withChannels $ parallel $ do «1»d = foo 3 d |] - code <- evalEmp env $ do + (inputSidebar, code) <- evalEmp env $ do Library.createLibrary Nothing "TestPath" let loc = GraphLocation "TestPath" $ Breadcrumb [] Graph.loadCode loc initialCode @@ -1414,7 +1415,9 @@ spec = around withChannels $ parallel $ do (input, _) <- Graph.withGraph loc'' $ runASTOp $ GraphBuilder.getEdgePortMapping Graph.removePort loc'' (outPortRef input [Port.Projection 0]) code <- Graph.withUnit loc $ use Graph.code - return code + inputSidebar <- Graph.withGraph loc'' $ runASTOp $ GraphBuilder.buildInputSidebar input + return (inputSidebar, code) + inputSidebar ^. Node.isDef `shouldBe` True normalizeQQ (Text.unpack code) `shouldBe` normalizeQQ [r| def main: «2»def foo: diff --git a/libs/luna-studio-common/src/LunaStudio/Data/Node.hs b/libs/luna-studio-common/src/LunaStudio/Data/Node.hs index 2aaa3653f489..c04e033c7056 100644 --- a/libs/luna-studio-common/src/LunaStudio/Data/Node.hs +++ b/libs/luna-studio-common/src/LunaStudio/Data/Node.hs @@ -32,6 +32,7 @@ data ExpressionNode = ExpressionNode { _exprNodeId :: NodeId data InputSidebar = InputSidebar { _inputNodeId :: NodeId , _inputEdgePorts :: [OutPortTree OutPort] + , _isDef :: Bool } deriving (Eq, Generic, Show, Typeable) data OutputSidebar = OutputSidebar { _outputNodeId :: NodeId