Skip to content

Commit

Permalink
Merge pull request finos#1085 from finos/pipe-visualisation
Browse files Browse the repository at this point in the history 
new visualisation for map, filter, filterMap
  • Loading branch information
@AttilaMihaly
AttilaMihaly authored Aug 2, 2023
2 parents 6b6699d + 6c811de commit 1f9ae9d
Show file tree
Hide file tree
Showing 3 changed files with 131 additions and 60 deletions.
172 changes: 119 additions & 53 deletions src/Morphir/Visual/ViewApply.elm
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,11 @@
module Morphir.Visual.ViewApply exposing (view)

import Dict exposing (Dict)
import Element exposing (Element, above, centerX, centerY, el, fill, moveUp, padding, row, spacing, text, width)
import Element exposing (Element, above, centerX, centerY, el, fill, htmlAttribute, moveUp, padding, row, spacing, text, width)
import Element.Background as Background
import Element.Border as Border
import Element.Font as Font
import Html.Attributes exposing (style)
import Morphir.IR.Distribution as Distribution
import Morphir.IR.FQName exposing (FQName)
import Morphir.IR.Name as Name
Expand All @@ -15,6 +16,7 @@ import Morphir.Type.Infer as Infer
import Morphir.Value.Error exposing (Error(..))
import Morphir.Value.Interpreter exposing (evaluateFunctionValue, evaluateValue)
import Morphir.Visual.Common exposing (nameToText, tooltip)
import Morphir.Visual.Components.DecisionTree as DecisionTree
import Morphir.Visual.Components.DrillDownPanel as DrillDownPanel exposing (Depth)
import Morphir.Visual.Components.FieldList as FieldList
import Morphir.Visual.Config exposing (Config, DrillDownFunctions(..), drillDownContains, evalIfPathTaken)
Expand All @@ -23,8 +25,8 @@ import Morphir.Visual.Theme as Theme exposing (borderRounded, smallPadding, smal
import Morphir.Visual.ViewList as ViewList


view : Config msg -> (Config msg -> Value.Definition () (Type ()) -> Element msg) -> (EnrichedValue -> Element msg) -> EnrichedValue -> List EnrichedValue -> Element msg
view config viewDefinitionBody viewValue functionValue argValues =
view : Config msg -> (Config msg -> Value.Definition () (Type ()) -> Element msg) -> (EnrichedValue -> Element msg) -> EnrichedValue -> List EnrichedValue -> EnrichedValue -> Element msg
view config viewDefinitionBody viewValue functionValue argValues applyValue =
let
styles : List (Element.Attribute msg)
styles =
Expand Down Expand Up @@ -52,7 +54,7 @@ view config viewDefinitionBody viewValue functionValue argValues =

viewFunctionValue : FQName -> Element msg
viewFunctionValue fqName =
el [ tooltip above (functionOutput fqName) ] <| viewValue functionValue
el [ tooltip above (functionOutput config fqName functionValue argValues viewValue) ] <| viewValue functionValue

viewArgumentList : List (Element msg)
viewArgumentList =
Expand All @@ -74,54 +76,6 @@ view config viewDefinitionBody viewValue functionValue argValues =
]
(viewValue v)
)

functionOutput : FQName -> Element msg
functionOutput fqName =
let
variables : List (Maybe RawValue)
variables =
case config.ir |> Distribution.lookupValueDefinition fqName of
Just valueDef ->
Dict.fromList (List.map2 (\( name, _, _ ) argValue -> ( name, argValue |> evalIfPathTaken config )) valueDef.inputTypes argValues) |> Dict.values

Nothing ->
[]

viewRawValue : RawValue -> Element msg
viewRawValue rawValue =
case fromRawValue config.ir rawValue of
Ok typedValue ->
el [ centerY ] (viewValue typedValue)

Err error ->
el [ centerX, centerY ] (text (Infer.typeErrorToMessage error))

popupstyles : List (Element.Attribute msg)
popupstyles =
[ Background.color config.state.theme.colors.lightest
, Font.bold
, Font.center
, config.state.theme |> borderRounded
, Border.width 1
, smallPadding config.state.theme |> padding
]
in
case evaluateFunctionValue config.nativeFunctions config.ir fqName variables of
Ok value ->
el popupstyles (viewRawValue value)

Err firstError ->
case firstError of
ReferenceNotFound _ ->
case evaluateValue config.nativeFunctions config.ir config.state.variables (List.map toRawValue argValues) (toRawValue functionValue) of
Ok value ->
el popupstyles (viewRawValue value)

Err err ->
Element.none

_ ->
Element.none
in
case ( functionValue, argValues ) of
( (Value.Constructor _ fQName) as constr, _ ) ->
Expand Down Expand Up @@ -162,6 +116,15 @@ view config viewDefinitionBody viewValue functionValue argValues =
, text ")"
]

( Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], _, [ "map" ] ), [ _, _ ] ) ->
pipeVisualisation config applyValue viewValue

( Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], _, [ "filter" ] ), [ _, _ ] ) ->
pipeVisualisation config applyValue viewValue

( Value.Reference _ ( [ [ "morphir" ], [ "s", "d", "k" ] ], _, [ "filter", "map" ] ), [ _, _ ] ) ->
pipeVisualisation config applyValue viewValue

-- possibly binary operator
( Value.Reference _ (( [ [ "morphir" ], [ "s", "d", "k" ] ], moduleName, localName ) as fqName), [ argValues1, argValues2 ] ) ->
let
Expand Down Expand Up @@ -289,7 +252,7 @@ view config viewDefinitionBody viewValue functionValue argValues =

_ ->
row ([ Border.color config.state.theme.colors.gray, Border.width 1, smallPadding config.state.theme |> padding, config.state.theme |> borderRounded ] ++ styles)
[ viewFunctionValue ( [], [], [] )
[ viewValue functionValue
, row [ width fill, centerX, smallSpacing config.state.theme |> spacing ]
viewArgumentList
]
Expand All @@ -311,3 +274,106 @@ inlineBinaryOperators =
, ( "Basics.notEqual", "≠" )
, ( "Basics.power", "^" )
]


functionOutput : Config msg -> FQName -> EnrichedValue -> List EnrichedValue -> (EnrichedValue -> Element msg) -> Element msg
functionOutput config fqName functionValue argValues viewValue =
let
variables : List (Maybe RawValue)
variables =
case config.ir |> Distribution.lookupValueDefinition fqName of
Just valueDef ->
Dict.fromList (List.map2 (\( name, _, _ ) argValue -> ( name, argValue |> evalIfPathTaken config )) valueDef.inputTypes argValues) |> Dict.values

Nothing ->
[]

viewRawValue : RawValue -> Element msg
viewRawValue rawValue =
case fromRawValue config.ir rawValue of
Ok typedValue ->
el [ centerY ] (viewValue typedValue)

Err error ->
el [ centerX, centerY ] (text (Infer.typeErrorToMessage error))

popupstyles : List (Element.Attribute msg)
popupstyles =
[ Background.color config.state.theme.colors.lightest
, Font.bold
, Font.center
, config.state.theme |> borderRounded
, Border.width 1
, smallPadding config.state.theme |> padding
]
in
case evaluateFunctionValue config.nativeFunctions config.ir fqName variables of
Ok value ->
el popupstyles (viewRawValue value)

Err firstError ->
case firstError of
ReferenceNotFound _ ->
case evaluateValue config.nativeFunctions config.ir config.state.variables (List.map toRawValue argValues) (toRawValue functionValue) of
Ok value ->
el popupstyles (viewRawValue value)

Err err ->
Element.none

_ ->
Element.none

pipeVisualisation : Config msg -> EnrichedValue -> (EnrichedValue -> Element msg) -> Element msg
pipeVisualisation config applyValue viewValue=
let
getMapsRec : EnrichedValue -> List (Element msg)
getMapsRec v =
let
recursiveCall : FQName -> EnrichedValue -> EnrichedValue -> EnrichedValue -> String -> List (Element msg)
recursiveCall currentFQName currentFunctionValue currentFunction src label =
getMapsRec src
++ [ el
[ Border.width 2
, Border.color config.state.theme.colors.brandSecondaryLight
, Theme.borderRounded config.state.theme
, Element.above <| el [ Font.color config.state.theme.colors.mediumGray, padding 4, Element.centerX, Element.centerY ] (text label)
]
<|
viewValue currentFunction
, arrow currentFQName currentFunctionValue [ currentFunction, src ]
]
in
case v of
Value.Apply _ applyFunction applyArgs ->
case Value.uncurryApply applyFunction applyArgs of
( (Value.Reference _ (( [ [ "morphir" ], [ "s", "d", "k" ] ], _, [ "map" ] ) as fqName)) as mapFunctionValue, [ mapfunc, source ] ) ->
recursiveCall fqName mapFunctionValue mapfunc source "map"

( (Value.Reference _ (( [ [ "morphir" ], [ "s", "d", "k" ] ], _, [ "filter" ] ) as fqName)) as mapFunctionValue, [ mapfunc, source ] ) ->
recursiveCall fqName mapFunctionValue mapfunc source "filter"

( (Value.Reference _ (( [ [ "morphir" ], [ "s", "d", "k" ] ], _, [ "filter", "map" ] ) as fqName)) as mapFunctionValue, [ mapfunc, source ] ) ->
recursiveCall fqName mapFunctionValue mapfunc source "filter & map"

_ ->
[ viewValue v ]

_ ->
[ viewValue v
, arrow ( [], [], [] ) v []
]

arrow : FQName -> EnrichedValue -> List EnrichedValue -> Element msg
arrow fqName mapFunctionValue args =
el
[ Element.centerX
, Element.centerY
, tooltip Element.below (functionOutput config fqName mapFunctionValue args viewValue)
, htmlAttribute (style "z-index" "10000")
, width (Element.shrink |> Element.minimum (config.state.theme.fontSize * 3) |> Element.maximum (config.state.theme.fontSize * 5))
]
<|
DecisionTree.rightArrow config False
in
row [ spacing <| Theme.smallSpacing config.state.theme ] <|( getMapsRec applyValue) ++ [el [Font.italic] <| text " output "]
6 changes: 4 additions & 2 deletions src/Morphir/Visual/ViewLambda.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,16 +9,18 @@ import Morphir.IR.Value as Value exposing (Pattern(..), Value)
import Morphir.Visual.Common exposing (nameToText)
import Morphir.Visual.Config exposing (Config, HighlightState(..))
import Morphir.Visual.EnrichedValue exposing (EnrichedValue)
import Morphir.Visual.Theme exposing (mediumPadding, smallPadding)
import Morphir.Visual.Theme exposing (mediumPadding, smallPadding, borderRounded)
import Morphir.Visual.ViewLiteral as ViewLiteral


view : Config msg -> (Config msg -> EnrichedValue -> Element msg) -> Pattern ( Int, Type () ) -> Value () ( Int, Type () ) -> Element msg
view config viewValue pattern val =
let
styles : List (Element.Attribute msg)
styles =
[ Background.color config.state.theme.colors.backgroundColor, smallPadding config.state.theme |> padding, Border.rounded 6 ]
[ Background.color config.state.theme.colors.backgroundColor, smallPadding config.state.theme |> padding, borderRounded config.state.theme ]

viewHelper : Pattern a -> List (Element msg)
viewHelper p =
case p of
Value.WildcardPattern _ ->
Expand Down
13 changes: 8 additions & 5 deletions src/Morphir/Visual/ViewValue.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,10 +19,11 @@ import Morphir.Type.Infer as Infer exposing (TypeError)
import Morphir.Visual.BoolOperatorTree as BoolOperatorTree exposing (BoolOperatorTree)
import Morphir.Visual.Common exposing (nameToText)
import Morphir.Visual.Components.AritmeticExpressions as ArithmeticOperatorTree exposing (ArithmeticOperatorTree)
import Morphir.Visual.Components.DecisionTree as DecisionTree
import Morphir.Visual.Components.DrillDownPanel as DrillDownPanel
import Morphir.Visual.Config as Config exposing (Config, DrillDownFunctions(..), drillDownContains)
import Morphir.Visual.EnrichedValue exposing (EnrichedValue, fromRawValue, fromTypedValue, getId)
import Morphir.Visual.Theme exposing (mediumPadding, mediumSpacing, smallPadding, smallSpacing)
import Morphir.Visual.Theme as Theme exposing (mediumPadding, mediumSpacing, smallPadding, smallSpacing)
import Morphir.Visual.ViewApply as ViewApply
import Morphir.Visual.ViewArithmetic as ViewArithmetic
import Morphir.Visual.ViewBoolOperatorTree as ViewBoolOperatorTree
Expand Down Expand Up @@ -258,12 +259,14 @@ viewValueByLanguageFeature config value =
_ ->
defaultFieldDisplay fieldName

Value.Apply _ fun arg ->
(Value.Apply _ fun arg) as applyValue ->
let
( function, args ) =
Value.uncurryApply fun arg
in
ViewApply.view config definitionBody (viewValue config) function args


ViewApply.view config definitionBody (viewValue config) function args applyValue

Value.LetDefinition _ _ _ _ ->
let
Expand Down Expand Up @@ -355,7 +358,7 @@ viewValueByLanguageFeature config value =
Element.column
[ Background.color (rgb 1 0.6 0.6)
, smallPadding config.state.theme |> padding
, Border.rounded 6
, Theme.borderRounded config.state.theme
]
[ Element.el
[ smallPadding config.state.theme |> padding
Expand All @@ -365,7 +368,7 @@ viewValueByLanguageFeature config value =
, Element.el
[ Background.color (rgb 1 1 1)
, smallPadding config.state.theme |> padding
, Border.rounded 6
, Theme.borderRounded config.state.theme
, width fill
]
(XRayView.viewValue (XRayView.viewType moduleNameToPathString) ((other |> Debug.log "unable to visualize: ") |> Value.mapValueAttributes identity (\( _, tpe ) -> tpe)))
Expand Down

0 comments on commit 1f9ae9d

Please sign in to comment.