mirror of
https://github.com/ilyakooo0/airlock.git
synced 2024-08-16 14:00:23 +03:00
Added pokes
This commit is contained in:
parent
4988fc5c0e
commit
5590712d02
@ -7,6 +7,7 @@
|
||||
"elm-version": "0.19.1",
|
||||
"dependencies": {
|
||||
"direct": {
|
||||
"Orasund/elm-ui-widgets": "3.4.0",
|
||||
"TSFoster/elm-bytes-extra": "1.3.0",
|
||||
"chelovek0v/bbase64": "1.0.1",
|
||||
"cmditch/elm-bigint": "2.0.1",
|
||||
@ -17,24 +18,32 @@
|
||||
"elm/http": "2.0.0",
|
||||
"elm/json": "1.1.3",
|
||||
"elm/parser": "1.1.0",
|
||||
"elm/time": "1.0.0",
|
||||
"elm/url": "1.0.0",
|
||||
"elm-community/list-extra": "8.7.0",
|
||||
"elm-community/maybe-extra": "5.3.0",
|
||||
"figbus/elm-urbit-api": "4.0.1",
|
||||
"jasonliang-dev/elm-heroicons": "2.0.0",
|
||||
"jxxcarlson/hex": "4.0.0",
|
||||
"ktonon/elm-word": "2.1.2",
|
||||
"mdgriffith/elm-ui": "1.1.8",
|
||||
"robinheghan/murmur3": "1.0.0"
|
||||
"robinheghan/murmur3": "1.0.0",
|
||||
"toastal/either": "3.6.3"
|
||||
},
|
||||
"indirect": {
|
||||
"AdrianRibao/elm-derberos-date": "1.2.3",
|
||||
"avh4/elm-color": "1.0.0",
|
||||
"bitsoflogic/elm-radixint": "2.0.0",
|
||||
"elm/file": "1.0.5",
|
||||
"elm/random": "1.0.0",
|
||||
"elm/regex": "1.0.0",
|
||||
"elm/time": "1.0.0",
|
||||
"elm/svg": "1.0.1",
|
||||
"elm/virtual-dom": "1.0.3",
|
||||
"rtfeldman/elm-hex": "1.0.0"
|
||||
"elm-community/intdict": "3.0.0",
|
||||
"fredcy/elm-parseint": "2.0.1",
|
||||
"noahzgordon/elm-color-extra": "1.0.2",
|
||||
"rtfeldman/elm-hex": "1.0.0",
|
||||
"turboMaCk/queue": "1.1.0"
|
||||
}
|
||||
},
|
||||
"test-dependencies": {
|
||||
|
@ -1,12 +1,24 @@
|
||||
port module Main exposing (main)
|
||||
|
||||
import BigInt exposing (BigInt)
|
||||
import Browser exposing (Document)
|
||||
import Element exposing (..)
|
||||
import Element.Border as Border
|
||||
import Heroicons.Outline
|
||||
import Json.Decode as JD
|
||||
import Task
|
||||
import Time
|
||||
import Ur
|
||||
import Ur.Cmd
|
||||
import Ur.Constructor as C
|
||||
import Ur.Da
|
||||
import Ur.Deconstructor as D
|
||||
import Ur.Requests
|
||||
import Ur.Run
|
||||
import Ur.Sub
|
||||
import Widget
|
||||
import Widget.Icon as Icon
|
||||
import Widget.Material as Material
|
||||
|
||||
|
||||
main =
|
||||
@ -14,22 +26,44 @@ main =
|
||||
{ init =
|
||||
\_ _ ->
|
||||
( { error = ""
|
||||
, entries = Nothing
|
||||
, newEntry = ""
|
||||
}
|
||||
, Ur.logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"
|
||||
|> Cmd.map (result (Debug.toString >> Error) (always Noop))
|
||||
, Cmd.batch
|
||||
[ Ur.logIn "http://localhost:8080" "lidlut-tabwed-pillex-ridrup"
|
||||
|> Cmd.map (result (Debug.toString >> Error) (always Noop))
|
||||
, Ur.Requests.scry
|
||||
{ url = "http://localhost:8080"
|
||||
, agent = "journal"
|
||||
, path = [ "entries", "all" ]
|
||||
, error = Noop
|
||||
, success =
|
||||
D.cell D.ignore
|
||||
(D.cell (D.const D.cord "jrnl")
|
||||
(D.list (D.cell D.bigint D.cord |> D.map (\a b -> ( a, b ))))
|
||||
|> D.map GotListings
|
||||
)
|
||||
}
|
||||
]
|
||||
|> Ur.Cmd.cmd
|
||||
)
|
||||
, update = update
|
||||
, view = view
|
||||
, subscriptions = always Sub.none
|
||||
, createEventSource = createEventSource
|
||||
, urbitSubscriptions =
|
||||
\_ ->
|
||||
Ur.Sub.subscribe
|
||||
{ ship = "~zod"
|
||||
, app = "journal"
|
||||
, path = [ "updates" ]
|
||||
, deconstructor = D.tar |> D.map (always Noop)
|
||||
}
|
||||
\{ entries } ->
|
||||
case entries of
|
||||
Nothing ->
|
||||
Ur.Sub.none
|
||||
|
||||
Just _ ->
|
||||
Ur.Sub.subscribe
|
||||
{ ship = "~zod"
|
||||
, app = "journal"
|
||||
, path = [ "updates" ]
|
||||
, deconstructor = decodeJournalUpdate |> D.map GotUpdate
|
||||
}
|
||||
, onEventSourceMsg = onEventSourceMessage
|
||||
, onUrlChange = \_ -> Noop
|
||||
, onUrlRequest = \_ -> Noop
|
||||
@ -39,28 +73,152 @@ main =
|
||||
|
||||
type alias Model =
|
||||
{ error : String
|
||||
, entries : Maybe (List ( BigInt, String ))
|
||||
, newEntry : String
|
||||
}
|
||||
|
||||
|
||||
type Msg
|
||||
= Noop
|
||||
| Error String
|
||||
| GotListings (List ( BigInt, String ))
|
||||
| GotUpdate JournalUpdate
|
||||
| UpdateNewEntry String
|
||||
| DeleteEntry BigInt
|
||||
| AddEntry String
|
||||
| RunCmd (Ur.Cmd.Cmd Msg)
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd msg )
|
||||
update : Msg -> Model -> ( Model, Ur.Cmd.Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
Noop ->
|
||||
( model, Cmd.none )
|
||||
( model, Ur.Cmd.none )
|
||||
|
||||
Error err ->
|
||||
( { model | error = err }, Cmd.none )
|
||||
( { model | error = err }, Ur.Cmd.none )
|
||||
|
||||
GotListings entries ->
|
||||
( { model | entries = Just entries }, Ur.Cmd.none )
|
||||
|
||||
GotUpdate action ->
|
||||
let
|
||||
applyAction oldEntries =
|
||||
case action of
|
||||
Add id txt ->
|
||||
( id, txt ) :: oldEntries
|
||||
|
||||
Edit id txt ->
|
||||
oldEntries
|
||||
|> List.map
|
||||
(\(( key, _ ) as value) ->
|
||||
if key == id then
|
||||
( key, txt )
|
||||
|
||||
else
|
||||
value
|
||||
)
|
||||
|
||||
Delete id ->
|
||||
oldEntries |> List.filter (\( key, _ ) -> key /= id)
|
||||
|
||||
newEntries =
|
||||
model.entries |> Maybe.map applyAction
|
||||
in
|
||||
( { model | entries = newEntries }, Ur.Cmd.none )
|
||||
|
||||
UpdateNewEntry txt ->
|
||||
( { model | newEntry = txt }, Ur.Cmd.none )
|
||||
|
||||
DeleteEntry id ->
|
||||
( model
|
||||
, Ur.Cmd.poke
|
||||
{ ship = "~zod"
|
||||
, agent = "journal"
|
||||
, mark = "journal-action"
|
||||
, noun = C.cell (C.cord "del") (C.bigint id)
|
||||
}
|
||||
)
|
||||
|
||||
AddEntry txt ->
|
||||
( { model | newEntry = "" }
|
||||
, Time.now
|
||||
|> Task.perform
|
||||
(\time ->
|
||||
Ur.Cmd.poke
|
||||
{ ship = "~zod"
|
||||
, agent = "journal"
|
||||
, mark = "journal-action"
|
||||
, noun = C.cell (C.cord "add") (C.cell (Ur.Da.posixToDa time |> C.bigint) (C.cord txt))
|
||||
}
|
||||
|> RunCmd
|
||||
)
|
||||
|> Ur.Cmd.cmd
|
||||
)
|
||||
|
||||
RunCmd cmd ->
|
||||
( model, cmd )
|
||||
|
||||
|
||||
type JournalUpdate
|
||||
= Add BigInt String
|
||||
| Edit BigInt String
|
||||
| Delete BigInt
|
||||
|
||||
|
||||
decodeJournalUpdate : D.Deconstructor (JournalUpdate -> a) a
|
||||
decodeJournalUpdate =
|
||||
D.cell D.ignore <|
|
||||
D.oneOf
|
||||
[ (D.cell (D.const D.cord "add") <| D.cell D.bigint D.cord) |> D.map Add
|
||||
, (D.cell (D.const D.cord "edit") <| D.cell D.bigint D.cord) |> D.map Edit
|
||||
, D.cell (D.const D.cord "del") D.bigint |> D.map Delete
|
||||
]
|
||||
|
||||
|
||||
view : Model -> Document Msg
|
||||
view model =
|
||||
{ body =
|
||||
[ layout [] (column [ centerX, centerY ] [ el [ alignTop ] (text model.error), text "Hello" ]) ]
|
||||
[ layout []
|
||||
([ el [ alignTop ] (text model.error)
|
||||
, row [ spacing 8 ]
|
||||
[ Widget.textInput (Material.textInput Material.defaultPalette)
|
||||
{ chips = []
|
||||
, text = model.newEntry
|
||||
, placeholder = Nothing
|
||||
, label = "New entry"
|
||||
, onChange = UpdateNewEntry
|
||||
}
|
||||
, Widget.iconButton (Material.containedButton Material.defaultPalette)
|
||||
{ text = "submit"
|
||||
, icon = Icon.elmHeroicons Heroicons.Outline.check
|
||||
, onPress = AddEntry model.newEntry |> Just
|
||||
}
|
||||
]
|
||||
, model.entries
|
||||
|> Maybe.withDefault []
|
||||
|> List.map
|
||||
(\( id, txt ) ->
|
||||
row
|
||||
[ Border.rounded 10
|
||||
, Border.shadow { offset = ( 0, 5 ), size = 1, blur = 10, color = rgba 0 0 0 0.3 }
|
||||
, centerX
|
||||
, padding 10
|
||||
, spacing 12
|
||||
]
|
||||
[ paragraph [] [ text txt ]
|
||||
, Widget.iconButton (Material.containedButton Material.defaultPalette)
|
||||
{ text = "delete"
|
||||
, icon = Icon.elmHeroicons Heroicons.Outline.trash
|
||||
, onPress = DeleteEntry id |> Just
|
||||
}
|
||||
]
|
||||
)
|
||||
|> column [ spacing 10, centerX ]
|
||||
]
|
||||
|> column [ spacing 18, centerX ]
|
||||
)
|
||||
]
|
||||
, title = "Airlock"
|
||||
}
|
||||
|
||||
|
35
src/Ur/Cmd.elm
Normal file
35
src/Ur/Cmd.elm
Normal file
@ -0,0 +1,35 @@
|
||||
module Ur.Cmd exposing
|
||||
( Cmd
|
||||
, batch
|
||||
, cmd
|
||||
, none
|
||||
, poke
|
||||
)
|
||||
|
||||
import Ur exposing (Agent, Mark, Noun)
|
||||
import Ur.Cmd.Internal
|
||||
import Ur.Phonemic exposing (Ship)
|
||||
|
||||
|
||||
type alias Cmd msg =
|
||||
List (Ur.Cmd.Internal.Cmd msg)
|
||||
|
||||
|
||||
none : Cmd msg
|
||||
none =
|
||||
[]
|
||||
|
||||
|
||||
poke : { ship : Ship, agent : Agent, mark : Mark, noun : Noun } -> Cmd msg
|
||||
poke p =
|
||||
[ Ur.Cmd.Internal.Poke p ]
|
||||
|
||||
|
||||
cmd : Cmd.Cmd msg -> Cmd msg
|
||||
cmd c =
|
||||
[ Ur.Cmd.Internal.Cmd c ]
|
||||
|
||||
|
||||
batch : List (Cmd msg) -> Cmd msg
|
||||
batch =
|
||||
List.concat
|
9
src/Ur/Cmd/Internal.elm
Normal file
9
src/Ur/Cmd/Internal.elm
Normal file
@ -0,0 +1,9 @@
|
||||
module Ur.Cmd.Internal exposing (Cmd(..))
|
||||
|
||||
import Ur exposing (Agent, Mark, Noun)
|
||||
import Ur.Phonemic exposing (Ship)
|
||||
|
||||
|
||||
type Cmd msg
|
||||
= Poke { ship : Ship, agent : Agent, mark : Mark, noun : Noun }
|
||||
| Cmd (Cmd.Cmd msg)
|
23
src/Ur/Da.elm
Normal file
23
src/Ur/Da.elm
Normal file
@ -0,0 +1,23 @@
|
||||
module Ur.Da exposing (Da, posixToDa)
|
||||
|
||||
import BigInt exposing (BigInt)
|
||||
import Time exposing (Posix)
|
||||
|
||||
|
||||
type alias Da =
|
||||
BigInt
|
||||
|
||||
|
||||
unixEpochStart : BigInt
|
||||
unixEpochStart =
|
||||
BigInt.fromIntString "170141184475152167957503069145530368000" |> Maybe.withDefault (BigInt.fromInt 0)
|
||||
|
||||
|
||||
second : BigInt
|
||||
second =
|
||||
BigInt.fromIntString "18446744073709551616" |> Maybe.withDefault (BigInt.fromInt 0)
|
||||
|
||||
|
||||
posixToDa : Posix -> Da
|
||||
posixToDa p =
|
||||
BigInt.add (BigInt.div (BigInt.mul (BigInt.fromInt (Time.posixToMillis p)) second) (BigInt.fromInt 1000)) unixEpochStart
|
@ -1,14 +1,19 @@
|
||||
module Ur.Requests exposing
|
||||
( EventId
|
||||
, UrbitRequest(..)
|
||||
, scry
|
||||
, scryTask
|
||||
, send
|
||||
, sendTask
|
||||
, tag
|
||||
, toNoun
|
||||
)
|
||||
|
||||
import Http
|
||||
import Task exposing (Task)
|
||||
import Ur exposing (..)
|
||||
import Ur.Constructor as C
|
||||
import Ur.Deconstructor as D
|
||||
import Ur.Phonemic exposing (Ship)
|
||||
import Ur.Uw
|
||||
|
||||
@ -30,8 +35,6 @@ tag eventId reqs =
|
||||
tag (eventId + 1) rest |> Tuple.mapSecond (\xs -> ( eventId, req ) :: xs)
|
||||
|
||||
|
||||
{-| `requests` should the result of calling `tag`
|
||||
-}
|
||||
send :
|
||||
{ url : String
|
||||
, error : msg
|
||||
@ -39,12 +42,25 @@ send :
|
||||
, requests : List ( EventId, UrbitRequest )
|
||||
}
|
||||
-> Cmd msg
|
||||
send { url, error, success, requests } =
|
||||
send inp =
|
||||
sendTask inp |> Task.perform identity
|
||||
|
||||
|
||||
{-| `requests` should the result of calling `tag`
|
||||
-}
|
||||
sendTask :
|
||||
{ url : String
|
||||
, error : msg
|
||||
, success : msg
|
||||
, requests : List ( EventId, UrbitRequest )
|
||||
}
|
||||
-> Task a msg
|
||||
sendTask { url, error, success, requests } =
|
||||
if List.isEmpty requests then
|
||||
Cmd.none
|
||||
Task.succeed success
|
||||
|
||||
else
|
||||
Http.riskyRequest
|
||||
Http.riskyTask
|
||||
{ method = "PUT"
|
||||
, headers = []
|
||||
, url = url
|
||||
@ -55,9 +71,17 @@ send { url, error, success, requests } =
|
||||
|> Ur.jam
|
||||
|> Ur.Uw.encode
|
||||
|> Http.stringBody "application/x-urb-jam"
|
||||
, expect = Http.expectWhatever (result (\_ -> error) (always success))
|
||||
, resolver =
|
||||
Http.bytesResolver
|
||||
(\resp ->
|
||||
case resp of
|
||||
Http.GoodStatus_ _ _ ->
|
||||
Ok success
|
||||
|
||||
_ ->
|
||||
Ok error
|
||||
)
|
||||
, timeout = Nothing
|
||||
, tracker = Nothing
|
||||
}
|
||||
|
||||
|
||||
@ -65,6 +89,51 @@ type alias EventId =
|
||||
Int
|
||||
|
||||
|
||||
scry :
|
||||
{ url : String
|
||||
, agent : Agent
|
||||
, path : Path
|
||||
, error : msg
|
||||
, success : D.Deconstructor (msg -> msg) msg
|
||||
}
|
||||
-> Cmd msg
|
||||
scry args =
|
||||
scryTask args |> Task.perform identity
|
||||
|
||||
|
||||
scryTask :
|
||||
{ url : String
|
||||
, agent : Agent
|
||||
, path : Path
|
||||
, error : msg
|
||||
, success : D.Deconstructor (msg -> msg) msg
|
||||
}
|
||||
-> Task a msg
|
||||
scryTask { url, agent, path, error, success } =
|
||||
Http.riskyTask
|
||||
{ method = "GET"
|
||||
, headers = []
|
||||
, url = url ++ "/~/scry/" ++ agent ++ "/" ++ String.join "/" path ++ ".jam"
|
||||
, body = Http.emptyBody
|
||||
, resolver =
|
||||
Http.bytesResolver
|
||||
(\resp ->
|
||||
case resp of
|
||||
Http.GoodStatus_ _ bytes ->
|
||||
case D.runBytes success bytes of
|
||||
Just msg ->
|
||||
Ok msg
|
||||
|
||||
Nothing ->
|
||||
Ok error
|
||||
|
||||
_ ->
|
||||
Ok error
|
||||
)
|
||||
, timeout = Nothing
|
||||
}
|
||||
|
||||
|
||||
toNoun : EventId -> UrbitRequest -> Noun
|
||||
toNoun eventId req =
|
||||
case req of
|
||||
|
@ -3,9 +3,12 @@ module Ur.Run exposing (Model, application)
|
||||
import Browser exposing (Document, UrlRequest)
|
||||
import Browser.Navigation as Nav
|
||||
import Dict exposing (Dict)
|
||||
import Either exposing (Either(..))
|
||||
import Html
|
||||
import Json.Decode as JD
|
||||
import Task
|
||||
import Ur.Cmd
|
||||
import Ur.Cmd.Internal
|
||||
import Ur.Constructor as C
|
||||
import Ur.Deconstructor as D
|
||||
import Ur.Requests exposing (..)
|
||||
@ -16,7 +19,7 @@ import Url exposing (Url)
|
||||
|
||||
type alias SubDict msg =
|
||||
Dict
|
||||
-- (ship, app, path)
|
||||
-- (ship, agent, path)
|
||||
( String, String, List String )
|
||||
{ deconstructor : D.Deconstructor (msg -> msg) msg
|
||||
, number : Int
|
||||
@ -48,9 +51,9 @@ type Msg msg
|
||||
|
||||
|
||||
application :
|
||||
{ init : Url -> Nav.Key -> ( model, Cmd msg )
|
||||
{ init : Url -> Nav.Key -> ( model, Ur.Cmd.Cmd msg )
|
||||
, view : model -> Document msg
|
||||
, update : msg -> model -> ( model, Cmd msg )
|
||||
, update : msg -> model -> ( model, Ur.Cmd.Cmd msg )
|
||||
, subscriptions : model -> Sub msg
|
||||
, urbitSubscriptions : model -> Ur.Sub.Sub msg
|
||||
, onUrlRequest : UrlRequest -> msg
|
||||
@ -71,16 +74,31 @@ application inp =
|
||||
let
|
||||
( app, appCmds ) =
|
||||
init u key
|
||||
|
||||
( eventId, cmds, urReqs ) =
|
||||
processCmd 0 appCmds
|
||||
|
||||
url =
|
||||
inp.urbitUrl app ++ "/~/channel/" ++ flags.uid
|
||||
in
|
||||
( { subscriptions = Dict.empty
|
||||
, subscriptionIntMapping = Dict.empty
|
||||
, app = app
|
||||
, connected = False
|
||||
, eventId = 0
|
||||
, eventId = eventId
|
||||
, flags = flags
|
||||
, requestsToRetry = []
|
||||
}
|
||||
, [ Cmd.map AppMsg appCmds, pureCmd NeedsActivation ] |> Cmd.batch
|
||||
, [ cmds
|
||||
, pureCmd NeedsActivation
|
||||
, send
|
||||
{ requests = urReqs
|
||||
, url = url
|
||||
, error = Noop
|
||||
, success = Noop
|
||||
}
|
||||
]
|
||||
|> Cmd.batch
|
||||
)
|
||||
, view =
|
||||
\model ->
|
||||
@ -100,7 +118,7 @@ application inp =
|
||||
|
||||
update :
|
||||
{ r
|
||||
| update : msg -> app -> ( app, Cmd msg )
|
||||
| update : msg -> app -> ( app, Ur.Cmd.Cmd msg )
|
||||
, createEventSource : String -> Cmd (Msg msg)
|
||||
, urbitUrl : app -> String
|
||||
, urbitSubscriptions : app -> Ur.Sub.Sub msg
|
||||
@ -119,6 +137,9 @@ update inp msg model =
|
||||
( appModel, appCmds ) =
|
||||
inp.update msg_ model.app
|
||||
|
||||
( eventId, cmds, urReqs ) =
|
||||
processCmd model.eventId appCmds
|
||||
|
||||
urbitSubs_ =
|
||||
inp.urbitSubscriptions model.app |> (\(Ur.Sub.Sub x) -> x)
|
||||
|
||||
@ -126,7 +147,7 @@ update inp msg model =
|
||||
urbitSubs_
|
||||
|> Dict.map (\_ deconstructor -> { deconstructor = deconstructor })
|
||||
|
||||
( eventId, newSubscriptionActions ) =
|
||||
( eventId_, newSubscriptionActions ) =
|
||||
Dict.diff urbitSubs model.subscriptions
|
||||
|> Dict.toList
|
||||
|> List.map (\( address, _ ) -> ( Subscribe address, address ))
|
||||
@ -135,11 +156,11 @@ update inp msg model =
|
||||
removedSubscriptions =
|
||||
Dict.diff model.subscriptions urbitSubs
|
||||
|
||||
( eventId_, removedSubscriptionActions ) =
|
||||
( eventId__, removedSubscriptionActions ) =
|
||||
removedSubscriptions
|
||||
|> Dict.toList
|
||||
|> List.map (\( _, { number } ) -> Unsubscribe number)
|
||||
|> tag eventId
|
||||
|> tag eventId_
|
||||
|
||||
keyToNumber =
|
||||
newSubscriptionActions |> List.map (\( a, ( _, b ) ) -> ( b, a )) |> Dict.fromList
|
||||
@ -160,7 +181,7 @@ update inp msg model =
|
||||
in
|
||||
( { model
|
||||
| app = appModel
|
||||
, eventId = eventId_
|
||||
, eventId = eventId__
|
||||
, subscriptions =
|
||||
Dict.diff model.subscriptions removedSubscriptions
|
||||
|> Dict.union newSubscriptions
|
||||
@ -174,7 +195,13 @@ update inp msg model =
|
||||
)
|
||||
}
|
||||
, Cmd.batch
|
||||
[ appCmds |> Cmd.map AppMsg
|
||||
[ cmds
|
||||
, Ur.Requests.send
|
||||
{ url = url
|
||||
, error = Noop
|
||||
, success = Noop
|
||||
, requests = urReqs
|
||||
}
|
||||
, let
|
||||
requests =
|
||||
removedSubscriptionActions
|
||||
@ -226,10 +253,11 @@ update inp msg model =
|
||||
|
||||
"fact" ->
|
||||
case
|
||||
Dict.get messageId model.subscriptionIntMapping |> Maybe.andThen (\key -> Dict.get key model.subscriptions)
|
||||
Dict.get messageId model.subscriptionIntMapping
|
||||
|> Maybe.andThen (\key -> Dict.get key model.subscriptions)
|
||||
of
|
||||
Just { deconstructor } ->
|
||||
case D.run (D.cell D.tar deconstructor |> D.map (\_ subMsg -> subMsg)) rest of
|
||||
case D.run (D.cell D.ignore (D.cell D.ignore deconstructor)) rest of
|
||||
Just subMsg ->
|
||||
( model_, pureCmd (AppMsg subMsg) )
|
||||
|
||||
@ -277,6 +305,28 @@ update inp msg model =
|
||||
( { model | connected = True }, inp.createEventSource url )
|
||||
|
||||
|
||||
processCmd : EventId -> Ur.Cmd.Cmd msg -> ( EventId, Cmd (Msg msg), List ( EventId, UrbitRequest ) )
|
||||
processCmd eventId urCmds =
|
||||
let
|
||||
( cmds, reqs ) =
|
||||
urCmds
|
||||
|> List.map
|
||||
(\x ->
|
||||
case x of
|
||||
Ur.Cmd.Internal.Cmd cmd ->
|
||||
cmd |> Cmd.map AppMsg |> Left
|
||||
|
||||
Ur.Cmd.Internal.Poke p ->
|
||||
Ur.Requests.Poke p |> Right
|
||||
)
|
||||
|> Either.partition
|
||||
|
||||
( newEventId, urReqs ) =
|
||||
reqs |> tag eventId
|
||||
in
|
||||
( newEventId, Cmd.batch cmds, urReqs )
|
||||
|
||||
|
||||
pureCmd : msg -> Cmd msg
|
||||
pureCmd msg =
|
||||
Task.succeed msg |> Task.perform identity
|
||||
|
Loading…
Reference in New Issue
Block a user