From 6dbc8d6ea94b7cd629fc488548bcef53542cb90d Mon Sep 17 00:00:00 2001 From: DieMyst Date: Tue, 1 Dec 2020 14:51:12 +0300 Subject: [PATCH] update main model schema --- elm.json | 1 + src/Instances/View.elm | 13 +++----- src/Main.elm | 2 ++ src/Model.elm | 6 ++-- src/Modules/View.elm | 29 ++++++++++-------- src/ServicePage/View.elm | 13 +++----- src/Services/View.elm | 11 +++---- src/Update.elm | 66 +++++++++------------------------------- 8 files changed, 50 insertions(+), 91 deletions(-) diff --git a/elm.json b/elm.json index a9e956c..a8e15bc 100644 --- a/elm.json +++ b/elm.json @@ -22,6 +22,7 @@ "elm-community/graph": "6.0.0", "elm-community/intdict": "3.0.0", "elm-community/list-extra": "8.2.4", + "elm-community/maybe-extra": "5.2.0", "ivadzy/bbase64": "1.1.1", "lukewestby/elm-string-interpolate": "1.0.4", "mpizenberg/elm-pointer-events": "4.0.2", diff --git a/src/Instances/View.elm b/src/Instances/View.elm index 09e6e67..bd5766c 100644 --- a/src/Instances/View.elm +++ b/src/Instances/View.elm @@ -1,5 +1,6 @@ module Instances.View exposing (..) +import Blueprints.Model exposing (Blueprint) import Dict exposing (Dict) import Html exposing (Html, a, div, table, tbody, td, text, th, thead, tr) import Html.Attributes exposing (attribute) @@ -10,11 +11,11 @@ import Palette exposing (classes) import Services.Model exposing (Service) -toInstance : String -> Identify -> Dict String String -> Service -> Instance +toInstance : String -> Identify -> Dict String Blueprint -> Service -> Instance toInstance peerId identify blueprints service = let name = - blueprints |> Dict.get service.blueprint_id |> Maybe.withDefault "unknown" + blueprints |> Dict.get service.blueprint_id |> Maybe.map .name |> Maybe.withDefault "unknown" ip = List.head identify.external_addresses |> Maybe.map (String.split "/") |> Maybe.map (List.drop 2) |> Maybe.andThen List.head |> Maybe.withDefault "unknown" @@ -25,18 +26,12 @@ toInstance peerId identify blueprints service = view : Model -> Html msg view model = let - bps = - Dict.values model.discoveredPeers |> List.map (\data -> data.blueprints |> List.map (\b -> ( b.id, b.name ))) - - bpsDict = - List.concat bps |> Dict.fromList - instances = Dict.toList model.discoveredPeers |> List.map (\( peer, data ) -> data.services - |> List.map (toInstance peer data.identify bpsDict) + |> List.map (toInstance peer data.identify model.blueprints) ) |> List.concat in diff --git a/src/Main.elm b/src/Main.elm index 7494d4b..b0f0063 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -55,6 +55,8 @@ init flags url key = , key = key , page = r , discoveredPeers = Dict.empty + , modules = Dict.empty + , blueprints = Dict.empty } in ( emptyModel, Route.routeCommand emptyModel r ) diff --git a/src/Model.elm b/src/Model.elm index c45019d..60c1813 100644 --- a/src/Model.elm +++ b/src/Model.elm @@ -35,8 +35,8 @@ type Route type alias PeerData = { identify : Identify , services : List Service - , modules : List Module - , blueprints : List Blueprint + , modules : List String + , blueprints : List String } @@ -52,4 +52,6 @@ type alias Model = , url : Url.Url , page : Route , discoveredPeers : Dict String PeerData + , modules : Dict String Module + , blueprints : Dict String Blueprint } diff --git a/src/Modules/View.elm b/src/Modules/View.elm index 60d50cd..bf2ebea 100644 --- a/src/Modules/View.elm +++ b/src/Modules/View.elm @@ -3,6 +3,7 @@ module Modules.View exposing (..) import Dict exposing (Dict) import Html exposing (Html, div, p, span, text) import Html.Attributes exposing (attribute) +import Maybe.Extra import Model exposing (Model, PeerData) import Modules.Model exposing (Module, ModuleShortInfo) import Palette exposing (classes) @@ -11,20 +12,20 @@ import Utils.Utils exposing (instancesText) getModuleShortInfo : Model -> List ModuleShortInfo getModuleShortInfo model = - getAllModules model.discoveredPeers |> Dict.toList |> List.map (\( moduleName, ( moduleInfo, peers ) ) -> { moduleInfo = moduleInfo, instanceNumber = List.length peers }) + getAllModules model.modules model.discoveredPeers |> Dict.toList |> List.map (\( moduleName, ( moduleInfo, peers ) ) -> { moduleInfo = moduleInfo, instanceNumber = List.length peers }) -getAllModules : Dict String PeerData -> Dict String ( Module, List String ) -getAllModules peerData = +getAllModules : Dict String Module -> Dict String PeerData -> Dict String ( Module, List String ) +getAllModules modules peerData = let peerDatas = Dict.toList peerData - allModules = + allModulesByPeers = peerDatas |> List.map (\( peer, pd ) -> pd.modules |> List.map (\ms -> ( peer, ms ))) |> List.concat peersByModuleName = - allModules |> List.foldr updateDict Dict.empty + allModulesByPeers |> List.foldr (updateDict modules) Dict.empty in peersByModuleName @@ -33,23 +34,25 @@ getAllModules peerData = -- group by module name and append peers -updateDict : ( String, Module ) -> Dict String ( Module, List String ) -> Dict String ( Module, List String ) -updateDict ( peer, moduleInfo ) dict = +updateDict : Dict String Module -> ( String, String ) -> Dict String ( Module, List String ) -> Dict String ( Module, List String ) +updateDict modules ( peer, moduleName ) dict = dict - |> Dict.update moduleInfo.name + |> Dict.update moduleName (\oldM -> - oldM - |> Maybe.map (\( info, peers ) -> ( info, List.append [ peer ] peers )) - |> Maybe.withDefault ( moduleInfo, [ peer ] ) - |> Just + Maybe.Extra.or + (oldM |> Maybe.map (\( info, peers ) -> ( info, List.append [ peer ] peers ))) + (Dict.get moduleName modules |> Maybe.map (\m -> ( m, [ peer ] ))) ) view : Model -> Html msg view modules = let + info = + getModuleShortInfo modules + modulesView = - List.map viewService (getModuleShortInfo modules) + List.map viewService info in div [ classes "cf ph2-ns" ] modulesView diff --git a/src/ServicePage/View.elm b/src/ServicePage/View.elm index 84b6ac8..14c640d 100644 --- a/src/ServicePage/View.elm +++ b/src/ServicePage/View.elm @@ -39,14 +39,11 @@ modelToServiceInfo model id = services = datas |> List.map (\( peer, data ) -> data.services |> List.map (\s -> ( peer, s ))) |> List.concat - blueprints = - datas |> List.map (\( _, data ) -> data.blueprints) |> List.concat |> List.map (\bp -> ( bp.id, bp.name )) |> Dict.fromList - service = services |> List.Extra.find (\( _, s ) -> s.service_id == id) name = - service |> Maybe.andThen (\( _, s ) -> blueprints |> Dict.get s.blueprint_id) |> Maybe.withDefault "unknown" + service |> Maybe.andThen (\( _, s ) -> model.blueprints |> Dict.get s.blueprint_id |> Maybe.map .name) |> Maybe.withDefault "unknown" info = service @@ -66,14 +63,14 @@ modelToServiceInfo model id = viewInfo : ServiceInfo -> Html msg -viewInfo moduleInfo = +viewInfo serviceInfo = article [ classes "cf" ] [ div [ classes "fl w-30 gray mv1" ] [ text "AUTHOR" ] - , div [ classes "fl w-70 mv1" ] [ span [ classes "fl w-100 black b" ] [ text moduleInfo.author ], span [ classes "fl w-100 black" ] [ text moduleInfo.authorPeerId ] ] + , div [ classes "fl w-70 mv1" ] [ span [ classes "fl w-100 black b" ] [ text serviceInfo.author ], span [ classes "fl w-100 black" ] [ text serviceInfo.authorPeerId ] ] , div [ classes "fl w-30 gray mv1" ] [ text "DESCRIPTION" ] - , div [ classes "fl w-70 mv1" ] [ span [ classes "fl w-100 black" ] [ text moduleInfo.description ] ] + , div [ classes "fl w-70 mv1" ] [ span [ classes "fl w-100 black" ] [ text serviceInfo.description ] ] , div [ classes "fl w-30 gray mv1" ] [ text "INTERFACE" ] - , div [ classes "fl w-70 mv1" ] [ span [ classes "fl w-100 black" ] (recordsView moduleInfo.service.interface.record_types ++ signaturesView moduleInfo.service.interface.function_signatures) ] + , div [ classes "fl w-70 mv1" ] [ span [ classes "fl w-100 black" ] (recordsView serviceInfo.service.interface.record_types ++ signaturesView serviceInfo.service.interface.function_signatures) ] ] diff --git a/src/Services/View.elm b/src/Services/View.elm index 68aeded..d7de36a 100644 --- a/src/Services/View.elm +++ b/src/Services/View.elm @@ -14,7 +14,7 @@ view : Model -> Html msg view model = let allBps = - getBlueprintsToServices model.discoveredPeers + getBlueprintsToServices model.blueprints model.discoveredPeers info = Dict.values allBps |> List.map (\( bp, servicesByPeers ) -> { name = bp.name, author = "Fluence Labs", instanceNumber = List.length (servicesByPeers |> List.map (\( _, s ) -> s) |> List.concat) }) @@ -40,14 +40,11 @@ viewService service = -- bpId peerId -getBlueprintsToServices : Dict String PeerData -> Dict String ( Blueprint, List ( String, List Service ) ) -getBlueprintsToServices peerData = +getBlueprintsToServices : Dict String Blueprint -> Dict String PeerData -> Dict String ( Blueprint, List ( String, List Service ) ) +getBlueprintsToServices blueprints peerData = let - peerDatas = - Dict.toList peerData - allBlueprints = - peerDatas |> List.map (\( _, pd ) -> pd.blueprints |> List.map (\bp -> bp)) |> List.concat + Dict.values blueprints bpsToServices = allBlueprints |> List.map (\bp -> ( bp.id, ( bp, getServicesByBlueprintId peerData bp.id ) )) |> Dict.fromList diff --git a/src/Update.elm b/src/Update.elm index 7c24e8f..fa72beb 100644 --- a/src/Update.elm +++ b/src/Update.elm @@ -89,22 +89,6 @@ update msg model = in ( updatedModel, Cmd.none ) - "modules_discovered" -> - let - newModules = - Maybe.withDefault [] modules - - empty = - emptyPeerData - - up = - \old -> Just (Maybe.withDefault { empty | modules = newModules } (Maybe.map (\o -> { o | modules = newModules }) old)) - - updatedDict = - Dict.update peer up model.discoveredPeers - in - ( { model | discoveredPeers = updatedDict }, Cmd.none ) - _ -> let _ = @@ -132,44 +116,22 @@ updateModel model peer identify services modules blueprints = data = Maybe.withDefault emptyPeerData (Dict.get peer model.discoveredPeers) + moduleDict = + modules |> List.map (\m -> ( m.name, m )) |> Dict.fromList + + blueprintDict = + blueprints |> List.map (\b -> ( b.name, b )) |> Dict.fromList + + updatedModules = + Dict.union moduleDict model.modules + + updatedBlueprints = + Dict.union blueprintDict model.blueprints + newData = - { data | identify = identify, services = services, modules = modules, blueprints = blueprints } + { data | identify = identify, services = services, modules = Dict.keys moduleDict, blueprints = Dict.keys blueprintDict } updated = Dict.insert peer newData model.discoveredPeers in - { model | discoveredPeers = updated } - - -peersByModule : Dict String PeerData -> String -> List String -peersByModule peerData moduleId = - let - list = - Dict.toList peerData - - found = - list |> List.filter (\( _, pd ) -> existsByModule moduleId pd.modules) |> List.map (\( peer, _ ) -> peer) - in - found - - -existsByModule : String -> List Module -> Bool -existsByModule moduleId modules = - modules |> List.any (\m -> m.name == moduleId) - - -peersByBlueprintId : Dict String PeerData -> String -> List String -peersByBlueprintId peerData blueprintId = - let - list = - Dict.toList peerData - - found = - list |> List.filter (\( _, pd ) -> existsByBlueprintId blueprintId pd.blueprints) |> List.map (\( peer, _ ) -> peer) - in - found - - -existsByBlueprintId : String -> List Blueprint -> Bool -existsByBlueprintId id bps = - bps |> List.any (\b -> b.id == id) + { model | discoveredPeers = updated, modules = updatedModules, blueprints = updatedBlueprints }