feat(client): rendering nested lambdas should work now

packages/client/spago.dhall

@@ -12,13 +12,15 @@
   , "transformers"
   , "tuples"
   , "typelevel-prelude"
+  , "sized-vectors"
   , "undefined"
   , "effect"
   , "console"
   , "canvas"
   , "run"
   , "fixed-points"
   , "matryoshka"
+  , "undefined-is-not-a-problem"
   , "lunarflow-utils"
   , "lunarflow-core"
   , "lunarflow-geometry"

packages/client/src/Main.purs

@@ -4,7 +4,7 @@ import Prelude
 import Data.List as List
 import Data.Maybe (Maybe(..), fromJust)
 import Data.Tuple (fst)
-import Debug.Trace (traceM)
+import Debug.Trace (spy)
 import Effect (Effect)
 import Effect.Console as Console
 import Graphics.Canvas (getCanvasElementById, getContext2D)
@@ -15,35 +15,33 @@ import Lunarflow.Geometry.Foreign (Geometry, fromShape, renderGeometry)
 import Lunarflow.Layout (addIndices, fromScoped, runLayoutM)
 import Lunarflow.Parser (unsafeParseLambdaCalculus)
 import Lunarflow.Renderer.WithHeight (withHeights)
-import Lunarflow.Debug (debugSpy)
 import Partial.Unsafe (unsafePartial)
 
 geometry :: Geometry
 geometry =
-  fromShape $ runRenderM
+  fromShape $ spy "shape" $ runRenderM
     $ render
-    $ debugSpy
     $ fst
     $ withHeights
     $ unsafePartial
     $ fromJust
-    -- TODO: fix bug with application creating a line in the same place as the lambda used as argument.
-
     $ flip List.index 0
     $ List.catMaybes
     $ map fromScoped
     $ runLayoutM
     $ addIndices
     $ groupExpression
     $ withDebrujinIndices
-    $ unsafeParseLambdaCalculus """\f a b -> f b a \x -> x"""
+    -- $ debugSpy
+
+    $ unsafeParseLambdaCalculus """\f. (\x. f (x x)) (\y. f (y y))"""
 
+-- $ unsafeParseLambdaCalculus """\f x y. f y x \x -> y x"""
 main :: Effect Unit
 main = do
   canvas <- getCanvasElementById "canvas"
   case canvas of
     Nothing -> Console.log "No canvas found"
     Just canvas' -> do
       ctx <- getContext2D canvas'
-      traceM geometry
       renderGeometry geometry ctx

packages/client/src/Render.purs

@@ -1,26 +1,33 @@
+-- TODO: Document this
 module Lunarbox.Render where
 
 import Prelude
+import Data.Array as Array
+import Data.Array.NonEmpty as NonEmptyArray
+import Data.Bifunctor (lmap)
 import Data.FoldableWithIndex (foldrWithIndex)
 import Data.List as List
+import Data.Maybe (fromMaybe)
 import Data.Set as Set
-import Data.Tuple (Tuple(..))
-import Debug.Trace (traceM)
+import Data.Tuple (Tuple(..), fst, snd)
+import Data.Unfoldable (replicate)
+import Data.Vec (vec2)
 import Lunarflow.Ast (AstF(..), isVar)
 import Lunarflow.Geometry.Foreign (getRightBound)
 import Lunarflow.Geometry.Foreign as ForeignShape
+import Lunarflow.Geometry.Types (Bounds)
 import Lunarflow.Geometry.Types as Shape
-import Lunarflow.Geometry.Utils (withPadding)
-import Lunarflow.Renderer.WithHeight (YLayout, YLayoutF, YMapSlice, getPosition)
-import Matryoshka (GAlgebra, para)
+import Lunarflow.Label (class Label)
+import Lunarflow.Renderer.WithHeight (YLayout, YLayoutF, YMapSlice)
+import Matryoshka (GAlgebra, para, project)
 import Run (Run, extract)
 import Run.Reader (READER, ask, local, runReader)
 
 type RenderContext
   = { doNotRender :: Set.Set Int
     , start :: Int
     , end :: Int
-    , slice :: YMapSlice
+    , slices :: List.List YMapSlice
     }
 
 type RenderM r
@@ -36,83 +43,136 @@ lineHeight = 50
 lineWidth :: Int
 lineWidth = 100
 
-{-- 
-So:
-- When we encounter a lambda, we draw the body and then the box around it
-- When we encouner a var, we check where it is in scope and draw until here
---}
+type ScopedShape
+  = Tuple Int Shape.Shape
+
+type RenderList
+  = NonEmptyArray.NonEmptyArray ScopedShape
+
+inScope ::
+  Int ->
+  RenderList ->
+  { no :: Array ScopedShape
+  , yes :: Array ScopedShape
+  }
+inScope max = NonEmptyArray.partition (fst >>> (_ < max))
+
+shiftScope :: Int -> ScopedShape -> ScopedShape
+shiftScope amount = lmap (_ - amount)
+
+-- | Renders a layout using the Render monad.
 render :: forall r. YLayout -> RenderM r Shape.Shape
-render = para algebra
+render = para algebra >>> map (map snd >>> Shape.fromFoldable)
   where
-  algebra :: GAlgebra (Tuple YLayout) YLayoutF (RenderM r Shape.Shape)
-  algebra (Lambda { args, heights } (Tuple _ body)) = do
-    bodyShape <- local (_ { slice = heights } <<< (shiftContext $ List.length args)) body
+  algebra :: GAlgebra (Tuple YLayout) YLayoutF (RenderM r RenderList)
+  algebra (Lambda { args, heights, position } (Tuple _ body)) = do
     let
-      bounds = ForeignShape.bounds bodyShape
-    pure
-      $ Shape.group {}
-          [ Shape.rect { fill: "black", stroke: "red" } $ withPadding 20 bounds
-          , bodyShape
-          ]
+      argCount = List.length args
+    bodyShapes <- inScope argCount <$> local (updateContext argCount) body
+    slices <- ask <#> _.slices
+    let
+      shapesInScope = snd <$> bodyShapes.yes
+
+      bounds :: Bounds
+      bounds = ForeignShape.bounds $ Shape.fromFoldable shapesInScope
+
+      result :: ScopedShape
+      result =
+        Tuple 0
+          $ Shape.group { translate: vec2 0 (getY 0 position slices) }
+          $ Array.cons (Shape.rect { fill: "black", stroke: "red" } bounds)
+              shapesInScope
+    pure $ NonEmptyArray.cons' result $ shiftScope argCount <$> bodyShapes.no
+    where
+    updateContext argCount = shiftContext argCount >>> \a -> a { slices = (replicate argCount heights) <> a.slices }
 
   algebra (Var { position, index }) = do
-    { end, start, slice, doNotRender } <- ask
-    if (Set.member index doNotRender) then
-      pure mempty
-    else do
-      pure
-        $ Shape.rect { fill: "yellow", stroke: "black" }
-            { x: 0
-            , y: getY position slice
-            , height: lineHeight
-            , width: max lineWidth start
-            }
+    { end, start, slices, doNotRender } <- ask
+    pure
+      $ NonEmptyArray.singleton
+          if (Set.member index doNotRender) then
+            Tuple 0 Shape.Null
+          else
+            Tuple index
+              $ Shape.rect
+                  { fill: "yellow"
+                  , stroke: "black"
+                  }
+                  { x: 0
+                  , y: getY index position slices
+                  , height: lineHeight
+                  , width: max lineWidth start
+                  }
 
   algebra (Call position mkFunc@(Tuple functionLayout _) mkArg@(Tuple argumentLayout _)) = do
     function <- renderFn 0 mkFunc
-    slice <- ask <#> _.slice
-    traceM ("Call position " <> show position)
+    slices <- ask <#> _.slices
     let
-      functionEnd = if isVar functionLayout then 0 else getRightBound function
-
-      functionPosition = getPosition functionLayout
+      -- TODO: maybe make the call to getRightBound only include stuff in scope or something
+      functionEnd = if isVar functionLayout then 0 else getRightBound $ Shape.fromFoldable $ snd <$> function
     argument <- renderFn functionEnd mkArg
     let
-      argumentEnd = getRightBound argument
-    pure
-      $ Shape.group {}
-          [ function
-          , argument
-          , Shape.rect
-              { fill: "green"
-              , stroke: "black"
-              }
-              { x: functionEnd
-              , width: argumentEnd - functionEnd
-              , height: lineHeight
-              , y: getY functionPosition slice
-              }
-          , Shape.rect
+      argumentEnd = getRightBound $ Shape.fromFoldable $ snd <$> argument
+
+      functionContinuation =
+        Shape.rect
+          { fill: "green"
+          , stroke: "black"
+          }
+          { x: functionEnd
+          , width: argumentEnd - functionEnd
+          , height: lineHeight
+          , y: getLayoutY functionLayout slices
+          }
+
+      functionShapes :: RenderList
+      functionShapes =
+        NonEmptyArray.cons
+          ( Tuple (fst $ NonEmptyArray.head function)
+              functionContinuation
+          )
+          function
+
+      resultShape =
+        Tuple 0
+          $ Shape.rect
               { fill: "blue"
               , stroke: "black"
               }
               { x: argumentEnd
               , width: lineWidth
               , height: lineHeight
-              , y: getY position slice
+              , y: getY 0 position slices
               }
-          ]
+    pure $ NonEmptyArray.cons resultShape $ functionShapes <> argument
     where
-    renderFn start (Tuple ast m) = local (_ { start = start, end = start + lineWidth }) m
+    renderFn start (Tuple ast m) =
+      local
+        ( _
+            { start = start
+            , end = start + lineWidth
+            }
+        )
+        m
+
+-- | Get the y position based on an index and a (relative) position.
+getY :: (Label "index" => Int) -> (Label "position" => Int) -> List.List YMapSlice -> Int
+getY index position slices = lineHeight * units
+  where
+  units =
+    foldrWithIndex
+      (\index' height result -> if position <= index' then result else result + height)
+      0
+      $ fromMaybe []
+      $ List.index slices index
 
-  getY :: Int -> YMapSlice -> Int
-  getY position slice =
-    lineHeight
-      * foldrWithIndex
-          (\index height result -> if position < index then result else result + height)
-          0
-          slice
+-- | Get the y position from a YLayout by inferring the correct scope. 
+getLayoutY :: YLayout -> List.List YMapSlice -> Int
+getLayoutY layout slices = case project layout of
+  Var { index, position } -> getY index position slices
+  Call position _ _ -> getY 0 position slices
+  Lambda { position } _ -> getY 0 position slices
 
--- | Run a computation in the Render monad
+-- | Run a computation in the render monad.
 runRenderM :: forall a. RenderM () a -> a
-runRenderM m = extract $ runReader { doNotRender: Set.empty, start: 0, end: 0, slice: mempty } m
+runRenderM m = extract $ runReader { doNotRender: Set.empty, start: 0, end: 0, slices: List.singleton mempty } m

packages/client/src/Renderer/WithHeight.purs

@@ -48,7 +48,7 @@ withHeights = cata algebra
   where
   algebra :: Algebra LayoutF (Tuple YLayout YMap)
   algebra = case _ of
-    Lambda { position, args } (Tuple body bodyMeasures) -> Tuple yLambda bodyMeasures
+    Lambda { position, args } (Tuple body bodyMeasures) -> Tuple yLambda measures
       where
       (Tuple slice remaining) = splitMap (List.length args) bodyMeasures