delete "Html.", formatting

This commit is contained in:
DieMyst 2020-11-30 14:31:03 +03:00
parent 17fc387e8e
commit 47a8de2482
20 changed files with 170 additions and 158 deletions

View File

@ -1,11 +1,11 @@
module AirScripts.CallPeers exposing (..)
import Air exposing (Air)
import Air exposing (Air, callBI, fold, next, par, relayEvent, seq, set)
import Json.Encode exposing (list, string)
air : String -> String -> (String, String, String) -> List String -> Air
air peerId relayId (event, service, fnName) peers =
air : String -> String -> ( String, String, String ) -> List String -> Air
air peerId relayId ( event, service, fnName ) peers =
let
clientIdSet =
set "clientId" <| string peerId
@ -28,4 +28,4 @@ air peerId relayId (event, service, fnName) peers =
(next "p")
)
in
clientIdSet <| relayIdSet <| peersSet <| airScript
clientIdSet <| relayIdSet <| peersSet <| airScript

View File

@ -1,9 +1,9 @@
module AirScripts.GetAll exposing (..)
import Air exposing (Air)
import Air exposing (Air, callBI, fold, next, par, relayEvent, seq, set)
import Json.Encode exposing (list, string)
air : String -> String -> List String -> Air
air peerId relayId peers =
let
@ -29,13 +29,12 @@ air peerId relayId peers =
(callBI "p" ( "dist", "get_modules" ) [] (Just "modules"))
(seq
(callBI "p" ( "srv", "get_interfaces" ) [] (Just "interfaces"))
(relayEvent "all_info" [ "p", "ident", "interfaces","blueprints", "modules" ])
(relayEvent "all_info" [ "p", "ident", "interfaces", "blueprints", "modules" ])
)
)
)
)
(next "p")
)
in
clientIdSet <| relayIdSet <| peersSet <| airScript
clientIdSet <| relayIdSet <| peersSet <| airScript

View File

@ -2,6 +2,8 @@ module Blueprints.Air exposing (..)
import Air exposing (Air)
import AirScripts.CallPeers
air : String -> String -> List String -> Air
air peerId relayId peers =
AirScripts.CallPeers.air peerId relayId ("blueprints_discovered", "dist", "get_blueprints") peers
AirScripts.CallPeers.air peerId relayId ( "blueprints_discovered", "dist", "get_blueprints" ) peers

View File

@ -1,7 +1,8 @@
module Blueprints.Model exposing (..)
type alias Blueprint =
{ dependencies: List String
, id: String
, name: String
}
{ dependencies : List String
, id : String
, name : String
}

View File

@ -6,6 +6,7 @@ import Model exposing (Model)
import Modules.View
import Services.View
view : Model -> Html msg
view model =
Html.div []

View File

@ -2,7 +2,8 @@ module Instances.Model exposing (..)
type alias Instance =
{ name: String
, instance: String
, peerId: String
, ip: String}
{ name : String
, instance : String
, peerId : String
, ip : String
}

View File

@ -6,6 +6,7 @@ import Instances.Model exposing (Instance)
import Model exposing (Model)
import Palette exposing (classes)
view : Model -> Html msg
view model =
let
@ -16,25 +17,27 @@ view model =
, { name = "SQLite", instance = "efrer3434g", peerId = "kljn35kfj4n5kjgn4k5jgn45kj", ip = "123.123.123.123" }
]
in
viewTable instances
viewTable instances
viewTable : List Instance -> Html msg
viewTable instances =
div [classes "pa4"]
[ div [classes "overflow-auto"]
[ table [classes "f6 w-100 mw8 center", attribute "cellspacing" "0"]
[ thead []
[ tr [ classes "stripe-dark" ]
[ th [ classes "fw6 tl pa3 bg-white" ] [ text "SERVICE"]
, th [ classes "fw6 tl pa3 bg-white" ] [ text "INSTANCE"]
, th [ classes "fw6 tl pa3 bg-white" ] [ text "NODE"]
, th [ classes "fw6 tl pa3 bg-white" ] [ text "IP"]
]
div [ classes "pa4" ]
[ div [ classes "overflow-auto" ]
[ table [ classes "f6 w-100 mw8 center", attribute "cellspacing" "0" ]
[ thead []
[ tr [ classes "stripe-dark" ]
[ th [ classes "fw6 tl pa3 bg-white" ] [ text "SERVICE" ]
, th [ classes "fw6 tl pa3 bg-white" ] [ text "INSTANCE" ]
, th [ classes "fw6 tl pa3 bg-white" ] [ text "NODE" ]
, th [ classes "fw6 tl pa3 bg-white" ] [ text "IP" ]
]
, tbody [ classes "lh-copy" ] (instances |> List.map viewInstance)
]
, tbody [ classes "lh-copy" ] (instances |> List.map viewInstance)
]
]
]
viewInstance : Instance -> Html msg
viewInstance instance =
@ -43,4 +46,4 @@ viewInstance instance =
, td [ classes "pa3" ] [ text instance.instance ]
, td [ classes "pa3" ] [ text instance.peerId ]
, td [ classes "pa3" ] [ text instance.ip ]
]
]

View File

@ -1,7 +1,6 @@
module ModulePage.View exposing (..)
import Html exposing (Html)
import Json.Encode as Encode
import Html exposing (Html, article, div, span, text)
import ModulePage.Model exposing (ModuleInfo)
import Palette exposing (classes)
import Services.Model exposing (Record, Signature)
@ -10,22 +9,22 @@ import String.Interpolate exposing (interpolate)
view : ModuleInfo -> Html msg
view moduleInfo =
Html.div [ classes "cf ph2-ns" ]
[ Html.span [ classes "fl w-100 f1 lh-title dark-red" ] [ Html.text ("Module: " ++ moduleInfo.name) ]
, Html.span [ classes "fl w-100 light-red" ] [ Html.text moduleInfo.id ]
div [ classes "cf ph2-ns" ]
[ span [ classes "fl w-100 f1 lh-title dark-red" ] [ text ("Module: " ++ moduleInfo.name) ]
, span [ classes "fl w-100 light-red" ] [ text moduleInfo.id ]
, viewInfo moduleInfo
]
viewInfo : ModuleInfo -> Html msg
viewInfo moduleInfo =
Html.article [ classes "cf" ]
[ Html.div [ classes "fl w-30 gray mv1" ] [ Html.text "AUTHOR" ]
, Html.div [ classes "fl w-70 mv1" ] [ Html.span [ classes "fl w-100 black b" ] [ Html.text moduleInfo.author ], Html.span [ classes "fl w-100 black" ] [ Html.text moduleInfo.authorPeerId ] ]
, Html.div [ classes "fl w-30 gray mv1" ] [ Html.text "DESCRIPTION" ]
, Html.div [ classes "fl w-70 mv1" ] [ Html.span [ classes "fl w-100 black" ] [ Html.text moduleInfo.description ] ]
, Html.div [ classes "fl w-30 gray mv1" ] [ Html.text "INTERFACE" ]
, Html.div [ classes "fl w-70 mv1" ] [ Html.span [ classes "fl w-100 black" ] (recordsView moduleInfo.service.interface.record_types ++ signaturesView moduleInfo.service.interface.function_signatures) ]
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-30 gray mv1" ] [ text "DESCRIPTION" ]
, div [ classes "fl w-70 mv1" ] [ span [ classes "fl w-100 black" ] [ text moduleInfo.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) ]
]
@ -36,16 +35,16 @@ recordsView record =
recordView : Record -> Html msg
recordView record =
Html.div [ classes "i" ]
([ Html.span [ classes "fl w-100 mt2" ] [ Html.text (record.name ++ " {") ] ]
div [ classes "i" ]
([ span [ classes "fl w-100 mt2" ] [ text (record.name ++ " {") ] ]
++ fieldsView record.fields
++ [ Html.span [ classes "fl w-100 mb2" ] [ Html.text "}" ] ]
++ [ span [ classes "fl w-100 mb2" ] [ text "}" ] ]
)
fieldsView : List (List String) -> List (Html msg)
fieldsView fields =
fields |> List.map (\f -> Html.span [ classes "fl w-100 ml2" ] [ Html.text (String.join ": " f) ])
fields |> List.map (\f -> span [ classes "fl w-100 ml2" ] [ text (String.join ": " f) ])
signaturesView : List Signature -> List (Html msg)
@ -55,8 +54,8 @@ signaturesView signatures =
signatureView : Signature -> Html msg
signatureView signature =
Html.div [ classes "i fl w-100 mv2" ]
[ Html.text (interpolate "fn {0}({1}) -> {2}" [ signature.name, argumentsToString signature.arguments, outputToString signature.output_types ]) ]
div [ classes "i fl w-100 mv2" ]
[ text (interpolate "fn {0}({1}) -> {2}" [ signature.name, argumentsToString signature.arguments, outputToString signature.output_types ]) ]
argumentsToString : List (List String) -> String

View File

@ -6,4 +6,4 @@ import AirScripts.CallPeers
air : String -> String -> List String -> Air
air peerId relayId peers =
AirScripts.CallPeers.air peerId relayId ("modules_discovered", "dist", "get_modules") peers
AirScripts.CallPeers.air peerId relayId ( "modules_discovered", "dist", "get_modules" ) peers

View File

@ -4,4 +4,4 @@ module Modules.Model exposing (..)
type alias ModuleShortInfo =
{ name : String
, instanceNumber : Int
}
}

View File

@ -1,28 +1,36 @@
module Modules.View exposing (..)
import Dict exposing (Dict)
import Html exposing (Html)
import Html exposing (Html, div, p, span, text)
import Model exposing (Model, PeerData)
import Modules.Model exposing (ModuleShortInfo)
import Palette exposing (classes)
import Utils.Utils exposing (instancesText)
getModuleShortInfo : Model -> List ModuleShortInfo
getModuleShortInfo model =
getAllModules model.discoveredPeers |> Dict.toList |> List.map (\(moduleName, peers) -> {name = moduleName, instanceNumber = List.length peers})
getAllModules model.discoveredPeers |> Dict.toList |> List.map (\( moduleName, peers ) -> { name = moduleName, instanceNumber = List.length peers })
getAllModules : Dict String PeerData -> Dict String (List String)
getAllModules peerData =
let
peerDatas = Dict.toList peerData
allModules = peerDatas |> List.map (\(peer, pd) -> pd.modules |> List.map (\ms -> (peer, ms))) |> List.concat
peersByModuleName = allModules |> List.foldr updateDict Dict.empty
in
peersByModuleName
peerDatas =
Dict.toList peerData
updateDict : (String, String) -> Dict String (List String) -> Dict String (List String)
updateDict (peer, moduleName) dict =
dict |> Dict.update moduleName (\oldM -> oldM |> Maybe.map (List.append [peer]) |> Maybe.withDefault [peer] |> Just)
allModules =
peerDatas |> List.map (\( peer, pd ) -> pd.modules |> List.map (\ms -> ( peer, ms ))) |> List.concat
peersByModuleName =
allModules |> List.foldr updateDict Dict.empty
in
peersByModuleName
updateDict : ( String, String ) -> Dict String (List String) -> Dict String (List String)
updateDict ( peer, moduleName ) dict =
dict |> Dict.update moduleName (\oldM -> oldM |> Maybe.map (List.append [ peer ]) |> Maybe.withDefault [ peer ] |> Just)
view : Model -> Html msg
@ -31,13 +39,13 @@ view modules =
modulesView =
List.map viewService (getModuleShortInfo modules)
in
Html.div [ classes "cf ph2-ns" ] modulesView
div [ classes "cf ph2-ns" ] modulesView
viewService : ModuleShortInfo -> Html msg
viewService service =
Html.div [ classes "fl w-third-ns pa2" ]
[ Html.div [ classes "fl w-100 br2 ba solid pa2 mh2" ]
[ Html.p [ classes "tl di" ] [ Html.span [ classes "b pl2" ] [ Html.text service.name ], Html.span [ classes "di fr pr2" ] [ instancesText service.instanceNumber ] ]
div [ classes "fl w-third-ns pa2" ]
[ div [ classes "fl w-100 br2 ba solid pa2 mh2" ]
[ p [ classes "tl di" ] [ span [ classes "b pl2" ] [ text service.name ], span [ classes "di fr pr2" ] [ instancesText service.instanceNumber ] ]
]
]

View File

@ -6,4 +6,4 @@ import AirScripts.CallPeers
air : String -> String -> List String -> Air
air peerId relayId peers =
AirScripts.CallPeers.air peerId relayId ("peer_identity", "op", "identify") peers
AirScripts.CallPeers.air peerId relayId ( "peer_identity", "op", "identify" ) peers

View File

@ -1,7 +1,10 @@
module Nodes.Model exposing (..)
type alias Identify =
{ external_addresses: List String }
{ external_addresses : List String }
emptyIdentify : Identify
emptyIdentify = { external_addresses = [] }
emptyIdentify =
{ external_addresses = [] }

View File

@ -13,7 +13,7 @@ type alias SendParticle =
type alias ReceiveEvent =
{ name : String, peer : String, peers : Maybe (List String), identify : Maybe Identify, services : Maybe (List Service), modules : Maybe (List String), blueprints : Maybe (List Blueprint)}
{ name : String, peer : String, peers : Maybe (List String), identify : Maybe Identify, services : Maybe (List Service), modules : Maybe (List String), blueprints : Maybe (List Blueprint) }
port sendParticle : SendParticle -> Cmd msg

View File

@ -32,10 +32,10 @@ routeView model route =
case page of
"" ->
HubPage.view model
"hub" ->
HubPage.view model
_ ->
Html.text ("undefined page: " ++ page)
@ -71,6 +71,7 @@ routeView model route =
Nothing ->
Html.text moduleName
getPeers : Model -> Cmd msg
getPeers m =
let
@ -97,6 +98,7 @@ getPeers m =
in
sendAir (relayId <| clientId <| air)
routeCommand : Model -> Route -> Cmd msg
routeCommand m r =
case r of
@ -109,7 +111,5 @@ routeCommand m r =
Service string ->
getPeers m
Module string ->
getPeers m

View File

@ -6,4 +6,4 @@ import AirScripts.CallPeers
air : String -> String -> List String -> Air
air peerId relayId peers =
AirScripts.CallPeers.air peerId relayId ("services_discovered", "srv", "get_interfaces") peers
AirScripts.CallPeers.air peerId relayId ( "services_discovered", "srv", "get_interfaces" ) peers

View File

@ -33,4 +33,3 @@ type alias ServiceInfo =
, author : String
, instanceNumber : Int
}

View File

@ -2,7 +2,7 @@ module Services.View exposing (..)
import Blueprints.Model exposing (Blueprint)
import Dict exposing (Dict)
import Html exposing (Html)
import Html exposing (Html, div, text)
import Model exposing (Model, PeerData)
import Palette exposing (classes)
import Services.Model exposing (Service, ServiceInfo)
@ -12,42 +12,62 @@ import Utils.Utils exposing (instancesText)
view : Model -> Html msg
view model =
let
allBps = getBlueprintsToServices 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)})
allBps =
getBlueprintsToServices 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) })
servicesView =
List.map viewService info
in
Html.div [ classes "cf ph2-ns" ] servicesView
div [ classes "cf ph2-ns" ] servicesView
viewService : ServiceInfo -> Html msg
viewService service =
Html.div [ classes "fl w-third-ns pa2" ]
[ Html.div [ classes "fl w-100 br2 ba solid ma2 pa3" ]
[ Html.div [ classes "w-100 mb2 b" ] [ Html.text service.name ]
, Html.div [ classes "w-100 mb4" ] [ Html.text ("By " ++ service.author) ]
, Html.div [ classes "w-100" ] [ instancesText service.instanceNumber ]
div [ classes "fl w-third-ns pa2" ]
[ div [ classes "fl w-100 br2 ba solid ma2 pa3" ]
[ div [ classes "w-100 mb2 b" ] [ text service.name ]
, div [ classes "w-100 mb4" ] [ text ("By " ++ service.author) ]
, div [ classes "w-100" ] [ instancesText service.instanceNumber ]
]
]
-- bpId peerId
getBlueprintsToServices : Dict String PeerData -> Dict String (Blueprint, (List (String, List Service)))
getBlueprintsToServices : Dict String PeerData -> Dict String ( Blueprint, List ( String, List Service ) )
getBlueprintsToServices peerData =
let
peerDatas = Dict.toList peerData
allBlueprints = peerDatas |> List.map (\(_, pd) -> pd.blueprints |> List.map (\bp -> bp)) |> List.concat
bpsToServices = allBlueprints |> List.map (\bp -> (bp.id, (bp, getServicesByBlueprintId peerData bp.id))) |> Dict.fromList
in
bpsToServices
peerDatas =
Dict.toList peerData
getServicesByBlueprintId : Dict String PeerData -> String -> List (String, List Service)
allBlueprints =
peerDatas |> List.map (\( _, pd ) -> pd.blueprints |> List.map (\bp -> bp)) |> List.concat
bpsToServices =
allBlueprints |> List.map (\bp -> ( bp.id, ( bp, getServicesByBlueprintId peerData bp.id ) )) |> Dict.fromList
in
bpsToServices
getServicesByBlueprintId : Dict String PeerData -> String -> List ( String, List Service )
getServicesByBlueprintId peerData bpId =
let
list = Dict.toList peerData
found = list |> List.map (\(peer, pd) -> (peer, (filterServicesByBlueprintId bpId pd)))
filtered = found |> List.filter (\(_, services) -> not (List.isEmpty services))
in
filtered
list =
Dict.toList peerData
found =
list |> List.map (\( peer, pd ) -> ( peer, filterServicesByBlueprintId bpId pd ))
filtered =
found |> List.filter (\( _, services ) -> not (List.isEmpty services))
in
filtered
filterServicesByBlueprintId : String -> PeerData -> List Service
filterServicesByBlueprintId blueprintId peerData =

View File

@ -33,53 +33,6 @@ import Services.Model exposing (Service)
import Url
maybeValueToString : Maybe Value -> String
maybeValueToString mv =
case mv of
Just v ->
case decodeValue string v of
Ok value ->
value
Err error ->
"error"
Nothing ->
""
-- list of lists of strings in json to list of strings from first element if it is an array
maybeValueToListString : Maybe Value -> List String
maybeValueToListString mv =
case mv of
Just v ->
case decodeValue (list (list string)) v of
Ok value ->
Maybe.withDefault [] (List.head value)
Err error ->
let
_ =
Debug.log "error" error
in
case decodeValue (list string) v of
Ok value ->
value
Err err ->
let
_ =
Debug.log "err" err
in
[ "error" ]
Nothing ->
[]
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
@ -121,11 +74,17 @@ update msg model =
"all_info" ->
let
updated = Maybe.map4 (updateModel model peer) identify services modules blueprints
updatedModel = withDefault model updated
updated =
Maybe.map4 (updateModel model peer) identify services modules blueprints
byBp = peersByBlueprintId model.discoveredPeers "623c6d14-2204-43c4-84d5-a237bcd19874"
_ = Debug.log "by blueprint id" byBp
updatedModel =
withDefault model updated
byBp =
peersByBlueprintId model.discoveredPeers "623c6d14-2204-43c4-84d5-a237bcd19874"
_ =
Debug.log "by blueprint id" byBp
in
( updatedModel, Cmd.none )
@ -158,43 +117,58 @@ update msg model =
( model
, sendAir (AirScripts.GetAll.air model.peerId model.relayId (Dict.keys model.discoveredPeers))
)
_ ->
(model, Cmd.none)
_ ->
( model, Cmd.none )
RelayChanged relayId ->
( { model | relayId = relayId }, Cmd.none )
updateModel : Model -> String -> Identify -> List Service -> List String -> List Blueprint -> Model
updateModel model peer identify services modules blueprints =
let
data = Maybe.withDefault emptyPeerData (Dict.get peer model.discoveredPeers)
newData = { data | identify = identify, services = services, modules = modules, blueprints = blueprints }
updated = Dict.insert peer newData model.discoveredPeers
data =
Maybe.withDefault emptyPeerData (Dict.get peer model.discoveredPeers)
newData =
{ data | identify = identify, services = services, modules = modules, blueprints = blueprints }
updated =
Dict.insert peer newData model.discoveredPeers
in
{ model | discoveredPeers = updated }
{ 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)
list =
Dict.toList peerData
found =
list |> List.filter (\( _, pd ) -> existsByModule moduleId pd.modules) |> List.map (\( peer, _ ) -> peer)
in
found
found
existsByModule : String -> List String -> Bool
existsByModule moduleId modules =
modules |> List.any (\m -> m == 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)
list =
Dict.toList peerData
found =
list |> List.filter (\( _, pd ) -> existsByBlueprintId blueprintId pd.blueprints) |> List.map (\( peer, _ ) -> peer)
in
found
found
existsByBlueprintId : String -> List Blueprint -> Bool
existsByBlueprintId id bps =
bps |> List.any (\b -> b.id == id)

View File

@ -18,10 +18,12 @@ limitations under the License.
import Maybe exposing (map2)
combine : List (Maybe a) -> Maybe (List a)
combine =
List.foldr (map2 (::)) (Just [])
isEmpty : Maybe a -> Bool
isEmpty maybe =
case maybe of