diff --git a/package.json b/package.json index 1b878e0..5892172 100644 --- a/package.json +++ b/package.json @@ -3,7 +3,7 @@ "scripts": { "prepare:purescript": "rm -rf output/bundle.js && hygen bundle prepare", "build:purescript": "spago build", - "dev": "pnpm run prepare:purescript && parcel public/index.html --port 8080 & nodemon", + "dev": "pnpm run prepare:purescript && parcel public/index.html --port 8080", "prebuild": "rm -rf dist", "bundle:purescript": "cross-env NODE_ENV=production pnpm run prepare:purescript && spago bundle-app -t output/prod-bundle.js", "build": "tsc && pnpm run bundle:purescript && parcel build public/index.html", diff --git a/src/Component/Editor.purs b/src/Component/Editor.purs index 0795b51..6316550 100644 --- a/src/Component/Editor.purs +++ b/src/Component/Editor.purs @@ -115,6 +115,7 @@ component = 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 @@ -152,7 +153,9 @@ component = state'' = set (_atNode currentFunction id) (Just node) state' state''' = set (_atNodeData currentFunction id) (Just def) state'' - void $ put $ setId state''' + + state'''' = over _functions (G.insertEdge name currentFunction) state''' + void $ put $ setId state'''' handleAction Compile ChangeTab newTab -> do oldTab <- gets $ view _currentTab diff --git a/src/Control/Monad/Dataflow/Solve/SolveExpression.purs b/src/Control/Monad/Dataflow/Solve/SolveExpression.purs index 5d75d40..b5c7c18 100644 --- a/src/Control/Monad/Dataflow/Solve/SolveExpression.purs +++ b/src/Control/Monad/Dataflow/Solve/SolveExpression.purs @@ -9,6 +9,7 @@ import Data.Array as Array import Data.Either (Either) import Data.Map as Map import Data.Tuple (Tuple(..)) +import Lunarbox.Capability.Editor.Type (prettify) import Lunarbox.Control.Monad.Dataflow.Infer (InferEnv(..), InferOutput(..), runInfer) import Lunarbox.Control.Monad.Dataflow.Infer.InferExpression (infer) import Lunarbox.Control.Monad.Dataflow.Solve (SolveContext(..), runSolve) @@ -38,6 +39,6 @@ solveExpression expression = do -- helper to print a typemap printTypeMap :: forall l. Show l => Ord l => Map.Map l Type -> String printTypeMap = - foldr (\(Tuple location type') result -> result <> "\n" <> show location <> " = " <> show type') "" + foldr (\(Tuple location type') result -> result <> "\n" <> show location <> " = " <> show (prettify type')) "" <<< Array.sortBy (\(Tuple _ a) (Tuple _ b) -> compare (show a) $ show b) <<< Map.toUnfoldable diff --git a/src/Data/Dataflow/Graph.purs b/src/Data/Dataflow/Graph.purs index 55cf120..50b055b 100644 --- a/src/Data/Dataflow/Graph.purs +++ b/src/Data/Dataflow/Graph.purs @@ -5,37 +5,33 @@ module Lunarbox.Data.Dataflow.Graph import Prelude import Data.Lens (view) import Data.Lens.At (at) -import Data.List (catMaybes, foldr, reverse) +import Data.List (catMaybes, foldr) import Data.Maybe (Maybe) import Data.Tuple (Tuple(..)) import Lunarbox.Data.Dataflow.Class.Expressible (nullExpr) -import Lunarbox.Data.Dataflow.Expression (Expression, VarName(..)) -import Lunarbox.Data.Editor.ExtendedLocation (ExtendedLocation(..), letWithLocation) +import Lunarbox.Data.Dataflow.Expression (Expression(..), VarName(..), wrap) +import Lunarbox.Data.Editor.ExtendedLocation (ExtendedLocation(..)) import Lunarbox.Data.Graph (Graph, topologicalSort) -- Takes a key and a graph and uses that to produce an Expression compileGraphNode :: forall k v l. Ord k => (v -> Expression l) -> Graph k v -> k -> Maybe (Tuple k (Expression (ExtendedLocation k l))) -compileGraphNode toExpression graph key = Tuple key <$> map (DeepLocation key) <$> toExpression <$> view (at key) graph +compileGraphNode toExpression graph key = Tuple key <$> wrap (Location key) <$> map (DeepLocation key) <$> toExpression <$> view (at key) graph -- Takes a graph of something and compiles it into an Expression -compileGraph :: forall k v l. Ord k => Eq l => Show k => (v -> Expression l) -> Graph k v -> Expression (ExtendedLocation k l) -compileGraph toExpression graph = +compileGraph :: forall k v l. Ord k => Eq l => Show k => Show l => (v -> Expression l) -> Graph k v -> k -> Expression (ExtendedLocation k l) +compileGraph toExpression graph main = let sorted = - reverse - $ topologicalSort - graph + topologicalSort + graph emptyExpression = nullExpr Nowhere in foldr ( \(Tuple key value) body -> - if body == emptyExpression then - value - else - letWithLocation (Location key) (VarName $ show key) value body + Let Nowhere (VarName $ show key) value body ) - emptyExpression + (Variable Nowhere $ VarName $ show main) $ catMaybes $ compileGraphNode toExpression graph <$> sorted diff --git a/src/Data/Editor/ExtendedLocation.purs b/src/Data/Editor/ExtendedLocation.purs index d52a11d..306290d 100644 --- a/src/Data/Editor/ExtendedLocation.purs +++ b/src/Data/Editor/ExtendedLocation.purs @@ -11,10 +11,9 @@ module Lunarbox.Data.Editor.ExtendedLocation import Prelude import Data.Default (class Default, def) import Data.Lens (Prism', prism') -import Data.List ((:), List(..)) import Data.Maybe (Maybe(..)) import Lunarbox.Data.Dataflow.Class.Expressible (nullExpr) -import Lunarbox.Data.Dataflow.Expression (Expression(..), VarName) +import Lunarbox.Data.Dataflow.Expression (Expression(..), VarName, wrap) -- This represents a location which may or may not have an extra or a missing layer data ExtendedLocation l l' @@ -62,9 +61,8 @@ letWithLocation :: letWithLocation location name value body = Let Nowhere name - value - $ Chain Nowhere - $ (Variable location name : body : Nil) + (wrap location value) + body -- Normalize nested Locations normalize :: forall l l' l''. ExtendedLocation l (ExtendedLocation l' l'') -> ExtendedLocation l (ExtendedLocation l' l'') diff --git a/src/Data/Editor/Node.purs b/src/Data/Editor/Node.purs index 58be551..8975d72 100644 --- a/src/Data/Editor/Node.purs +++ b/src/Data/Editor/Node.purs @@ -9,7 +9,6 @@ module Lunarbox.Data.Editor.Node ) where import Prelude -import Data.Default (def) import Data.Lens (Prism', Traversal', is, prism') import Data.Lens.Record (prop) import Data.List (List, foldl, mapWithIndex) @@ -52,7 +51,7 @@ compileNode nodes id child = outputNode id case outputId of Just outputId' -> Variable (Location outputId') $ VarName $ show outputId' Nothing -> nothing - ComplexNode { inputs, function } -> Let def name value child + ComplexNode { inputs, function } -> Let Nowhere name value child where name = VarName $ show id diff --git a/src/Data/Editor/NodeGroup.purs b/src/Data/Editor/NodeGroup.purs index 79301b0..8ed09a0 100644 --- a/src/Data/Editor/NodeGroup.purs +++ b/src/Data/Editor/NodeGroup.purs @@ -40,7 +40,7 @@ compileNodeGroup group@(NodeGroup { nodes, output, inputs }) = let ordered = orderNodes group - bodyNodes = output : (ordered \\ inputs) + bodyNodes = output : (ordered \\ (output : inputs)) return = foldl diff --git a/src/Data/Editor/Project.purs b/src/Data/Editor/Project.purs index c8a22ed..6549bae 100644 --- a/src/Data/Editor/Project.purs +++ b/src/Data/Editor/Project.purs @@ -26,7 +26,6 @@ import Data.Unfoldable (class Unfoldable) import Lunarbox.Data.Dataflow.Expression (Expression) import Lunarbox.Data.Dataflow.Graph (compileGraph) import Lunarbox.Data.Editor.DataflowFunction (DataflowFunction(..), _VisualFunction, compileDataflowFunction) -import Lunarbox.Data.Editor.ExtendedLocation (normalize) import Lunarbox.Data.Editor.FunctionName (FunctionName(..)) import Lunarbox.Data.Editor.Location (Location) import Lunarbox.Data.Editor.Node (Node(..)) @@ -50,7 +49,7 @@ _ProjectMain :: Lens' Project FunctionName _ProjectMain = newtypeIso <<< prop (SProxy :: _ "main") compileProject :: Project -> Expression Location -compileProject = map normalize <<< compileGraph compileDataflowFunction <<< view _ProjectFunctions +compileProject (Project { functions, main }) = compileGraph compileDataflowFunction functions main createEmptyFunction :: NodeId -> DataflowFunction createEmptyFunction id = diff --git a/src/Data/Graph.purs b/src/Data/Graph.purs index e105b80..12abc92 100644 --- a/src/Data/Graph.purs +++ b/src/Data/Graph.purs @@ -8,12 +8,13 @@ module Lunarbox.Data.Graph , keys , vertices , toUnfoldable + , insertEdge , topologicalSort , _Graph ) where import Prelude -import Data.Bifunctor (lmap) +import Data.Bifunctor (lmap, rmap) import Data.Foldable (class Foldable, foldMap, foldlDefault, foldrDefault) import Data.Graph as CG import Data.Lens (Traversal', lens, traversed, wander) @@ -99,6 +100,10 @@ vertices = map fst <<< Map.values <<< unwrap toUnfoldable :: forall u k v. Unfoldable u => Ord k => Graph k v -> u (Tuple k v) toUnfoldable (Graph m) = Map.toUnfoldable $ fst <$> m +-- Insert an edge from the start key to the end key. +insertEdge :: forall k v. Ord k => k -> k -> Graph k v -> Graph k v +insertEdge from to (Graph g) = Graph $ Map.alter (map (rmap (Set.insert to))) from g + -- no idea how to implement this so I'm using an implementation from another lib topologicalSort :: forall k v. Ord k => Graph k v -> List k topologicalSort = CG.topologicalSort <<< CG.fromMap <<< unwrap