fix counters

This commit is contained in:
DieMyst 2021-02-26 04:57:06 +03:00
parent c346e0a1fa
commit a237da4aea
6 changed files with 99 additions and 44 deletions

View File

@ -9,12 +9,12 @@ import Html.Events exposing (onClick)
import Info exposing (getBlueprintDescription)
import Instances.View
import Interface.View exposing (interfaceView)
import List.Unique exposing (..)
import Model exposing (Model)
import Modules.Model exposing (Module)
import Msg exposing (Msg(..))
import Palette exposing (classes, darkRed, redFont)
import Service.Model exposing (Interface)
import List.Unique exposing (..)
view : Model -> String -> Html Msg
@ -50,15 +50,20 @@ blueprintToInfo model id =
case Dict.get id model.blueprints of
Just bp ->
let
hashes = bp.dependencies
hashes =
bp.dependencies
|> List.map (\d -> String.split ":" d)
|> List.map (\p -> Maybe.withDefault [] (List.tail p))
|> List.map (\p -> Maybe.withDefault "" (List.head p))
modules =
bp.dependencies |> List.map (\d -> Dict.get d model.modules) |> List.filterMap identity
modulesByHash =
hashes |> List.map (\d -> Dict.get d model.modulesByHash) |> List.filterMap identity
m = List.Unique.filterDuplicates (List.concat [modules, modulesByHash])
m =
List.Unique.filterDuplicates (List.concat [ modules, modulesByHash ])
in
Just
{ name = bp.name
@ -90,7 +95,8 @@ viewInfo blueprintInfo =
, div [ classes "fl w-100 w-80-ns mv3" ] [ span [ classes "fl w-100 black lucida pv1" ] [ text blueprintInfo.description ] ]
, div [ classes "fl w-100 w-20-ns gray-font mv3" ] [ text "MODULES" ]
, div [ classes "fl w-100 w-80-ns mv3" ]
[text (String.join ", " (blueprintInfo.modules |> List.map (\m -> m.name)))]
[ text (String.join ", " (blueprintInfo.modules |> List.map (\m -> m.name))) ]
--(blueprintInfo.modules
-- |> List.map (\m -> viewToggledInterface (checkToggle m.name) m.name)
--)
@ -102,7 +108,10 @@ alwaysPreventDefault msg =
{ message = msg, stopPropagation = True, preventDefault = True }
--viewToggledInterface : Bool -> String -> Interface -> Html Msg
viewToggledInterface : Bool -> String -> Html Msg
viewToggledInterface isOpen name =
let
@ -110,12 +119,14 @@ viewToggledInterface isOpen name =
if isOpen then
--[ div [ classes "fl w-100 ph3" ] (interfaceView interface) ]
[]
else
[]
in
div []
([ div [ classes "fl w-100 light-shadow bg-near-white pa2 mv2 pointer", onClick (ToggleInterface name) ]
[ span [ classes "fl mh2 pv1 tldib v-mid dib v-mid" ] [ text name ]
--, a [ attribute "href" ("/module/" ++ name), classes "fl dib v-mid mt1" ] [ img [ attribute "src" "/images/link.svg" ] [] ]
--, div [ classes "fl o-40 f4 fr pr3 dib v-mid" ]
-- [ if isOpen then

View File

@ -15,9 +15,13 @@ view model =
let
allBps =
getBlueprintsToServices model.blueprints model.discoveredPeers
-- TODO HACK: this is a hack to filter bloat blueprints until we have a predefined list of good ones
filteredBps = Dict.values allBps |> List.filter (\(_, services) -> List.length services > 3)
info = List.map
filteredBps =
Dict.values allBps |> List.filter (\( _, services ) -> List.length services > 3)
info =
List.map
(\( bp, servicesByPeers ) ->
{ name = bp.name
, id = bp.id

View File

@ -82,10 +82,7 @@ empty =
viewInfo : ModuleViewInfo -> Html msg
viewInfo moduleInfo =
article [ classes "cf" ]
[ div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "HASH" ]
, div [ classes "fl w-100 w-80-ns mv3" ]
[ span [ classes "fl w-100 black b lucida" ] [ text moduleInfo.moduleInfo.hash ] ]
, div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "AUTHOR" ]
[ div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "AUTHOR" ]
, div [ classes "fl w-100 w-80-ns mv3" ]
[ span [ classes "fl w-100 black b lucida" ] [ text moduleInfo.author ] ]
, div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "WEBSITE" ]
@ -99,6 +96,7 @@ viewInfo moduleInfo =
, div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "DESCRIPTION" ]
, div [ classes "fl w-100 w-80-ns mv3 lucida" ]
[ span [ classes "fl w-100 black", property "innerHTML" (string " 123") ] [ text moduleInfo.description ] ]
--, div [ classes "fl w-100 w-20-ns gray mv3" ] [ text "INTERFACE" ]
--, div [ classes "fl w-100 w-80-ns mv3" ]
-- [ span [ classes "fl w-100 black" ] (interfaceView moduleInfo.moduleInfo.interface) ]

View File

@ -5,7 +5,8 @@ import Service.Model exposing (Interface)
type alias Module =
{ name : String
, hash: String
, hash : String
--, interface : Interface
}

View File

@ -14,22 +14,28 @@ import Utils.Utils exposing (instancesText)
getModuleShortInfo : Model -> List ModuleShortInfo
getModuleShortInfo model =
getAllModules model.blueprints model.modules model.discoveredPeers
let
all = getAllModules model.blueprints model.modules model.modulesByHash model.discoveredPeers
res = all
|> Dict.toList
|> List.map (\( _, ( moduleInfo, services ) ) -> { moduleInfo = moduleInfo, instanceNumber = List.length services })
in
res
getAllModules : Dict String Blueprint -> Dict String Module -> Dict String PeerData -> Dict String ( Module, List Service )
getAllModules blueprints modules peerData =
getAllModules : Dict String Blueprint -> Dict String Module -> Dict String Module -> Dict String PeerData -> Dict String ( Module, List Service )
getAllModules blueprints modules modulesByHash peerData =
let
peerDatas =
Dict.toList peerData
allModulesByPeers =
peerDatas |> List.map (\( _, pd ) -> pd.modules |> List.map (\ms -> ( pd, ms ))) |> List.concat
peerDatas |> List.map (\( _, pd ) -> pd.modules |> List.map (\ms -> ( pd, ms, Maybe.withDefault "" (Maybe.map .hash (modules |> Dict.get ms)) ))) |> List.concat
peersByModuleName =
allModulesByPeers |> List.foldr (updateDict blueprints modules) Dict.empty
allModulesByPeers |> List.foldr (updateDict blueprints modules modulesByHash) Dict.empty
in
peersByModuleName
@ -38,26 +44,60 @@ getAllModules blueprints modules peerData =
-- group by module name and append peers
updateDict : Dict String Blueprint -> Dict String Module -> ( PeerData, String ) -> Dict String ( Module, List Service ) -> Dict String ( Module, List Service )
updateDict blueprints modules ( peerData, moduleName ) dict =
updateDict : Dict String Blueprint -> Dict String Module -> Dict String Module -> ( PeerData, String, String ) -> Dict String ( Module, List Service ) -> Dict String ( Module, List Service )
updateDict blueprints modules modulesByHash ( peerData, moduleName, moduleHash ) dict =
let
filter =
filterByHash =
\hash -> \list -> list |> List.filter (filterByModuleHash blueprints hash)
filterByName =
\name -> \list -> list |> List.filter (filterByModuleName blueprints name)
in
allModules =
Dict.union modules modulesByHash
dictNames =
dict
|> Dict.update moduleName
(\oldM ->
Maybe.Extra.or
(oldM |> Maybe.map (\( info, services ) -> ( info, List.append (filter info.name peerData.services) services )))
(Dict.get moduleName modules |> Maybe.map (\m -> ( m, filter m.name peerData.services )))
(oldM |> Maybe.map (\( info, services ) -> ( info, List.concat [ filterByHash moduleHash peerData.services, filterByName info.name peerData.services, services ] )))
(Dict.get moduleName allModules |> Maybe.map (\m -> ( m, List.append (filterByHash moduleHash peerData.services) (filterByName m.name peerData.services) )))
)
in
dictNames
filterByModuleName : Dict String Blueprint -> String -> (Service -> Bool)
filterByModuleName bps moduleName =
let
names =
\bp ->
bp.dependencies
|> List.map (\d -> String.split ":" d)
|> List.map (\p -> Maybe.withDefault [] (List.tail p))
|> List.map (\p -> Maybe.withDefault "" (List.head p))
check =
Maybe.map (\bp -> bp.dependencies |> List.member moduleName)
Maybe.map (\bp -> names bp |> List.member moduleName)
filter =
\s -> bps |> Dict.get s.blueprint_id |> check |> Maybe.withDefault False
in
filter
filterByModuleHash : Dict String Blueprint -> String -> (Service -> Bool)
filterByModuleHash bps moduleHash =
let
hashes =
\bp ->
bp.dependencies
|> List.map (\d -> String.split ":" d)
|> List.map (\p -> Maybe.withDefault [] (List.tail p))
|> List.map (\p -> Maybe.withDefault "" (List.head p))
check =
Maybe.map (\bp -> hashes bp |> List.member moduleHash)
filter =
\s -> bps |> Dict.get s.blueprint_id |> check |> Maybe.withDefault False

View File

@ -24,6 +24,7 @@ type alias Interface =
type alias Service =
{ id : String
, blueprint_id : String
--, interface : Interface
, owner_id : String
}