Req msg with cache

elm-package.json

{
    "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"
}

Main.elm

module Main exposing (..)

import Html exposing (..)
import Html.App as App
import Html.Events exposing (onClick)
import Req exposing (..)
import Dict exposing (Dict)


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
    , cache : Dict String String
    }


init : ( Model, Cmd Msg )
init =
    { top = ChildModel "Top" "evancz"
    , bottom = ChildModel "Bottom" "rtfeldman"
    , cache = Dict.empty
    }
        ! []



-- UPDATE


type ChildMsg
    = RequestOrgs
    | RequestRepos
    | Update String


type Msg
    = Top ChildMsg
    | Bottom ChildMsg
    | UpdateCache String String Msg


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 )


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 model.cache UpdateCache (Req.map Top req) ]

        Bottom cMsg ->
            let
                ( bottom, req ) =
                    childUpdate cMsg model.bottom
            in
                { model | bottom = bottom } ! [ Req.toCmd model.cache UpdateCache (Req.map Bottom req) ]

        UpdateCache key value newMsg ->
            let
                newCache =
                    Dict.insert key value model.cache
            in
                update newMsg { model | cache = newCache }



-- 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

Req.elm

module Req exposing (..)

import Http
import Task
import Json.Decode exposing (Decoder, list, string, (:=))
import Dict exposing (Dict)


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


url : String
url =
    "https://api.github.com/users/"


toCmd : Dict String String -> (String -> String -> msg -> msg) -> Req msg -> Cmd msg
toCmd cache cacheUpdateMsg req =
    case req of
        None ->
            Cmd.none

        Req { success, fail, decoder, urlBit } ->
            let
                fullUrl =
                    (url ++ urlBit)

                cachedVersion =
                    Dict.get fullUrl cache

                cacheAndDispatch str =
                    cacheUpdateMsg fullUrl str (success str)
            in
                case cachedVersion of
                    Nothing ->
                        Http.get decoder fullUrl
                            |> Task.mapError toString
                            |> Task.perform fail cacheAndDispatch

                    Just str ->
                        Task.succeed str
                            |> Task.perform fail success