Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix the visualization in Try Morphir #1212

Merged
merged 4 commits into from
Dec 23, 2024
+111 −115
Merged

Fix the visualization in Try Morphir #1212

Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
ce3dcd3
Working editors, better styling.
AttilaMihaly Jun 4, 2024
53371fc
Minor improvements.
AttilaMihaly Jun 5, 2024
0ae6042
Merge branch 'refs/heads/main' into improve-try-morphir
AttilaMihaly Dec 17, 2024
73e0437
Revert sample code.
AttilaMihaly Dec 17, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
226 changes: 111 additions & 115 deletions cli/src/Morphir/Web/TryMorphir.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,15 +7,18 @@ import Element.Background as Background
import Element.Border as Border
import Element.Font as Font
import Element.Input as Input
import FontAwesome.Styles as Icon
import Html exposing (Html)
import Morphir.Compiler as Compiler
import Morphir.Elm.Frontend as Frontend exposing (SourceFile)
import Morphir.IR.Distribution exposing (Distribution(..))
import Morphir.IR.FQName exposing (FQName)
import Morphir.IR.Module as Module exposing (ModuleName)
import Morphir.IR.Name exposing (Name)
import Morphir.IR.Package as Package exposing (PackageName)
import Morphir.IR.SDK as SDK
import Morphir.IR.Type as Type exposing (Type)
import Morphir.IR.Value as Value
import Morphir.IR.Value as Value exposing (Value)
import Morphir.Type.Count as Count
import Morphir.Type.Infer as Infer
import Morphir.Type.Solve as Solve exposing (SolutionMap)
Expand All @@ -41,15 +44,21 @@ type alias Flags =


main =
Browser.element { init = init, update = update, view = view, subscriptions = subscriptions }
Browser.document
{ init = init
, update = update
, view = view
, subscriptions = subscriptions
}



-- MODEL


type alias Model =
{ source : String
{ theme : Theme
, source : String
, maybePackageDef : Maybe (Package.Definition () (Type ()))
, errors : List Compiler.Error
, irView : IRView
Expand All @@ -58,7 +67,7 @@ type alias Model =


type IRView
= InsightView
= InsightView InsightArgumentState Morphir.Visual.Config.VisualState
| IRView


Expand All @@ -67,20 +76,36 @@ type alias ValueState =
}


theme : Theme
theme =
initialTheme : Theme
initialTheme =
Theme.fromConfig Nothing


init : Flags -> ( Model, Cmd Msg )
init _ =
update (ChangeSource sampleSource) { source = "", maybePackageDef = Nothing, errors = [], irView = InsightView, valueStates = Dict.empty }


moduleSource : String -> SourceFile
moduleSource sourceValue =
{ path = "Test.elm"
, content = sourceValue
update (ChangeSource sampleSource)
{ theme = Theme.fromConfig Nothing
, source = ""
, maybePackageDef = Nothing
, errors = []
, irView = InsightView Dict.empty emptyVisualState
, valueStates = Dict.empty
}


emptyVisualState : Morphir.Visual.Config.VisualState
emptyVisualState =
{ theme = Theme.fromConfig Nothing
, variables = Dict.empty
, nonEvaluatedVariables = Dict.empty
, highlightState = Nothing
, popupVariables =
{ variableIndex = 0
, variableValue = Nothing
, nodePath = []
}
, drillDownFunctions = DrillDownFunctions Dict.empty
, zIndex = 9999
}


Expand All @@ -92,9 +117,14 @@ type Msg
= ChangeSource String
| ChangeIRView IRView
| UpdateInferStep FQName Int
| ArgValueUpdated Name ValueEditor.EditorState
| DoNothing


type alias InsightArgumentState =
Dict Name ValueEditor.EditorState


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Expand Down Expand Up @@ -150,6 +180,34 @@ update msg model =
, Cmd.none
)

ArgValueUpdated argName editorState ->
case model.irView of
InsightView argStates insightViewState ->
let
variables : InsightArgumentState -> Dict Name (Value () ())
variables argState =
argState
|> Dict.map (\_ arg -> arg.lastValidValue |> Maybe.withDefault (Value.Unit ()))

newArgState : InsightArgumentState
newArgState =
argStates |> Dict.insert argName editorState

newInsightViewState : Morphir.Visual.Config.VisualState
newInsightViewState =
{ insightViewState
| variables = variables newArgState
}
in
( { model
| irView = InsightView newArgState newInsightViewState
}
, Cmd.none
)

_ ->
( model, Cmd.none )

DoNothing ->
( model, Cmd.none )

Expand All @@ -175,26 +233,31 @@ update msg model =
-- VIEW


view : Model -> Html Msg
view : Model -> Browser.Document Msg
view model =
layout
[ width fill
, height fill
, Font.family
[ Font.external
{ name = "Source Code Pro"
, url = "https://fonts.googleapis.com/css2?family=Source+Code+Pro&display=swap"
}
, Font.monospace
]
, Font.size 16
]
(el
{ title = "Morphir - Home"
, body =
[ Icon.css
, layout
[ width fill
, height fill
, Font.family
[ Font.external
{ name = "Source Code Pro"
, url = "https://fonts.googleapis.com/css2?family=Source+Code+Pro&display=swap"
}
, Font.monospace
]
, Font.size model.theme.fontSize
]
(viewPackageResult model ChangeSource)
)
(el
[ width fill
, height fill
]
(viewPackageResult model ChangeSource)
)
]
}


viewPackageResult : Model -> (String -> Msg) -> Element Msg
Expand Down Expand Up @@ -301,7 +364,7 @@ viewModuleDefinition model ir packageName moduleName _ moduleDef =
|> Dict.toList
|> List.map
(\( typeName, accessControlledDocumentedTypeDef ) ->
ViewType.viewType theme typeName accessControlledDocumentedTypeDef.value.value accessControlledDocumentedTypeDef.value.doc
ViewType.viewType initialTheme typeName accessControlledDocumentedTypeDef.value.value accessControlledDocumentedTypeDef.value.doc
)

valueViews : List (Element Msg)
Expand All @@ -318,7 +381,7 @@ viewModuleDefinition model ir packageName moduleName _ moduleDef =
{ typeInferenceStep = 0
}
in
Card.viewAsCard theme
Card.viewAsCard initialTheme
(text (nameToText valueName))
"value"
valueDef.value.doc
Expand All @@ -341,71 +404,32 @@ viewModuleDefinition model ir packageName moduleName _ moduleDef =
]
]
)
, if List.isEmpty valueDef.value.value.inputTypes then
none

else
el
[ padding 5
, Border.rounded 5
, Background.color (rgb 0.95 0.95 0.95)
, width fill
]
(valueDef.value.value.inputTypes
|> List.map
(\( argName, _, argType ) ->
row []
[ el [ paddingXY 10 5 ] (text (nameToText argName))
, row
[ paddingXY 10 5
, spacing 5
, Background.color (rgb 1 0.9 0.8)
]
[ text ":"
, XRayView.viewType pathToUrl argType
]
]
)
|> column [ spacing 5 ]
)
, el
[ padding 5
, Border.rounded 5
, Background.color (rgb 1 1 1)
, width fill
]
(viewValue valueState ir ( packageName, moduleName, valueName ) model.irView valueDef.value.value)
(viewValue model.theme valueState ir ( packageName, moduleName, valueName ) model.irView valueDef.value.value)
]
)
)
in
(typeViews ++ valueViews)
|> List.intersperse (el [ width fill, height (px (Theme.smallSpacing theme)), Background.color theme.colors.gray ] none)
valueViews
|> List.intersperse (el [ width fill, height (px (Theme.smallSpacing initialTheme)), Background.color initialTheme.colors.gray ] none)
|> column [ spacing 20 ]


viewValue : ValueState -> Distribution -> FQName -> IRView -> Value.Definition () (Type ()) -> Element Msg
viewValue valueState ir fullyQualifiedName irView valueDef =
viewValue : Theme -> ValueState -> Distribution -> FQName -> IRView -> Value.Definition () (Type ()) -> Element Msg
viewValue theme valueState ir fullyQualifiedName irView valueDef =
case irView of
InsightView ->
InsightView argStates insightVisualState ->
let
config : Config Msg
config =
{ ir = ir
, nativeFunctions = Dict.empty
, state =
{ drillDownFunctions = DrillDownFunctions Dict.empty
, variables = Dict.empty
, nonEvaluatedVariables = Dict.empty
, popupVariables =
{ variableIndex = -1
, variableValue = Nothing
, nodePath = []
}
, theme = Theme.fromConfig Nothing
, highlightState = Nothing
, zIndex = 9999
}
, nativeFunctions = SDK.nativeFunctions
, state = insightVisualState
, handlers =
{ onReferenceClicked = \_ _ _ -> DoNothing
, onReferenceClose = \_ _ _ -> DoNothing
Expand All @@ -423,30 +447,30 @@ viewValue valueState ir fullyQualifiedName irView valueDef =
, ValueEditor.view theme
ir
argType
(always DoNothing)
(ValueEditor.initEditorState ir argType Nothing)
(ArgValueUpdated argName)
(argStates |> Dict.get argName |> Maybe.withDefault (ValueEditor.initEditorState ir argType Nothing))
)
)
|> FieldList.view theme
in
column []
column [ spacing (theme |> Theme.mediumSpacing) ]
[ editors
, ViewValue.viewDefinition config fullyQualifiedName valueDef
]

IRView ->
viewValueAsIR valueState ir fullyQualifiedName irView valueDef
viewValueAsIR valueState ir fullyQualifiedName valueDef


viewValueAsIR : ValueState -> Distribution -> FQName -> IRView -> Value.Definition () (Type ()) -> Element Msg
viewValueAsIR valueState ir fullyQualifiedName irView valueDef =
viewValueAsIR : ValueState -> Distribution -> FQName -> Value.Definition () (Type ()) -> Element Msg
viewValueAsIR valueState ir fullyQualifiedName valueDef =
let
untypedValueDef : Value.Definition () ()
untypedValueDef =
valueDef
|> Value.mapDefinitionAttributes identity (always ())

( index, ( defVar, annotatedValueDef, ( valueDefConstraints, typeVariablesByIndex ) ) ) =
( _, ( defVar, annotatedValueDef, ( valueDefConstraints, typeVariablesByIndex ) ) ) =
Infer.constrainDefinition ir Dict.empty untypedValueDef
|> Count.apply 0

Expand Down Expand Up @@ -518,34 +542,6 @@ viewValueAsIR valueState ir fullyQualifiedName irView valueDef =
]


viewFields : List ( Element msg, Element msg ) -> Element msg
viewFields fields =
fields
|> List.map
(\( key, value ) ->
column []
[ key
, el [ paddingXY 10 5 ] value
]
)
|> column []


viewDict : (comparable -> Element msg) -> (v -> Element msg) -> Dict comparable v -> Element msg
viewDict viewKey viewVal dict =
dict
|> Dict.toList
|> List.map
(\( key, value ) ->
column []
[ viewKey key
, el [ paddingXY 10 5 ]
(viewVal value)
]
)
|> column []


viewIRViewTabs : IRView -> Element Msg
viewIRViewTabs irView =
let
Expand All @@ -570,7 +566,7 @@ viewIRViewTabs irView =
, paddingXY 10 0
, spacing 10
]
[ button InsightView "Insight"
[ button (InsightView Dict.empty emptyVisualState) "Insight"
, button IRView "IR"
]

Expand Down Expand Up @@ -612,4 +608,4 @@ request allowPartial availableSurfboards requestedSurfboards =
type Response
= Rejected
| Reserved Int
"""
"""
Loading