How to batch multiple http calls together? - elm

I have a report which I'm using as a basis to perform a number of Http calls to get details for each row.
LoadReport ->
( model
, Http.toTask (loadReport model.token model.page)
|> Task.andThen
(\report ->
Task.map (addProductDetailsResultsToReport report) (Task.sequence (prepareRequests model.token report))
)
|> Task.map filterOnlyMissingBarcodes
|> Task.attempt ProductData
)
The calls are sequenced and perform one after another which is very slow as I need to perform 20 calls in a row. I would like to do something analogues to JavaScript
Promise.all(prepareRequests)
I used to have them being processed using Cmd.Batch but then I couldn't find a way to know when the whole batch is finished loading, I need to load another batch if there are not enough rows on the screen.

I believe the solution already posted by Murph is correct. The following code is an example that demonstrates that solution by first getting a collection of photos from flickr and then getting captions for all those photos by batching a bunch of http get tasks. Two lists are maintained in the model - untitled photos and titled photos. As the responses to the http gets come in, the appropriate photo is added to titled photos with the title assigned.
In this example the code can tell that all the gets have been responded to when the length of the titled list is the same as the length of the untitled list but it could just as easily have been done by removing photos from the untitled list until it is empty.
Here's a working demo
module Main exposing (..)
import Browser
import Html exposing (Html, div, text)
import Html.Attributes as HA
import Http
import Json.Decode as DC
import Svg
import Svg.Attributes as SA
import Task
type Msg
= SetPhotos (Result Http.Error (List Photo))
| SetDescription (Result Http.Error ( String, String ))
main : Program () Model Msg
main =
Browser.element
{ init = init
, view = view
, update = update
, subscriptions = \m -> Sub.none
}
type alias Model =
Result Http.Error
{ untitled : List Photo
, titled : List Photo
}
decodeUser : DC.Decoder String
decodeUser =
DC.at [ "user", "id" ] DC.string
type alias Photo =
{ id : String
, secret : String
, server : String
, farm : Int
, description : Maybe String
}
-- Create a Photo record from info retrieved from flickr api.
-- Get description later
initPhoto : String -> String -> String -> Int -> Photo
initPhoto id sec ser farm =
Photo id sec ser farm Nothing
decodePhotoList : DC.Decoder (List Photo)
decodePhotoList =
DC.list <|
DC.map4 initPhoto
(DC.at [ "id" ] DC.string)
(DC.at [ "secret" ] DC.string)
(DC.at [ "server" ] DC.string)
(DC.at [ "farm" ] DC.int)
-- Decode photos from "flickr.people.getPublicPhotos" request.
decodePhotos : DC.Decoder (List Photo)
decodePhotos =
DC.at [ "photos", "photo" ] decodePhotoList
-- Decode descripion of photo from "flickr.photos.getInfo" request.
decodePhotoDescription : DC.Decoder String
decodePhotoDescription =
DC.at [ "photo", "description", "_content" ] DC.string
-- api key from flickr. Anyone who clones this project should
-- get their own api key.
apiKey : String
apiKey =
"e9d3fdd5c2e26f9ebd13f4983cf727db"
flickrRestServices : String
flickrRestServices =
"https://api.flickr.com/services/rest/?"
noJsonCallback : String
noJsonCallback =
"&format=json&nojsoncallback=1"
userUrl : String -> String
userUrl name =
flickrRestServices
++ "&method=flickr.people.findByUserName"
++ "&api_key="
++ apiKey
++ "&username="
++ name
++ noJsonCallback
publicPhotosUrl : String -> String
publicPhotosUrl uid =
flickrRestServices
++ "&method=flickr.people.getPublicPhotos"
++ "&api_key="
++ apiKey
++ "&user_id="
++ uid
++ noJsonCallback
photoInfoUrl : String -> String
photoInfoUrl photo =
flickrRestServices
++ "&method=flickr.photos.getInfo"
++ "&api_key="
++ apiKey
++ "&photo_id="
++ photo
++ noJsonCallback
-- Cmd to get photo description from flickr.
-- Package results as SetDescription message.
-- Save the photo id with Task.map to apply the description to the right photo
setDescriptionCmd : Photo -> Cmd Msg
setDescriptionCmd dp =
case dp.description of
Nothing ->
Task.attempt SetDescription (Task.map (\s -> ( dp.id, s )) <| Http.toTask <| Http.get (photoInfoUrl dp.id) decodePhotoDescription)
Just des ->
Cmd.none
-- Cmd to get users public photos from flickr.
-- Package results as SetPhotos message.
getPhotosCmd : String -> Cmd Msg
getPhotosCmd name =
let
req =
Http.get (userUrl name) decodeUser
userTask =
Http.toTask req
publicPhotosTask uid =
Http.toTask (Http.get (publicPhotosUrl uid) decodePhotos)
userPhotosTask =
userTask |> Task.andThen publicPhotosTask
in
Task.attempt SetPhotos userPhotosTask
init : () -> ( Model, Cmd Msg )
init _ =
( Ok
{ untitled = []
, titled = []
}
, getPhotosCmd "elmDemo" -- flickr user name
)
-- UPDATE
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
SetPhotos (Ok photos) ->
( Ok
{ untitled = photos
, titled = []
}
, Cmd.batch <| List.map setDescriptionCmd photos
)
SetPhotos (Err e) ->
( Err e
, Cmd.none
)
-- Update description of the photo with matching id.
SetDescription (Ok ( photoId, desc )) ->
case model of
Ok photos ->
let
justTitled =
photos.untitled
|> List.filter (\ph -> ph.id == photoId)
|> List.map (\ph -> { ph | description = Just desc })
newTitled = photos.titled ++ justTitled
newPhotos = { photos | titled = newTitled }
in
( Ok newPhotos
, if
List.length newPhotos.titled
== List.length newPhotos.untitled
then
Cmd.none -- Could do something else here.
else
Cmd.none
)
Err e ->
( Err e
, Cmd.none
)
SetDescription (Err e) ->
( Err e
, Cmd.none
)
-- Compute a photo URL from a Photo record.
-- per: https://www.flickr.com/services/api/misc.urls.html
photoUrl : Photo -> String
photoUrl ps =
"https://farm"
++ String.fromInt ps.farm
++ ".staticflickr.com/"
++ ps.server
++ "/"
++ ps.id
++ "_"
++ ps.secret
++ "_b.jpg"
-- show an image and description if available.
viewPhoto : Photo -> Html Msg
viewPhoto ps =
div
[ HA.style "height" "20%"
, HA.style "width" "20%"
, HA.style "margin" "0"
]
[ div
[ HA.style "height" "90%"
, HA.style "width" "100%"
, HA.style "margin" "0"
]
[ Svg.svg
[ SA.version "1.1"
, SA.width "100%"
, SA.height "100%"
, SA.viewBox "-1 -0.6 2 1.2"
, SA.preserveAspectRatio "none"
]
[ Svg.image
[ SA.xlinkHref (photoUrl ps)
, SA.x "-1"
, SA.y "-0.6"
, SA.width "2"
, SA.height "1.2"
]
[]
]
]
, div
[ HA.style "height" "10%"
, HA.style "width" "100%"
, HA.style "margin" "0"
]
[ div
[ HA.style "text-align" "center" ]
[ text <| Maybe.withDefault "" ps.description ]
]
]
-- Draw an image or display the reason the image is not available.
view : Model -> Html Msg
view model =
case model of
Err s ->
text "Error: "
Ok photos ->
div []
[ div [] [ text "UNTITLED" ]
, div [] (List.map viewPhoto photos.untitled)
, div [] [ text "TITLED" ]
, div [] (List.map viewPhoto photos.titled)
]

Random thought:
Given that you will get a response back for each call you can keep track of the calls received by creating a collection of expected responses before calling batch and then removing the appropriate item from the collection each time a response is received.
At the point at which that collection is empty you've received all the responses and can fire off the next batch.
There are any number of variations on this pattern that should achieve the desired result. (And probably other patterns that would work just as well.)

Related

Elm `update` is not executing the case statement when dropdown's value is changed

I am new to Elm. I am not able to call the update function once the dropdown value changes.
Scenario:
I have two dropdowns Grade and Environment. What I want is when Grade dropdown values change, the options of Environment dropdown will dependently change.
For example, if Grade dropdown value is 3 then the options of Environment should change to Imagine Math
gradeDropdown : String -> List String -> Html Msg
gradeDropdown grade grades =
let
buildOption =
gradeOption grade
in
select [ class "importWizard--gradeSelection", name "gradeSelection", onChange (UpdateStudent Grade) ]
(map buildOption grades)
gradeOption : String -> String -> Html Msg
gradeOption optSelectedVal temp =
let
optSelected =
temp == optSelectedVal
in
option [ value temp, selected optSelected ] [ text temp ]
environmentDropdown : Model -> String -> List String -> String -> Html Msg
environmentDropdown model learningEnvironment learningEnvironments selectedGrade =
let
buildOption =
environmentOption model learningEnvironment
blueprint_grades = ["PreKindergarten", "Kindergarten", "1"]
environmentDropdownOption =
if (selectedGrade == "" || (List.member selectedGrade blueprint_grades)) then
["Blueprint"]
else if (selectedGrade == "2") then
learningEnvironments
else
["Imagine Math"]
in
select [
class "importWizard--learningEnvironmentSelection"
, name "learningEnvironmentSelection"
, onChange (UpdateStudent LearningEnvironments)
]
(map buildOption environmentDropdownOption)
environmentOption : Model -> String -> String -> Html Msg
environmentOption model optSelectedVal temp =
let
optSelected =
temp == optSelectedVal
in
option [ value temp, selected optSelected ] [ text temp ]
And in Update
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags message model =
case message of
UpdateStudent updateType newValue ->
let
validate =
validateStudent flags validatableFieldsForScreen
in
case updateType of
LastName ->
( validate { model | lastName = newValue } <| Just LastNameField, Cmd.none )
FirstName ->
( validate { model | firstName = newValue } <| Just FirstNameField, Cmd.none )
Sin ->
( validate { model | sin = newValue } <| Just SinField, Cmd.none )
Grade ->
( validate { model | grade = newValue, selectedGrade = newValue } Nothing, Cmd.none )
LearningEnvironments ->
( validate { model | learningEnvironments = newValue } Nothing, Cmd.none )
View:
, td [ class wizardTableInput ] [ gradeDropdown model.grade flags.grades ]
, td [ class wizardTableInput ] [ environmentDropdown model model.learningEnvironments flags.learningEnvironments model.selectedGrade ]
In this code, the environment dropdown's value is changing, however the model's value is not updated. From what I understand, I can see is environment dropdown's id re-rendered, but it is not updating the model's value of learningEnvironments. This means it is not executing the update function matching LearningEnvironments.
select widgets where the options change is one of the use cases for Html.Keyed.node
Use a helper function like the one bellow:
keyedSelect : (String -> a) -> String -> List ( String, String ) -> Html a
keyedSelect message selectedValue kvs =
let
toOption ( k, v ) =
( k
, option
[ value k
, selected (k == selectedValue)
, disabled (k == "-1")
]
[ text v ]
)
in
Keyed.node "select"
[ class "form-control", onChange message ]
(List.map toOption kvs)
I usually have a "Please select Foo" first option with the value -1 if the user never selected any of the options. This is why the code checks for -1 and disables the option. You can remove the disabled attribute if you don't need it.

How access multiples objects in a list

I have this code in Elm-lang:
import Json.Decode exposing (..)
import Html exposing (..)
json = -- List that contains and will have many users
"""
[{\"ssn\":\"111.111.111-11\",\"name\":\"People Silva\",\"email\":\"people#eat.com\"}, {\"ssn\":\"000.000.000-00\",\"name\":\"Pet Silva\",\"email\":\"pet#eat.com\"}]
"""
type alias User =
{ name : String
, email: String
, ssn: String
}
userDecoder : Json.Decode.Decoder User
userDecoder =
Json.Decode.map3 User
(field "name" string)
(field "email" string)
(field "ssn" string)
userListDecoder : Json.Decode.Decoder (List User)
userListDecoder =
Json.Decode.list userDecoder
main =
let
decoded = (decodeString userListDecoder json)
in
case decoded of
Ok u ->
span [] [text (toString u)]
Err e ->
span [] [text (toString e)]
This code work very well, and output this(how expected):
[{ name = "People Silva", email = "people#eat.com", ssn = "111.111.111-11" },{ name = "Pet Silva", email = "pet#eat.com", ssn = "000.000.000-00" }]
And here begins my doubt, how get list of all users in list?(And also as a bonus, get the number of users in the list)
-- already tried, unsuccessfully
u[0].name
u[1].name
The users are in a List User value, so you can use the functions from the List package to access them.
If you want to get a list of user names from a list of users, you can call List.map .name users.
If you want to write the user names in their own divs, you can write it like this:
showUser : User -> Html msg
showUser user =
div [] [ text user.name ]
and call it from main like this:
main =
let
decoded = (decodeString userListDecoder json)
in
case decoded of
Ok users ->
div [] (List.map showUser users)
Err e ->
span [] [text (toString e)]
Obtaining the length of a list is just a matter of using the List.length function: List.length users

Elm - How Do I Detect Current Focus

How do you get the current focus in Elm? I know how to set focus with Elm, but I can't find any functionality to detect what currently has focus.
The elm-lang/dom package allows setting focus on an element given an ID but it does not allow you to fetch the currently focused element. It hints that you can use document.activeElement for this. To do that, you'll have to use ports.
Here is a contrived example. Let's say you have a Model that contains the currently selected id and a list of all ids of some textboxes we'll soon create.
type alias Model =
{ selected : Maybe String
, ids : List String
}
The Msgs we will use will be able to inquire about the focus as well as use the Dom library to set focus:
type Msg
= NoOp
| FetchFocused
| FocusedFetched (Maybe String)
| Focus (Maybe String)
For that, we will need two ports:
port focusedFetched : (Maybe String -> msg) -> Sub msg
port fetchFocused : () -> Cmd msg
The javascript calling these ports will report on the current document.activeElement:
var app = Elm.Main.fullscreen()
app.ports.fetchFocused.subscribe(function() {
var id = document.activeElement ? document.activeElement.id : null;
app.ports.focusedFetched.send(id);
});
The view displays the currently selected id, provides a list of buttons that will set the focus on one of the numbered textboxes below.
view : Model -> Html Msg
view model =
div []
[ div [] [ text ("Currently selected: " ++ toString model.selected) ]
, div [] (List.map viewButton model.ids)
, div [] (List.map viewInput model.ids)
]
viewButton : String -> Html Msg
viewButton id =
button [ onClick (Focus (Just id)) ] [ text id ]
viewInput : String -> Html Msg
viewInput idstr =
div [] [ input [ id idstr, placeholder idstr, onFocus FetchFocused ] [] ]
The update function ties it all together:
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
NoOp ->
model ! []
FetchFocused ->
model ! [ fetchFocused () ]
FocusedFetched selected ->
{ model | selected = selected } ! []
Focus (Just selected) ->
model ! [ Task.attempt (always NoOp) (Dom.focus selected), fetchFocused () ]
Focus Nothing ->
{ model | selected = Nothing } ! [ fetchFocused () ]
Here is a working example on ellie-app.com.

Elm: Conditional preventDefault (with contentEditable)

I'm trying to make a content editable tag that uses enter to update the model.
My code is below, and here is a version that you can play around with on Ellie.
The on "blur" attribute works and updates the model when you click away. But I want to get the same 'update' functionality when an enter is pressed.
view : Model -> Html Msg
view model =
let
attrs =
[ contenteditable True
--, on "blur" (Json.map UpdateTitle targetTextContent)
, onInput2 UpdateTitle
, onEnter EnterPressed
, id "title"
, class "title"
]
in
div []
[ h1 attrs [ text model.existing ]
, text "Click above to start editing. Blur to save the value. The aim is to capture an <enter> and interpret that as a blur, i.e. to save the value and blur the field"
, p [] [ text <| "(" ++ model.existing ++ ")" ]
]
targetTextContent : Json.Decoder String
targetTextContent =
Json.at [ "target", "textContent" ] Json.string
onInput2 : (String -> msg) -> Attribute msg
onInput2 msgCreator =
on "input" (Json.map msgCreator targetTextContent)
onEnter : (Bool -> msg) -> Attribute msg
onEnter enterMsg =
onWithOptions "keydown"
{ stopPropagation = False
, preventDefault = False
}
(keyCode
|> Json.andThen
(\ch ->
let
_ =
Debug.log "on Enter" ch
in
Json.succeed (enterMsg <| ch == 13)
)
)
This code seems to be updating the model ok, but the DOM is getting messed up. For example if I enter enter after "blast" I see this
I tried switching to Html.Keyed and using "keydown" but it did not make any difference or just created different issues.
Solved! The key point is the filter function that uses Json.Decode.fail so that only <enter> is subject to preventDefault. See https://github.com/elm-lang/virtual-dom/issues/18#issuecomment-273403774 for the idea.
view : Model -> Html Msg
view model =
let
attrs =
[ contenteditable True
, on "blur" (Json.map UpdateTitle targetTextContent)
, onEnter EnterPressed
, id "title"
, class "title"
]
in
div []
[ h1 attrs [ text model.existing ]
, text "Click above to start editing. Blur to save the value. The aim is to capture an <enter> and interpret that as a blur, i.e. to save the value and blur the field"
, p [] [ text <| "(" ++ model.existing ++ ")" ]
]
targetTextContent : Json.Decoder String
targetTextContent =
Json.at [ "target", "textContent" ] Json.string
onEnter : msg -> Attribute msg
onEnter msg =
let
options =
{ defaultOptions | preventDefault = True }
filterKey code =
if code == 13 then
Json.succeed msg
else
Json.fail "ignored input"
decoder =
Html.Events.keyCode
|> Json.andThen filterKey
in
onWithOptions "keydown" options decoder

Create a New Record in a List of data in Elm

I finished loading resources from an API in Elm, everything is fine... except for one litte problem : I don't know how to update or create a new record without persisting it.
I have a type Msg (I striped some code for this demo)
type Msg
= NoOp
| FetchSucceed (List User)
| FetchError Http.Error
| UpdateTitle String
| ...
update msg model =
case model of
NoOp ->
( model, Cmd.none )
FetchSucceed newModel =
( { model | users = newModel, isLoading = False }, Cmd.none )
FetchError _ =
( { model | isLoading = False }, Cmd.none )
UpdateTitle newTitle =
-- I don't know what to put here, the previous messages
-- have a list, and I Just want to add ONE model
view model =
div []
[ List.map displayRow model.users
, formCreateUser {title = "", username = "", email = ""}
]
formCreateUser user =
div []
[ input [ onInput UpdateTitle, placeholder "Title" ] []
, button [ onClick SaveUser ] [ text "Save" ]
]
I would love to be able to add a new model from this form (formCreateUser), but I keep getting this error :
The 3rd element has this type:
VirtualDom.Node Msg
But the 4th is:
Html Link -> Html (String -> Msg)
edit2: Add some context
If I understand your example snippets, you have a page that shows the list of existing user, and you want to have a "quick add" form that lets you create another user given only a title. I'll give a quick example of how to achieve this which should hopefully shed some light on the problems you've run into.
I'm assuming your User and Model look like this at present:
type alias Model =
{ users : List User
, isLoading : Bool
}
type alias User =
{ title : String
, username : String
, email : String
}
Since you have that quick add form, I don't think you want to append the new user until they hit Submit. With that notion in mind, let's update Model to store the pending new user title:
type alias Model =
{ users : List User
, isLoading : Bool
, newUserTitle : Maybe String
}
Now we can change your view function accordingly. Since we want to display the typed title in the textbox, let's change formCreateUser to this:
formCreateUser model =
div []
[ input [ onInput UpdateTitle, placeholder "Title", value (Maybe.withDefault "" model.newUserTitle) ] []
, button [ onClick SaveUser ] [ text "Save" ]
]
That means the calling code in view needs updating too:
view model =
div []
[ div [] (List.map displayRow model.users)
, formCreateUser model
]
Now we need to handle the UpdateTitle Msg to set the contents as they are typed:
UpdateTitle newTitle ->
( { model | newUserTitle = Just newTitle }, Cmd.none )
And now we can also handle the submit button. This is where you would create the new user and append it to the list of existing users:
SaveUser ->
case model.newUserTitle of
Nothing -> (model, Cmd.none)
Just title ->
( { model
| newUserTitle = Nothing
, users = model.users ++ [{ title = title, username = "", email = "" }]
}, Cmd.none)
If you wanted SaveUser to submit it to your API endpoint, you'd also return an appropriate Cmd, but that seems outside the scope of your question.
While this all isn't an ideal way to handle your situation, hopefully this explanation gives you more understanding of the building blocks needed for this type of thing. I've posted the full gist here which can be pasted and run in elm-lang.org/try.