feat: pretty printing of expressions

spago.dhall

@@ -31,6 +31,7 @@ You can edit this file as you like.
   , "routing-duplex"
   , "sized-vectors"
   , "spec"
+  , "stringutils"
   , "tuples"
   , "typelevel"
   , "typelevel-prelude"

src/Component/Editor.purs

@@ -6,7 +6,6 @@ import Control.Monad.State (get, gets, modify_, put)
 import Control.MonadZero (guard)
 import Data.Array (foldr, (..))
 import Data.Default (def)
-import Data.Either (Either(..))
 import Data.Foldable (for_, sequence_)
 import Data.Lens (over, preview, set, view)
 import Data.List.Lazy as List
@@ -28,9 +27,10 @@ import Lunarbox.Component.Editor.Tree as TreeC
 import Lunarbox.Component.Icon (icon)
 import Lunarbox.Component.Utils (container)
 import Lunarbox.Config (Config)
-import Lunarbox.Control.Monad.Dataflow.Solve.SolveExpression (printTypeMap, solveExpression)
+import Lunarbox.Control.Monad.Dataflow.Solve.SolveExpression (printTypeMap)
 import Lunarbox.Control.Monad.Effect (print, printString)
 import Lunarbox.Data.Dataflow.Class.Expressible (nullExpr)
+import Lunarbox.Data.Dataflow.Expression (printSource)
 import Lunarbox.Data.Dataflow.Native.Prelude (loadPrelude)
 import Lunarbox.Data.Dataflow.Type (numberOfInputs)
 import Lunarbox.Data.Editor.ExtendedLocation (ExtendedLocation(..))
@@ -40,21 +40,19 @@ import Lunarbox.Data.Editor.Node.NodeData (NodeData(..), _NodeDataPosition, _Nod
 import Lunarbox.Data.Editor.Node.NodeDescriptor (onlyEditable)
 import Lunarbox.Data.Editor.Node.NodeId (NodeId(..))
 import Lunarbox.Data.Editor.Node.PinLocation (Pin(..))
-import Lunarbox.Data.Editor.Project (_projectNodeGroup, compileProject, createFunction, emptyProject)
-import Lunarbox.Data.Editor.State (State, Tab(..), _atColorMap, _atNode, _atNodeData, _currentFunction, _currentTab, _function, _functions, _isSelected, _lastMousePosition, _nextId, _nodeData, _panelIsOpen, _partialFrom, _partialTo, _project, _typeMap, tabIcon, tryConnecting)
+import Lunarbox.Data.Editor.Project (_projectNodeGroup, createFunction, emptyProject)
+import Lunarbox.Data.Editor.State (State, Tab(..), _atColorMap, _atCurrentNode, _atNode, _atNodeData, _currentFunction, _currentTab, _expression, _function, _functions, _isSelected, _lastMousePosition, _nextId, _nodeData, _panelIsOpen, _partialFrom, _partialTo, _project, _typeMap, compile, tabIcon, tryConnecting)
 import Lunarbox.Data.Graph as G
 import Lunarbox.Data.Vector (Vec2)
 import Lunarbox.Page.Editor.EmptyEditor (emptyEditor)
 import Lunarbox.Svg.Attributes (transparent)
-import Record as Record
 
 data Action
   = ChangeTab Tab
   | CreateFunction FunctionName
   | SelectFunction (Maybe FunctionName)
   | CreateNode FunctionName
   | StartFunctionCreation
-  | Compile
   | SceneMouseUp
   | SceneMouseDown (Vec2 Number)
   | SceneMouseMove (Vec2 Number)
@@ -106,23 +104,7 @@ component =
   handleAction :: Action -> HalogenM State Action ChildSlots Void m Unit
   handleAction = case _ of
     LoadNodes -> do
-      modify_ loadPrelude
-      handleAction Compile
-    Compile -> do
-      { project, expression } <- get
-      let
-        expression' = compileProject project
-      -- we only run the type inference algorithm if the expression changed
-      when (expression /= expression') do
-        let
-          typeMap = case solveExpression expression' of
-            Right map -> Map.delete Nowhere map
-            Left _ -> mempty
-        print $ expression
-        printString $ printTypeMap typeMap
-        -- printString $ printSource expression'
-        -- TODO: make it so this accounts for errors
-        modify_ $ Record.merge { expression: expression', typeMap }
+      modify_ $ compile <<< loadPrelude
     CreateNode name -> do
       print "here:)"
       Tuple id setId <- createId
@@ -158,8 +140,7 @@ component =
                 state''' = set (_atNodeData currentFunction id) (Just def) state''
 
                 state'''' = over _functions (G.insertEdge name currentFunction) state'''
-              void $ put $ setId state''''
-              handleAction Compile
+              void $ put $ compile $ setId state''''
     ChangeTab newTab -> do
       oldTab <- gets $ view _currentTab
       modify_
@@ -185,9 +166,8 @@ component =
             function <-
               G.lookup currentFunction functions
             pure do
-              handleAction Compile
               -- And finally, save the selected function in the state
-              modify_ $ set _currentFunction name
+              modify_ $ set _currentFunction name <<< compile
     SceneMouseDown position -> do
       modify_ $ set _lastMousePosition $ Just position
     SceneMouseMove position -> do
@@ -222,6 +202,12 @@ component =
       let
         setFrom = set _partialFrom $ Just id
       modify_ $ tryConnecting <<< setFrom
+      s <- gets $ view _typeMap
+      e <- gets $ view _expression
+      s' <- gets $ preview $ _atCurrentNode $ NodeId "firstOutput"
+      printString $ printTypeMap s
+      printString $ printSource e
+      print s'
 
   handleTreeOutput :: TreeC.Output -> Maybe Action
   handleTreeOutput = case _ of

src/Data/Dataflow/Expression.purs

@@ -24,6 +24,7 @@ import Data.Newtype (class Newtype, unwrap)
 import Data.Set (Set)
 import Lunarbox.Data.Dataflow.Runtime (RuntimeValue)
 import Lunarbox.Data.Dataflow.Scheme (Scheme)
+import Lunarbox.Data.String (indent)
 
 newtype VarName
   = VarName String
@@ -139,19 +140,39 @@ printExpressionAt location =
 sumarizeExpression :: forall l. Show l => Eq l => Expression l -> String
 sumarizeExpression = printRawExpression $ const "..."
 
+printRawLet :: forall l. (Expression l -> String) -> Expression l -> String
+printRawLet print (Let _ name value _) = indent 2 (unwrap name <> " = " <> print value) <> "\n"
+
+printRawLet _ _ = ""
+
+printLet :: forall l. Boolean -> (Expression l -> String) -> Expression l -> String
+printLet true print expression@(Let _ _ _ _) = "let\n" <> printLet false print expression
+
+printLet false print expression@(Let _ _ _ next@(Let _ _ _ _)) = printRawLet print expression <> printLet false print next
+
+printLet false print expression@(Let _ _ _ next) = printRawLet print expression <> "in\n" <> indent 2 (print next)
+
+printLet _ _ _ = ""
+
 -- Prints an expression without it's location. 
 -- Uses a custom function to print the recursive Expressions.
 -- Only used internally inside the show instance 
 -- to not reepat the location printing code every time
 printRawExpression :: forall l. Show l => (Expression l -> String) -> Expression l -> String
-printRawExpression print = case _ of
+printRawExpression print expression = case expression of
   Variable _ name -> unwrap name
   FunctionCall _ f i -> print f <> " " <> print i
   Lambda _ arg value -> "\\" <> show arg <> " -> " <> print value
   Literal _ literal -> show literal
-  Let _ name value body -> "let " <> unwrap name <> " = " <> print value <> " in " <> print body
-  If _ c t f -> "if " <> print c <> " then " <> print t <> " else " <> print f
+  Let _ _ _ _ -> printLet true (printRawExpression print) expression
   FixPoint _ e -> "fixpoint( " <> print e <> " )"
+  If _ cond then' else' ->
+    "if\n"
+      <> indent 2 (print cond)
+      <> "\nthen\n"
+      <> indent 2 (print then')
+      <> "\nelse\n"
+      <> indent 2 (print else')
   Native _ (NativeExpression t _) -> "native :: " <> show t
   Chain l (e : Nil) -> printRawExpression print e
   Chain l (e : es) -> "{" <> printRawExpression print e <> "," <> (printRawExpression print $ Chain l es) <> "}"

src/Data/Editor/Node.purs

@@ -11,9 +11,9 @@ module Lunarbox.Data.Editor.Node
   ) where
 
 import Prelude
-import Data.Lens (Iso', Lens', Prism', Traversal', is, iso, lens, prism', review, set, view)
+import Data.Lens (Lens', Prism', Traversal', is, lens, prism', set)
 import Data.Lens.Record (prop)
-import Data.List (List(..), (:), (!!), foldl, mapWithIndex)
+import Data.List (List(..), foldl, mapWithIndex, (!!))
 import Data.Maybe (Maybe(..), maybe)
 import Data.Symbol (SProxy(..))
 import Lunarbox.Data.Dataflow.Expression (Expression(..), VarName(..), wrap)
@@ -38,6 +38,11 @@ data Node
     ComplexNodeData
   | OutputNode (Maybe NodeId)
 
+instance showNode :: Show Node where
+  show InputNode = "InputNode"
+  show (OutputNode id) = "Output " <> maybe "???" show id
+  show (ComplexNode data') = show data'
+
 -- Check if a node has an output pin
 hasOutput :: Node -> Boolean
 hasOutput = not <<< is _OutputNode
@@ -46,7 +51,7 @@ hasOutput = not <<< is _OutputNode
 getInputs :: Node -> List (Maybe NodeId)
 getInputs = case _ of
   ComplexNode { inputs } -> inputs
-  OutputNode input -> Just <$> view _maybeToList input
+  OutputNode input -> pure input
   InputNode -> Nil
 
 functionCall :: forall l l'. ExtendedLocation l l' -> Expression (ExtendedLocation l l') -> List (Expression (ExtendedLocation l l')) -> Expression (ExtendedLocation l l')
@@ -96,12 +101,9 @@ _OutputNode =
     OutputNode v -> Just v
     _ -> Nothing
 
-_maybeToList :: forall a. Iso' (Maybe a) (List a)
-_maybeToList = iso (maybe Nil (_ : Nil)) (_ !! 0)
-
 _nodeInputs :: Lens' Node (List (Maybe NodeId))
 _nodeInputs =
   lens getInputs \node -> case node of
     InputNode -> const node
-    OutputNode inner -> OutputNode <<< join <<< review _maybeToList
+    OutputNode inner -> OutputNode <<< join <<< (_ !! 0)
     ComplexNode _ -> flip (set _ComplexNodeInputs) node

src/Data/Editor/State.purs

@@ -3,6 +3,7 @@ module Lunarbox.Data.Editor.State
   , Tab(..)
   , tabIcon
   , tryConnecting
+  , compile
   , _nodeData
   , _atNodeData
   , _project
@@ -31,18 +32,21 @@ module Lunarbox.Data.Editor.State
   ) where
 
 import Prelude
+import Data.Either (Either(..))
 import Data.Lens (Lens', Traversal', _Just, lens, over, preview, set, view)
 import Data.Lens.At (at)
 import Data.Lens.Index (ix)
 import Data.Lens.Record (prop)
 import Data.Map (Map)
+import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Symbol (SProxy(..))
 import Data.Tuple (Tuple(..))
-import Data.Typelevel.Undefined (undefined)
+import Lunarbox.Control.Monad.Dataflow.Solve.SolveExpression (solveExpression)
 import Lunarbox.Data.Dataflow.Expression (Expression)
 import Lunarbox.Data.Dataflow.Type (Type)
 import Lunarbox.Data.Editor.DataflowFunction (DataflowFunction)
+import Lunarbox.Data.Editor.ExtendedLocation (ExtendedLocation(..))
 import Lunarbox.Data.Editor.FunctionData (FunctionData)
 import Lunarbox.Data.Editor.FunctionName (FunctionName)
 import Lunarbox.Data.Editor.Location (Location)
@@ -51,7 +55,7 @@ import Lunarbox.Data.Editor.Node.NodeData (NodeData, _NodeDataSelected)
 import Lunarbox.Data.Editor.Node.NodeId (NodeId)
 import Lunarbox.Data.Editor.NodeGroup (NodeGroup, _NodeGroupNodes)
 import Lunarbox.Data.Editor.PartialConnection (PartialConnection, _from, _to)
-import Lunarbox.Data.Editor.Project (Project, _ProjectFunctions, _atProjectFunction, _atProjectNode, _projectNodeGroup)
+import Lunarbox.Data.Editor.Project (Project, _ProjectFunctions, _atProjectFunction, _atProjectNode, _projectNodeGroup, compileProject)
 import Lunarbox.Data.Graph as G
 import Lunarbox.Data.Lens (listToArrayIso)
 import Lunarbox.Data.Vector (Vec2)
@@ -179,6 +183,23 @@ _atCurrentNode :: NodeId -> Traversal' State (Maybe Node)
 _atCurrentNode id = _currentNodes <<< at id
 
 -- Helpers
+-- Compile a project
+compile :: State -> State
+compile state@{ project, expression, typeMap } =
+  let
+    expression' = compileProject project
+
+    typeMap' =
+      -- we only run the type inference algorithm if the expression changed
+      if (expression == expression') then
+        typeMap
+      else case solveExpression expression' of
+        Right map -> Map.delete Nowhere map
+        -- TODO: make it so this accounts for errors
+        Left _ -> mempty
+  in
+    state { expression = expression', typeMap = typeMap' }
+
 -- Tries connecting the pins the user selected
 tryConnecting :: State -> State
 tryConnecting state =
@@ -199,4 +220,6 @@ tryConnecting state =
           )
           (Just from)
           state
-    undefined
+
+      state''' = set _partialTo Nothing $ set _partialFrom Nothing state''
+    pure $ compile state'''

src/Data/String.purs

@@ -0,0 +1,11 @@
+module Lunarbox.Data.String (indent) where
+
+import Prelude
+import Data.String.Utils (lines, unsafeRepeat)
+import Data.String (joinWith)
+
+-- Indent a string by a number of spaces
+indent :: Int -> String -> String
+indent spaces = joinWith "\n" <<< map (space <> _) <<< lines
+  where
+  space = unsafeRepeat spaces " "