number of instances in module list

This commit is contained in:
DieMyst 2020-12-09 10:50:28 +03:00
parent aca851004a
commit 78e0cf69c3
2 changed files with 33 additions and 11 deletions

View File

@ -1,5 +1,6 @@
module Modules.View exposing (..) module Modules.View exposing (..)
import Blueprints.Model exposing (Blueprint)
import Dict exposing (Dict) import Dict exposing (Dict)
import Html exposing (Html, a, div, p, text) import Html exposing (Html, a, div, p, text)
import Html.Attributes exposing (attribute) import Html.Attributes exposing (attribute)
@ -7,27 +8,28 @@ import Maybe.Extra
import Model exposing (Model, PeerData) import Model exposing (Model, PeerData)
import Modules.Model exposing (Module, ModuleShortInfo) import Modules.Model exposing (Module, ModuleShortInfo)
import Palette exposing (classes) import Palette exposing (classes)
import Service.Model exposing (Service)
import Utils.Utils exposing (instancesText) import Utils.Utils exposing (instancesText)
getModuleShortInfo : Model -> List ModuleShortInfo getModuleShortInfo : Model -> List ModuleShortInfo
getModuleShortInfo model = getModuleShortInfo model =
getAllModules model.modules model.discoveredPeers getAllModules model.blueprints model.modules model.discoveredPeers
|> Dict.toList |> Dict.toList
|> List.map (\( _, ( moduleInfo, peers ) ) -> { moduleInfo = moduleInfo, instanceNumber = List.length peers }) |> List.map (\( _, ( moduleInfo, services ) ) -> { moduleInfo = moduleInfo, instanceNumber = List.length services })
getAllModules : Dict String Module -> Dict String PeerData -> Dict String ( Module, List String ) getAllModules : Dict String Blueprint -> Dict String Module -> Dict String PeerData -> Dict String ( Module, List Service )
getAllModules modules peerData = getAllModules blueprints modules peerData =
let let
peerDatas = peerDatas =
Dict.toList peerData Dict.toList peerData
allModulesByPeers = allModulesByPeers =
peerDatas |> List.map (\( peer, pd ) -> pd.modules |> List.map (\ms -> ( peer, ms ))) |> List.concat peerDatas |> List.map (\( _, pd ) -> pd.modules |> List.map (\ms -> ( pd, ms ))) |> List.concat
peersByModuleName = peersByModuleName =
allModulesByPeers |> List.foldr (updateDict modules) Dict.empty allModulesByPeers |> List.foldr (updateDict blueprints modules) Dict.empty
in in
peersByModuleName peersByModuleName
@ -36,17 +38,33 @@ getAllModules modules peerData =
-- group by module name and append peers -- group by module name and append peers
updateDict : Dict String Module -> ( String, String ) -> Dict String ( Module, List String ) -> Dict String ( Module, List String ) updateDict : Dict String Blueprint -> Dict String Module -> ( PeerData, String ) -> Dict String ( Module, List Service ) -> Dict String ( Module, List Service )
updateDict modules ( peer, moduleName ) dict = updateDict blueprints modules ( peerData, moduleName ) dict =
let
filter =
\name -> \list -> list |> List.filter (filterByModuleName blueprints name)
in
dict dict
|> Dict.update moduleName |> Dict.update moduleName
(\oldM -> (\oldM ->
Maybe.Extra.or Maybe.Extra.or
(oldM |> Maybe.map (\( info, peers ) -> ( info, List.append [ peer ] peers ))) (oldM |> Maybe.map (\( info, services ) -> ( info, List.append (filter info.name peerData.services) services )))
(Dict.get moduleName modules |> Maybe.map (\m -> ( m, [ peer ] ))) (Dict.get moduleName modules |> Maybe.map (\m -> ( m, filter m.name peerData.services )))
) )
filterByModuleName : Dict String Blueprint -> String -> (Service -> Bool)
filterByModuleName bps moduleName =
let
check =
Maybe.map (\bp -> bp.dependencies |> List.member moduleName)
filter =
\s -> bps |> Dict.get s.blueprint_id |> check |> Maybe.withDefault False
in
filter
view : Model -> Html msg view : Model -> Html msg
view modules = view modules =
let let

View File

@ -54,7 +54,11 @@ body model =
[] []
] ]
] ]
, div [ classes "fl pl5 h-auto" ] [ p [ classes "h-100 m-auto fw4" ] [ a [ attribute "href" "/", classes "link black" ] [ text "Developer Hub" ] ] ] , div [ classes "fl pl5 h-auto" ]
[ p [ classes "h-100 m-auto fw4" ]
[ a [ attribute "href" "/", classes "link black" ] [ text "Developer Hub" ]
]
]
] ]
] ]
] ]