Skip to content

Instantly share code, notes, and snippets.

@eriklott
Last active February 19, 2019 10:12
Show Gist options
  • Star 8 You must be signed in to star a gist
  • Fork 2 You must be signed in to fork a gist
  • Save eriklott/812a63be9d9cfd6a949cccaa94e6790c to your computer and use it in GitHub Desktop.
Save eriklott/812a63be9d9cfd6a949cccaa94e6790c to your computer and use it in GitHub Desktop.
Elm Backend Client
module YourAPIClient exposing (Config, otherFunctions)
import Http
import Json.Decode as Decode
import Json.Encode as Encode
-- Config
{-| represents the client configuration
-}
type Config
= Config
{ backend : String
, session : Maybe String
}
{-| returns a client configuration
-}
config : { backend : String, session : Maybe String } -> Config
config params =
Config params
{-| sets configuration session id
-}
startSession : String -> Config -> Config
startSession session (Config config) =
Config { config | session = Just session }
{-| clears configuration session id
-}
clearSession : Config -> Config
clearSession (Config config) =
Config { config | session = Nothing }
{-| returns true if session id is set
-}
hasSession : Config -> Bool
hasSession (Config config) =
config.session /= Nothing
-- REQUESTS
getApples : Config -> Http.Request (List Apple)
getApples config =
request config
{ method = "get"
, path = "/apples"
, query = []
, body = Http.emptyBody
, decoder = applesDecoder
}
... more requests
-- TYPES
type alias Apple =
{ color : String }
-- DECODERS
appleDecoder : Decode.Decoder Apple
appleDecoder =
Decode.succeed Apple
|: (Decode.field "color" Decode.string)
-- REQUEST HELPER
request :
Config
-> { method : String
, path : String
, query : List ( String, String )
, body : Http.Body
, decoder : Decode.Decoder a
}
-> Http.Request a
request (Config config) { method, path, query, body, decoder } =
... get the session token from the config and, if it is present, add it to the
http request headers...
module Evt exposing (Evt, evt, none, toMaybe, map, update)
type Evt a
= Evt
{ value : Maybe a
}
evt : a -> Evt a
evt val =
Evt { value = Just val }
none : Evt a
none =
Evt { value = Nothing }
toMaybe : Evt a -> Maybe a
toMaybe (Evt evt) =
evt.value
map : (a -> b) -> Evt a -> Evt b
map fn (Evt evt) =
case evt.value of
Just a ->
Evt { value = Just (fn a) }
Nothing ->
Evt { value = Nothing }
update : (msg -> model -> ( model, Evt msg, Cmd msg )) -> msg -> model -> ( model, Cmd msg )
update standardUpdate msg model =
let
( model2, evt, cmd ) =
standardUpdate msg model
( model3, cmd2 ) =
case toMaybe evt of
Just msg2 ->
update standardUpdate msg2 model2
Nothing ->
( model2, Cmd.none )
cmd3 =
Cmd.batch [ cmd, cmd2 ]
in
( model3, cmd3 )
module Main exposing (..)
import Evt exposing (Evt)
import Html exposing (..)
import Http
import Navigation exposing (Location)
import Client
import Route exposing (Route)
import Routing
import Session
import Task
-- TYPES
type Page
= Loading
| Loaded Routing.PageModel
| Failure Http.Error
| NotFound
type alias Model =
{ clientConfig : Client.Config
, page : Page
}
init : Flags -> Maybe Route -> ( Model, Cmd Msg )
init flags route =
( { clientConfig = Client.config { backend = flags.backend, session = Nothing }
, page = Loading
}
, Session.get
|> Task.andThen (\session -> Task.succeed ( route, session ))
|> Task.perform Initialized
)
-- UPDATE
type Msg
= NoOp
| Initialized ( Maybe Route, Maybe String )
| RouteTo (Maybe Route)
| PageLoaded (Result Http.Error Routing.PageModel)
| SignedIn String
| SignedOut
| RoutingPageMsg Routing.PageMsg
update : Msg -> Model -> ( Model, Evt Msg, Cmd Msg )
update msg model =
case msg of
NoOp ->
( model, Evt.none, Cmd.none )
Initialized ( route, sessionID ) ->
( sessionID
|> Maybe.map (\sid -> { model | clientConfig = Client.startSession sid model.clientConfig })
|> Maybe.withDefault model
, Evt.evt (RouteTo route)
, Cmd.none
)
RouteTo (Just route) ->
let
hasSession =
Client.hasSession model.clientConfig
routeRequiresSession =
Route.isSecure route
loadCmd =
if hasSession == routeRequiresSession then
Task.attempt PageLoaded <| Routing.load model.clientConfig route
else if hasSession then
Route.redirectTo Route.secureEntry
else
Route.redirectTo Route.nonSecureEntry
in
( model, Evt.none, loadCmd )
RouteTo Nothing ->
( { model | page = NotFound }, Evt.none, Cmd.none )
PageLoaded (Ok pageModel) ->
( { model | page = Loaded pageModel }, Evt.none, Cmd.none )
PageLoaded (Err err) ->
case Debug.log "page load error: " err of
Http.BadStatus resp ->
if resp.status.code == 401 then
update SignedOut model
else
( { model | page = Failure err }, Evt.none, Cmd.none )
_ ->
( { model | page = Failure err }, Evt.none, Cmd.none )
SignedIn session ->
( { model | clientConfig = Client.startSession session model.clientConfig }
, Evt.none
, Cmd.batch
[ Task.perform (always NoOp) (Session.set session)
, Route.redirectTo Route.secureEntry
]
)
SignedOut ->
( { model | clientConfig = Client.clearSession model.clientConfig }
, Evt.none
, Cmd.batch
[ Task.perform (always NoOp) Session.clear
, Route.redirectTo Route.nonSecureEntry
]
)
RoutingPageMsg pgmsg ->
case model.page of
Loaded pgmod ->
let
( pgmodnew, pgevt, pgcmd ) =
Routing.update model.clientConfig (Evt.evt << SignedIn) pgmsg pgmod
in
( { model | page = Loaded pgmodnew }, pgevt, Cmd.map RoutingPageMsg pgcmd )
_ ->
( model, Evt.none, Cmd.none )
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
case model.page of
Loaded pgmod ->
Sub.map RoutingPageMsg <| Routing.subscriptions pgmod
_ ->
Sub.none
-- VIEW
view : Model -> Html Msg
view model =
case model.page of
Loading ->
text "loading"
Loaded pageModel ->
Routing.view pageModel
{ toMsg = RoutingPageMsg
, onSignOut = SignedOut
}
Failure err ->
text "failure"
NotFound ->
text "not found"
-- MAIN
type alias Flags =
{ backend : String
}
main : Program Flags Model Msg
main =
Navigation.programWithFlags (RouteTo << Route.route)
{ init = (\flags loc -> init flags (Route.route loc))
, update = Evt.update update
, view = view
, subscriptions = subscriptions
}
module Page.Apples exposing (Model, Msg, load, update, subscriptions, view)
import Component.UserHeader as UserHeader
import Html exposing (..)
import Html.Attributes exposing (..)
import Http
import Client
import Route
import Task exposing (Task)
-- MODEL
type Model
= Model
{ user : Client.User
, apples : List Client.Apple
}
initialModel : Client.User -> List Client.Apple -> Model
initialModel user apples =
Model
{ user = user
, apples = apples
}
load : Client.Config -> Task Http.Error Model
load client =
Task.map2 initialModel
(Http.toTask <| Client.me client)
(Http.toTask <| Client.getApples client)
-- UPDATE
type Msg
= DoSomething
update : Msg -> Model -> ( Model, Cmd Msg )
update msg (Model model) =
case msg of
DoSomething ->
(Model model, Cmd.none)
-- VIEW
view : Model -> { toMsg : Msg -> msg, onSignOut : msg } -> Html msg
view (Model model) { toMsg, onSignOut } =
div []
[ UserHeader.view
{ onSignOut = onSignOut
, user = model.user
}
, Html.map toMsg <| applesView (Model model)
]
applesView : List Client.Apple -> Html Msg
applesView apples =
div []
[ h1 [] [ text "Choose apple" ]
, div [] (List.map appleView apples)
]
appleView : Client.Apple -> Html Msg
appleView apple =
a [ href (Route.path (Route.Navigation apple.color)) ] [ text apple.color ]
module Route exposing (..)
import Navigation exposing (Location)
import UrlParser exposing ((</>), s, int, string, parseHash, oneOf, map, top)
type Route
= SignIn
| Apples
| Apple String
redirectTo : Route -> Cmd msg
redirectTo r =
Navigation.newUrl (path r)
route : Location -> Maybe Route
route =
parseHash <|
oneOf
[ map SignIn (s "signin")
, map Apples top
, map Apple (s "apples" </> string ")
]
path : Route -> String
path r =
"#/"
++ case r of
SignIn ->
"signin"
Apples ->
""
Apple color ->
"apples/" ++ color
isSecure : Route -> Bool
isSecure route =
case route of
SignIn ->
False
_ ->
True
nonSecureEntry : Route
nonSecureEntry =
SignIn
secureEntry : Route
secureEntry =
Apples
module Routing exposing (PageModel, PageMsg, load, update, subscriptions, view)
import Evt exposing (Evt)
import Html exposing (..)
import Http
import Client
import Page.SignIn
import Page.Apples
import Page.Apple
import Route exposing (Route)
import Task exposing (Task)
type PageModel
= SignInModel Page.SignIn.Model
| ApplesModel Page.Apples.Model
| AppleModel Page.Apple.Model
type PageMsg
= SignInMsg Page.SignIn.Msg
| ApplesMsg Page.Apples.Msg
| AppleMsg Page.Apple.Msg
load : Client.Config -> Route -> Task Http.Error PageModel
load client route =
case route of
Route.SignIn ->
Task.map SignInModel <| Page.SignIn.load client
Route.Apples ->
Task.map ApplesModel <| Page.Apples.load client
Route.Apple color ->
Task.map AppleModel <| Page.Apple.load client color
_ ->
Task.fail Http.NetworkError -- handle your page load failures in some application specific way
update : Client.Config -> (String -> Evt msg) -> PageMsg -> PageModel -> ( PageModel, Evt msg, Cmd PageMsg )
update client onSignIn msg model =
case ( msg, model ) of
( SignInMsg pgmsg, SignInModel pgmod ) ->
let
( pgmod_, evt, pgcmd ) =
Page.SignIn.update nconf onSignIn pgmsg pgmod
in
( SignInModel pgmod_, evt, Cmd.map SignInMsg pgcmd )
( ApplesMsg pgmsg, ApplesModel pgmod ) ->
let
( pgmod_, pgcmd ) =
Page.Apples.update pgmsg pgmod
in
( ApplesModel pgmod_, Evt.none, Cmd.map ApplesMsg pgcmd )
( AppleMsg pgmsg, AppleModel pgmod ) ->
let
( pgmod_, pgcmd ) =
Page.Apple.update pgmsg pgmod
in
( AppleModel pgmod_, Evt.none, Cmd.map AppleMsg pgcmd )
_ ->
( model, Evt.none, Cmd.none )
subscriptions : PageModel -> Sub PageMsg
subscriptions model =
case model of
ApplesModel model_ ->
Sub.map ApplesMsg <| Page.Apples.subscriptions model_
_ ->
Sub.none
view : PageModel -> { toMsg : PageMsg -> msg, onSignOut : msg } -> Html msg
view model { toMsg, onSignOut } =
case model of
SignInModel pgmod ->
Html.map (toMsg << SignInMsg) <| Page.SignIn.view pgmod
ApplesModel pgmod ->
Page.Apples.view pgmod
{ toMsg = toMsg << ApplesMsg
, onSignOut = onSignOut
}
AppleModel pgmod ->
Page.Apple.view pgmod
{ toMsg = toMsg << AppleMsg
, onSignOut = onSignOut
}
@wpiekutowski
Copy link

Thanks for sharing this sample! May I ask what is Evt module? Is it a package or something custom?

@eriklott
Copy link
Author

The Evt module is custom (https://gist.github.com/eriklott/812a63be9d9cfd6a949cccaa94e6790c#file-evt-elm). It's how we facilitate simple Child to Parent communication in our SPAs, between the "Page" level and root level (architecturally speaking) of our application. For example, we generally keep the authentication state (is the current user logged in or logged out) in the root level of the application. When a change of authentication state occurs inside of a page, that fact needs to be delivered to the root level, so the authentication state can be changed. We would use an Evt to transmit that message down to the root from the page.

In essence, Msgs travel from the root down to the pages, and Evts travel upwards from the pages to the root. If you look above, you can see a page returning an Evt:
https://gist.github.com/eriklott/812a63be9d9cfd6a949cccaa94e6790c#file-routing-elm-L51

If this is important to you, I can write a thorough explanation on elm-discuss.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment