update main model schema

This commit is contained in:
DieMyst 2020-12-01 14:51:12 +03:00
parent 9102ed6282
commit 6dbc8d6ea9
8 changed files with 50 additions and 91 deletions

View File

@ -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",

View File

@ -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

View File

@ -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 )

View File

@ -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
}

View File

@ -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

View File

@ -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) ]
]

View File

@ -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

View File

@ -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 }