diff --git a/.travis.yml b/.travis.yml index 6ef683a..2dd449c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -39,7 +39,7 @@ before_install: fi install: - - npm install -g elm@0.17.1 + - npm install -g elm@0.18.0 - npm install - mv $(npm config get prefix)/bin/elm-make $(npm config get prefix)/bin/elm-make-org - printf '%s\n\n' '#!/bin/bash' 'echo "Running elm-make with sysconfcpus -n 2"' '$TRAVIS_BUILD_DIR/sysconfcpus/bin/sysconfcpus -n 2 elm-make-org "$@"' > $(npm config get prefix)/bin/elm-make diff --git a/elm-package.json b/elm-package.json index 5829423..65b8449 100644 --- a/elm-package.json +++ b/elm-package.json @@ -8,17 +8,16 @@ ], "exposed-modules": [], "dependencies": { - "debois/elm-mdl": "7.6.0 <= v < 8.0.0", - "elm-community/result-extra": "2.0.0 <= v < 3.0.0", - "elm-lang/core": "4.0.5 <= v < 5.0.0", - "elm-lang/html": "1.1.0 <= v < 2.0.0", - "elm-lang/navigation": "1.0.0 <= v < 2.0.0", - "etaque/elm-simple-form": "4.0.0 <= v < 5.0.0", - "evancz/elm-http": "3.0.1 <= v < 4.0.0", - "evancz/url-parser": "1.0.0 <= v < 2.0.0", - "noahzgordon/elm-jsonapi": "2.0.2 <= v < 3.0.0", - "sporto/erl": "10.0.1 <= v < 11.0.0", - "sporto/hop": "6.0.0 <= v < 7.0.0" + "debois/elm-mdl": "8.1.0 <= v < 9.0.0", + "elm-community/result-extra": "2.2.0 <= v < 3.0.0", + "elm-lang/core": "5.1.1 <= v < 6.0.0", + "elm-lang/html": "2.0.0 <= v < 3.0.0", + "elm-lang/http": "1.0.0 <= v < 2.0.0", + "elm-lang/navigation": "2.1.0 <= v < 3.0.0", + "etaque/elm-form": "2.0.0 <= v < 3.0.0", + "evancz/url-parser": "2.0.1 <= v < 3.0.0", + "lukewestby/elm-http-builder": "5.1.0 <= v < 6.0.0", + "noahzgordon/elm-jsonapi": "2.2.1 <= v < 3.0.0" }, - "elm-version": "0.17.1 <= v < 0.18.0" + "elm-version": "0.18.0 <= v < 0.19.0" } diff --git a/src/Api.elm b/src/Api.elm index 67eb02d..b4b5292 100644 --- a/src/Api.elm +++ b/src/Api.elm @@ -12,7 +12,7 @@ module Api import Result.Extra import Http -import Task exposing (Task) +import HttpBuilder import Json.Decode as Decode import Json.Decode exposing (Decoder) import Json.Encode as Encode @@ -78,7 +78,6 @@ facebookAuthUrl = let facebookRedirectUri = Config.baseRoot - ++ Config.basePath ++ "/" ++ Config.facebookRedirectPath in @@ -160,7 +159,7 @@ type alias DecodedProposalAttributes = decodeProposalAttributes : Decoder DecodedProposalAttributes decodeProposalAttributes = - Decode.object5 DecodedProposalAttributes + Decode.map5 DecodedProposalAttributes (Decode.at [ "title" ] Decode.string) (Decode.at [ "body" ] Decode.string) (Decode.at [ "support-count" ] Decode.int) @@ -173,7 +172,7 @@ decodeParticipantAttributes = Decode.at [ "name" ] Decode.string -encodeProposalInput : NewProposal -> String +encodeProposalInput : NewProposal -> Encode.Value encodeProposalInput proposalInput = JsonApi.Extra.encodeDocument "proposal" @@ -184,7 +183,7 @@ encodeProposalInput proposalInput = [] -encodeSupportProposal : String -> String +encodeSupportProposal : String -> Encode.Value encodeSupportProposal id = JsonApi.Extra.encodeDocument "support" @@ -215,7 +214,7 @@ assembleSupport document = decodeProposalSupportAttributes : Decoder ( Int, Bool ) decodeProposalSupportAttributes = - Decode.object2 (,) + Decode.map2 (,) (Decode.at [ "support-count" ] Decode.int) (Decode.at [ "supported-by-me" ] Decode.bool) @@ -226,60 +225,69 @@ decodeProposalSupportAttributes = authenticate : String -> (Msg -> a) -> Cmd a authenticate authCode wrapMsg = - ("{\"auth_code\": \"" ++ authCode ++ "\"}") - |> Api.Util.requestPost tokenEndpoint - |> JsonApi.Extra.withHeader "Content-Type" "application/json" - |> Api.Util.sendDefJson decodeToken - |> Task.perform AuthFailed GotAccessToken + tokenEndpoint + |> HttpBuilder.post + |> HttpBuilder.withJsonBody + (Encode.object [ ( "auth_code", Encode.string authCode ) ]) + |> HttpBuilder.withExpect (Http.expectJson decodeToken) + |> HttpBuilder.toTask + |> Api.Util.attempt AuthFailed GotAccessToken |> Cmd.map wrapMsg getMe : String -> (Msg -> a) -> Cmd a getMe accessToken wrapMsg = meEndpoint - |> Api.Util.requestGet + |> HttpBuilder.get |> Api.Util.withAccessToken accessToken - |> Api.Util.sendDefJsonApi assembleMe - |> Task.perform AuthFailed GotMe + |> Api.Util.withExpectJsonApi assembleMe + |> HttpBuilder.toTask + |> Api.Util.attempt AuthFailed GotMe |> Cmd.map wrapMsg createProposal : NewProposal -> String -> (Msg -> a) -> Cmd a createProposal proposalInput accessToken wrapMsg = - encodeProposalInput proposalInput - |> Api.Util.requestPost newProposalEndpoint + newProposalEndpoint + |> HttpBuilder.post + |> Api.Util.withJsonApiBody (encodeProposalInput proposalInput) |> Api.Util.withAccessToken accessToken - |> Api.Util.sendDefJsonApi assembleProposal - |> Task.perform ProposalCreationFailed ProposalCreated + |> Api.Util.withExpectJsonApi assembleProposal + |> HttpBuilder.toTask + |> Api.Util.attempt ProposalCreationFailed ProposalCreated |> Cmd.map wrapMsg supportProposal : String -> Bool -> String -> (Msg -> a) -> Cmd a supportProposal id newState accessToken wrapMsg = -- ToDo: Send DELETE request to remove support (if newState == False) - encodeSupportProposal id - |> Api.Util.requestPost supportProposalEndpoint + supportProposalEndpoint + |> HttpBuilder.post + |> Api.Util.withJsonApiBody (encodeSupportProposal id) |> Api.Util.withAccessToken accessToken - |> Api.Util.sendDefJsonApi assembleSupport - |> Task.perform SupportProposalFailed ProposalSupported + |> Api.Util.withExpectJsonApi assembleSupport + |> HttpBuilder.toTask + |> Api.Util.attempt SupportProposalFailed ProposalSupported |> Cmd.map wrapMsg getProposal : String -> String -> (Msg -> a) -> Cmd a getProposal id accessToken wrapMsg = getProposalEndpoint id - |> Api.Util.requestGet + |> HttpBuilder.get |> Api.Util.withAccessToken accessToken - |> Api.Util.sendDefJsonApi assembleProposal - |> Task.perform GettingProposalFailed GotProposal + |> Api.Util.withExpectJsonApi assembleProposal + |> HttpBuilder.toTask + |> Api.Util.attempt GettingProposalFailed GotProposal |> Cmd.map wrapMsg getProposalList : String -> (Msg -> a) -> Cmd a getProposalList accessToken wrapMsg = getProposalListEndpoint - |> Api.Util.requestGet + |> HttpBuilder.get |> Api.Util.withAccessToken accessToken - |> Api.Util.sendDefJsonApi assembleProposalList - |> Task.perform GettingProposalListFailed GotProposalList + |> Api.Util.withExpectJsonApi assembleProposalList + |> HttpBuilder.toTask + |> Api.Util.attempt GettingProposalListFailed GotProposalList |> Cmd.map wrapMsg diff --git a/src/Api/Util.elm b/src/Api/Util.elm index b59f0b0..4759007 100644 --- a/src/Api/Util.elm +++ b/src/Api/Util.elm @@ -1,10 +1,13 @@ module Api.Util exposing (..) +import Result.Extra import Task exposing (Task) +import Json.Encode as Encode import Json.Decode as Decode import Http +import HttpBuilder import JsonApi -import JsonApi.Extra +import JsonApi.Decode {-| Infix notation for Result.andThen. Makes andThen-chains look nicer. @@ -12,57 +15,54 @@ import JsonApi.Extra infixl 0 :> (:>) : Result x a -> (a -> Result x b) -> Result x b (:>) = - Result.andThen + flip Result.andThen -{-| Insert accessToken into Http header +{-| Convenience version of `Task.attempt` that performs Tasks that may fail. +That's the same as in `elm-lang/core 4.x` (Elm 0.17) -} -withAccessToken : String -> Http.Request -> Http.Request -withAccessToken accessToken = - JsonApi.Extra.withHeader "Authorization" ("Bearer " ++ accessToken) +attempt : (e -> msg) -> (a -> msg) -> Task e a -> Cmd msg +attempt errorTagger successTagger task = + Task.attempt (Result.Extra.unpack errorTagger successTagger) task -{-| Build a GET request +{-| Insert accessToken into Http header -} -requestGet : String -> Http.Request -requestGet url = - { verb = "GET" - , headers = [] - , url = url - , body = Http.empty - } +withAccessToken : String -> HttpBuilder.RequestBuilder a -> HttpBuilder.RequestBuilder a +withAccessToken accessToken = + HttpBuilder.withHeader "Authorization" ("Bearer " ++ accessToken) -{-| Build a POST request +{-| Insert a JSON value as the body of a RequestBuilder. +This will set the `Content-Type: application/vnd.api+json` header, +as required by JSON API standard. -} -requestPost : String -> String -> Http.Request -requestPost url body = - { verb = "POST" - , headers = [] - , url = url - , body = Http.string body - } +withJsonApiBody : Encode.Value -> HttpBuilder.RequestBuilder a -> HttpBuilder.RequestBuilder a +withJsonApiBody jsonValue = + HttpBuilder.withBody <| + Http.stringBody "application/vnd.api+json" (Encode.encode 0 jsonValue) -{-| Send a Http request with default settings -and decode the response from a JSON API document +{-| Expect the response body to be a JsonApi Document. -} -sendDefJsonApi : +withExpectJsonApi : (JsonApi.Document -> Result String a) - -> Http.Request - -> Task Http.Error a -sendDefJsonApi assembleResponse request = - JsonApi.Extra.sendJsonApi assembleResponse Http.defaultSettings request - + -> HttpBuilder.RequestBuilder () + -> HttpBuilder.RequestBuilder a +withExpectJsonApi assembleResponse requestBuilder = + requestBuilder + |> HttpBuilder.withHeader "Accept" "application/vnd.api+json" + |> HttpBuilder.withExpect + (Http.expectJson + (JsonApi.Decode.document + |> Decode.andThen + (\document -> + case assembleResponse document of + Ok successValue -> + Decode.succeed successValue -{-| Send a Http request with default settings -and decode the response from JSON --} -sendDefJson : - Decode.Decoder a - -> Http.Request - -> Task Http.Error a -sendDefJson decodeResponse request = - request - |> Http.send Http.defaultSettings - |> Http.fromJson decodeResponse + Err errorMessage -> + Decode.fail errorMessage + ) + ) + ) diff --git a/src/Config_heroku.elm b/src/Config_heroku.elm index 92125ba..a715eca 100644 --- a/src/Config_heroku.elm +++ b/src/Config_heroku.elm @@ -1,21 +1,21 @@ module Config exposing (..) +baseRoot : String baseRoot = "https://participateapp.github.io" -basePath = - "" - - +facebookRedirectPath : String facebookRedirectPath = "facebook_redirect" +facebookClientId : String facebookClientId = "1583083548592686" +apiUrl : String apiUrl = "https://participate-api.herokuapp.com" diff --git a/src/Config_local.elm b/src/Config_local.elm index b5834b3..12abad3 100644 --- a/src/Config_local.elm +++ b/src/Config_local.elm @@ -1,24 +1,21 @@ module Config exposing (..) +baseRoot : String baseRoot = - -- "https://oliverbarnes.github.io" "http://localhost:3000" -basePath = - -- "/participate" - "" - - +facebookRedirectPath : String facebookRedirectPath = "facebook_redirect" +facebookClientId : String facebookClientId = "1583083701926004" +apiUrl : String apiUrl = - -- "https://participate-api.herokuapp.com" "http://localhost:4000" diff --git a/src/JsonApi/Extra.elm b/src/JsonApi/Extra.elm index 3ca3875..b57a58c 100644 --- a/src/JsonApi/Extra.elm +++ b/src/JsonApi/Extra.elm @@ -1,8 +1,6 @@ module JsonApi.Extra exposing - ( withHeader - , sendJsonApi - , ResourceLinkage + ( ResourceLinkage , resourceLinkage , resourceLinkageCollection , encodeDocument @@ -13,31 +11,6 @@ import Json.Encode as Encode import Task exposing (Task) import Http import JsonApi -import JsonApi.Decode - - -{-| Insert a header field into a Http request --} -withHeader : String -> String -> Http.Request -> Http.Request -withHeader field value request = - { request | headers = ( field, value ) :: request.headers } - - -{-| Send a Http request and decode the response from a JSON API document --} -sendJsonApi : - (JsonApi.Document -> Result String a) - -> Http.Settings - -> Http.Request - -> Task Http.Error a -sendJsonApi assembleResponse settings request = - Http.send settings - (request - |> withHeader "Content-Type" "application/vnd.api+json" - |> withHeader "Accept" "application/vnd.api+json" - ) - |> Http.fromJson - (Decode.customDecoder JsonApi.Decode.document assembleResponse) {-| Represents a resource linkage @@ -70,14 +43,14 @@ The resource is specified by: - a list of attributes - a list of relationships -Returns JSON as a string suitable for a POST or PATCH request. +Returns a JSON value suitable for a POST or PATCH request. -} encodeDocument : String -> Maybe String -> List ( String, Encode.Value ) -> List ( String, ResourceLinkage ) - -> String + -> Encode.Value encodeDocument resourceType optionalId attributes relationships = let encodedType : ( String, Encode.Value ) @@ -136,4 +109,3 @@ encodeDocument resourceType optionalId attributes relationships = ] ) ] - |> Encode.encode 0 diff --git a/src/Main.elm b/src/Main.elm index b989a8e..f01578d 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -1,7 +1,6 @@ port module Main exposing (main) import Html exposing (..) -import Html.App as App import Html.Events exposing (..) import Html.Attributes exposing (style, href, class, disabled, id) import Material @@ -26,17 +25,15 @@ import Form exposing (Form) import Form.Field import Form.Input import Form.Error -import Form.Validate exposing (Validation, form1, form2, get, string) +import Form.Validate exposing (Validation) import Dict exposing (Dict) import Set exposing (Set) import String -import Navigation -import UrlParser exposing (()) +import Navigation exposing (Location) +import UrlParser exposing ((), ()) import Http -import Hop -import Hop.Types exposing (Config, Address, Query) import Types exposing (..) -import Config exposing (basePath) +import Config import Api @@ -47,88 +44,32 @@ type Route = Home | NewProposalRoute | ProposalRoute String - | FacebookRedirect + | FacebookRedirect (Maybe String) | NotFoundRoute routes : UrlParser.Parser (Route -> a) a routes = UrlParser.oneOf - [ UrlParser.format Home (UrlParser.s "") - , UrlParser.format NewProposalRoute (UrlParser.s "new-proposal") - , UrlParser.format ProposalRoute (UrlParser.s "proposals" UrlParser.string) - , UrlParser.format FacebookRedirect (UrlParser.s "facebook_redirect") + [ UrlParser.map Home (UrlParser.top) + , UrlParser.map NewProposalRoute (UrlParser.s "new-proposal") + , UrlParser.map ProposalRoute (UrlParser.s "proposals" UrlParser.string) + , UrlParser.map FacebookRedirect + (UrlParser.s "facebook_redirect" UrlParser.stringParam "code") ] -hopConfig : Config -hopConfig = - { basePath = basePath - , hash = False - } - - -urlParser : Navigation.Parser ( Route, Address ) -urlParser = - let - parse path = - path - |> UrlParser.parse identity routes - |> Result.withDefault NotFoundRoute - - resolver = - Hop.makeResolver hopConfig parse - in - Navigation.makeParser (.href >> resolver) - - -urlUpdate : ( Route, Address ) -> Model -> ( Model, Cmd Msg ) -urlUpdate ( route, address ) model = - let - model1 = - { model | route = route, address = address } - - model1ps = - model1 |> progressStart - - _ = - Debug.log "urlUpdate" ( route, address ) - in - if String.isEmpty model.accessToken && route /= Home then - ( model1ps, Navigation.newUrl <| Hop.outputFromPath hopConfig "/" ) - else - case route of - ProposalRoute id -> - case Dict.get id model.proposals of - Nothing -> - ( model1ps - , Api.getProposal id model.accessToken ApiMsg - ) - - Just _ -> - ( model1, Cmd.none ) - - Home -> - ( model1ps - , Api.getProposalList model.accessToken ApiMsg - ) - - _ -> - ( model1, Cmd.none ) - +routeNeedsAccess : Route -> Bool +routeNeedsAccess route = + case route of + Home -> + False -checkForAuthCode : Address -> Cmd Msg -checkForAuthCode address = - let - authCode = - address.query |> Dict.get "code" - in - case authCode of - Just code -> - Api.authenticate code ApiMsg + FacebookRedirect _ -> + False - Nothing -> - Cmd.none + _ -> + True @@ -144,9 +85,7 @@ port storeAccessToken : Maybe String -> Cmd msg type alias Model = { route : Route - , address : Address , accessToken : String - , error : Maybe String , me : Me , form : Form () NewProposal , mdl : Material.Model @@ -156,12 +95,10 @@ type alias Model = } -initialModel : String -> Route -> Address -> Model -initialModel accessToken route address = - { route = route - , address = address +initialModel : String -> Model +initialModel accessToken = + { route = NotFoundRoute , accessToken = accessToken - , error = Nothing , me = { name = "" } , form = Form.initial [] validate , mdl = Material.model @@ -176,7 +113,8 @@ initialModel accessToken route address = type Msg - = ApiMsg Api.Msg + = UrlChange Location + | ApiMsg Api.Msg | NavigateToPath String | FormMsg Form.Msg | NoOp @@ -212,12 +150,31 @@ withSnackbarNote snackContent ( model, cmd ) = withHttpErrorResponse : String -> Http.Error -> ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) withHttpErrorResponse contextText httpError ( model, cmd ) = withSnackbarNote - (contextText ++ ": " ++ toString httpError) - ( { model | error = Just <| toString httpError } |> progressDone + (contextText ++ ": " ++ httpErrorToNoticeString httpError) + ( model |> progressDone , Cmd.none ) +httpErrorToNoticeString : Http.Error -> String +httpErrorToNoticeString httpError = + case httpError of + Http.BadStatus response -> + response.status.message ++ " (" ++ toString response.status.code ++ ")" + + Http.BadPayload description _ -> + "Bad payload (" ++ description ++ ")" + + Http.BadUrl description -> + "Bad URL (" ++ description ++ ")" + + Http.Timeout -> + "Timeout" + + Http.NetworkError -> + "Network Error" + + updateProposalSupport : Support -> Model -> Model updateProposalSupport support model = let @@ -249,6 +206,53 @@ progressDone model = update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of + UrlChange location -> + let + route = + UrlParser.parsePath routes location + |> Maybe.withDefault NotFoundRoute + + model1 = + { model | route = route } + + model1ps = + model1 |> progressStart + + _ = + Debug.log "UrlChange" ( route, location.href ) + in + if String.isEmpty model.accessToken && routeNeedsAccess route then + ( model1ps, Navigation.newUrl "/" ) + else + case route of + FacebookRedirect maybeCode -> + ( model1ps + , case maybeCode of + Just code -> + Api.authenticate code ApiMsg + + Nothing -> + Navigation.newUrl "/" + ) + + ProposalRoute id -> + case Dict.get id model.proposals of + Nothing -> + ( model1ps + , Api.getProposal id model.accessToken ApiMsg + ) + + Just _ -> + ( model1, Cmd.none ) + + Home -> + ( model1ps + , Api.getProposalList model.accessToken ApiMsg + ) + + _ -> + ( model1, Cmd.none ) + ApiMsg apiMsg -> case apiMsg of Api.GotAccessToken accessToken -> @@ -267,14 +271,13 @@ update msg model = Api.GotMe me -> ( { model | me = me } |> progressDone - , Navigation.newUrl <| Hop.outputFromPath hopConfig "/" + , Navigation.newUrl "/" ) Api.ProposalCreated proposal -> ( model |> addProposal proposal - , Navigation.newUrl <| - Hop.output hopConfig { path = [ "proposals", proposal.id ], query = Dict.empty } + , Navigation.newUrl ("/proposals/" ++ proposal.id) ) |> withSnackbarNote "Proposal saved" @@ -324,7 +327,7 @@ update msg model = NavigateToPath path -> ( model - , Navigation.newUrl <| Hop.outputFromPath hopConfig path + , Navigation.newUrl path ) FormMsg formMsg -> @@ -333,13 +336,13 @@ update msg model = model ! [ Api.createProposal proposalInput model.accessToken ApiMsg ] _ -> - ( { model | form = Form.update formMsg model.form }, Cmd.none ) + ( { model | form = Form.update validate formMsg model.form }, Cmd.none ) NoOp -> ( model, Cmd.none ) - Mdl msg' -> - Material.update msg' model + Mdl mdlMsg -> + Material.update Mdl mdlMsg model SnackbarMsg snackMsg -> -- Snackbar currently has no builtin elm-mdl-component support. @@ -362,16 +365,16 @@ update msg model = ( { model | accessToken = "" } , Cmd.batch [ storeAccessToken Nothing - , Navigation.newUrl <| Hop.outputFromPath hopConfig "/" + , Navigation.newUrl "/" ] ) validate : Validation () NewProposal validate = - form2 NewProposal - (get "title" string) - (get "body" string) + Form.Validate.map2 NewProposal + (Form.Validate.field "title" Form.Validate.string) + (Form.Validate.field "body" Form.Validate.string) @@ -417,7 +420,7 @@ viewHeader model = model.mdl [ Options.id "new-proposal" , Button.colored - , Button.onClick <| NavigateToPath "/new-proposal" + , Options.onClick <| NavigateToPath "/new-proposal" ] [ text "New proposal" ] ] @@ -430,7 +433,7 @@ viewLoginButton : Model -> Html Msg viewLoginButton model = a [ href Api.facebookAuthUrl ] [ img - [ Html.Attributes.src <| basePath ++ "/images/facebook-sign-in.png" + [ Html.Attributes.src "/images/facebook-sign-in.png" , class "login-button-img" ] [] @@ -493,11 +496,11 @@ viewMain model = div [] [ text <| "Not found" ] - FacebookRedirect -> + FacebookRedirect _ -> div [] [ text <| "Authenticating, please wait..." ] , viewFooter model - , Snackbar.view model.snackbar |> App.map SnackbarMsg + , Snackbar.view model.snackbar |> Html.map SnackbarMsg ] @@ -565,7 +568,7 @@ viewLandingPage model = "Ensured Representation" "Representation is ensured for participants who are less involved (be it for lack of time, inclination or of knowledge) through fluid delegation of support, in a liquid democracy." ] - , Options.styled' section + , Options.styled_ section [ Color.background <| Color.color Color.Grey Color.S200 ] [ id "main-lower" ] [ grid [ Options.cs "content-grid" ] @@ -614,11 +617,11 @@ viewFooter model = [ Footer.links [ Options.cs "social-links" ] [ Footer.linkItem [ Footer.href "https://github.com/participateapp/web-client" ] [ Footer.html <| - img [ Html.Attributes.src <| basePath ++ "/images/github-circle.png" ] [] + img [ Html.Attributes.src "/images/github-circle.png" ] [] ] , Footer.linkItem [ Footer.href "https://github.com/participateapp/web-client" ] [ Footer.html <| - img [ Html.Attributes.src <| basePath ++ "/images/github-circle.png" ] [] + img [ Html.Attributes.src "/images/github-circle.png" ] [] ] ] ] @@ -627,15 +630,15 @@ viewFooter model = ul [ class "mdl-mini-footer__link-list social-links" ] [ li [] [ a [ Html.Attributes.href "https://github.com/participateapp/web-client" ] - [ img [ Html.Attributes.src <| basePath ++ "/images/github-circle.png" ] [] ] + [ img [ Html.Attributes.src "/images/github-circle.png" ] [] ] ] , li [] [ a [ Html.Attributes.href "https://participateapp.slack.com" ] - [ img [ Html.Attributes.src <| basePath ++ "/images/slack.png" ] [] ] + [ img [ Html.Attributes.src "/images/slack.png" ] [] ] ] , li [] [ a [ Html.Attributes.href "https://twitter.com/digiberber" ] - [ img [ Html.Attributes.src <| basePath ++ "/images/twitter.png" ] [] ] + [ img [ Html.Attributes.src "/images/twitter.png" ] [] ] ] ] ] @@ -685,7 +688,7 @@ viewNewProposal model = [ Button.raised , Button.ripple , Button.colored - , Button.onClick <| FormMsg <| Form.Submit + , Options.onClick <| FormMsg <| Form.Submit ] [ text "Save" ] , Layout.spacer @@ -722,14 +725,15 @@ titleField model = model.mdl ([ Textfield.label "Title" , Textfield.floatingLabel - , Textfield.text' + , Textfield.text_ , Textfield.value <| Maybe.withDefault "" title.value - , Textfield.onInput <| FormMsg << (Form.Field.Text >> Form.Input title.path) - , Textfield.onFocus <| FormMsg <| Form.Focus title.path - , Textfield.onBlur <| FormMsg <| Form.Blur title.path + , Options.onInput <| Form.Field.String >> Form.Input title.path Form.Text >> FormMsg + , Options.onFocus <| FormMsg (Form.Focus title.path) + , Options.onBlur <| FormMsg (Form.Blur title.path) ] ++ conditionalProperties ) + [] bodyField : Model -> Html Msg @@ -762,12 +766,13 @@ bodyField model = , Textfield.textarea , Textfield.rows 6 , Textfield.value <| Maybe.withDefault "" body.value - , Textfield.onInput <| FormMsg << (Form.Field.Text >> Form.Input body.path) - , Textfield.onFocus <| FormMsg <| Form.Focus body.path - , Textfield.onBlur <| FormMsg <| Form.Blur body.path + , Options.onInput <| Form.Field.String >> Form.Input body.path Form.Textarea >> FormMsg + , Options.onFocus <| FormMsg (Form.Focus body.path) + , Options.onBlur <| FormMsg (Form.Blur body.path) ] ++ conditionalProperties ) + [] viewProposal : Model -> String -> Html Msg @@ -783,7 +788,7 @@ viewProposal model id = [ span [ class "actions__authored" ] [ img [ class "mdl-chip__contact" - , Html.Attributes.src <| basePath ++ "/images/john.jpg" + , Html.Attributes.src "/images/john.jpg" ] [] , span [ class "authored" ] @@ -816,7 +821,7 @@ viewProposal model id = model.mdl ([ Options.id "support-proposal" , Button.colored - , Button.onClick <| SupportProposal id (not proposal.supportedByMe) + , Options.onClick <| SupportProposal id (not proposal.supportedByMe) ] ++ if proposal.supportedByMe then [ Color.text <| Color.color Color.Green Color.S500 ] @@ -916,30 +921,28 @@ type alias Flags = { accessToken : Maybe String } -init : Flags -> ( Route, Address ) -> ( Model, Cmd Msg ) -init flags ( route, address ) = +init : Flags -> Location -> ( Model, Cmd Msg ) +init flags location = let model0 = - initialModel (Maybe.withDefault "" flags.accessToken) route address + initialModel (Maybe.withDefault "" flags.accessToken) ( model1, cmd1 ) = - urlUpdate ( route, address ) model0 + update (UrlChange location) model0 in ( model1 , Cmd.batch [ cmd1 - , checkForAuthCode address , Layout.sub0 Mdl ] ) -main : Program Flags +main : Program Flags Model Msg main = - Navigation.programWithFlags urlParser + Navigation.programWithFlags UrlChange { init = init , update = update - , urlUpdate = urlUpdate , subscriptions = \model -> Sub.batch