Skip to content

Instantly share code, notes, and snippets.

@pdamoc
Created May 31, 2016 18:33
Show Gist options
  • Star 4 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save pdamoc/a47090e69b75433efa60fe4f70e6a06a to your computer and use it in GitHub Desktop.
Save pdamoc/a47090e69b75433efa60fe4f70e6a06a to your computer and use it in GitHub Desktop.
Req msg instead of Cmd msg
{
"version": "1.0.0",
"summary": "helpful summary of your project, less than 80 characters",
"repository": "https://github.com/user/project.git",
"license": "BSD3",
"source-directories": [
"."
],
"exposed-modules": [],
"dependencies": {
"elm-lang/core": "4.0.1 <= v < 5.0.0",
"elm-lang/html": "1.0.0 <= v < 2.0.0",
"evancz/elm-http": "3.0.1 <= v < 4.0.0"
},
"elm-version": "0.17.0 <= v < 0.18.0"
}
module Main exposing (..)
import Html exposing (..)
import Html.App as App
import Html.Events exposing (onClick)
import Req exposing (..)
main : Program Never
main =
App.program
{ init = init
, update = update
, view = view
, subscriptions = subscriptions
}
-- MODEL
type alias ChildModel =
{ info : String
, user : String
}
type alias Model =
{ top : ChildModel
, bottom : ChildModel
}
init : ( Model, Cmd Msg )
init =
{ top = ChildModel "Top" "evancz"
, bottom = ChildModel "Bottom" "rtfeldman"
}
! []
-- UPDATE
type ChildMsg
= RequestOrgs
| RequestRepos
| Update String
type Msg
= Top ChildMsg
| Bottom ChildMsg
childUpdate : ChildMsg -> ChildModel -> ( ChildModel, Req ChildMsg )
childUpdate msg model =
case msg of
RequestOrgs ->
( model, Req.getOrgs model.user Update Update )
RequestRepos ->
( model, Req.getRepos model.user Update Update )
Update str ->
( { model | info = str }, Req.none )
url : String
url =
"https://api.github.com/users/"
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Top cMsg ->
let
( top, req ) =
childUpdate cMsg model.top
in
{ model | top = top } ! [ Req.toCmd url (Req.map Top req) ]
Bottom cMsg ->
let
( bottom, req ) =
childUpdate cMsg model.bottom
in
{ model | bottom = bottom } ! [ Req.toCmd url (Req.map Bottom req) ]
-- VIEW
viewChild : ChildModel -> Html ChildMsg
viewChild model =
div []
[ div [] [ text model.info ]
, button [ onClick RequestOrgs ] [ text ("Request Orgs for " ++ model.user) ]
, button [ onClick RequestRepos ] [ text ("Request Reposrtfeldman for " ++ model.user) ]
]
view : Model -> Html Msg
view model =
div []
[ App.map Top (viewChild model.top)
, App.map Bottom (viewChild model.bottom)
]
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.none
module Req exposing (..)
import Http
import Task
import Json.Decode exposing (Decoder, list, string, (:=))
getOrgs : String -> (String -> msg) -> (String -> msg) -> Req msg
getOrgs user fail success =
Req { fail = fail, success = success, decoder = orgsDecoder, urlBit = (user ++ "/orgs") }
getRepos : String -> (String -> msg) -> (String -> msg) -> Req msg
getRepos user fail success =
Req { fail = fail, success = success, decoder = reposDecoder, urlBit = (user ++ "/repos") }
none : Req msg
none =
None
type Req msg
= Req { success : String -> msg, fail : String -> msg, decoder : Decoder String, urlBit : String }
| None
map : (a -> msg) -> Req a -> Req msg
map f req =
case req of
None ->
None
Req aReq ->
Req { aReq | success = (aReq.success >> f), fail = (aReq.fail >> f) }
orgsDecoder : Decoder String
orgsDecoder =
list ("login" := string)
|> Json.Decode.map toString
reposDecoder : Decoder String
reposDecoder =
list ("name" := string)
|> Json.Decode.map toString
toCmd : String -> Req msg -> Cmd msg
toCmd url req =
case req of
None ->
Cmd.none
Req { success, fail, decoder, urlBit } ->
Http.get decoder (url ++ urlBit)
|> Task.mapError toString
|> Task.perform fail success
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment