Commit 0a380ab8 authored by Emmanuel Raviart's avatar Emmanuel Raviart

Add support for argumented debates.

parent 8ac97866
......@@ -6,6 +6,7 @@ import Http
import I18n
import Ports
import Properties.KeysAutocomplete.State
import Properties.New.State
import Requests
import Task
import Types exposing (..)
......@@ -25,11 +26,15 @@ init =
{ authentication = authentication
, cardId = ""
, data = initData
, debatedIds = Nothing
, debateKeyId = "pros"
, debatePropertyIds = []
, displayUseItModal = False
, editedKeyId = Nothing
, httpError = Nothing
, keysAutocompleteModel = Properties.KeysAutocomplete.State.init [] True
, language = language
, newDebatePropertyModel = Properties.New.State.init authentication language "" "" []
, newValueModel = Values.New.State.init authentication language "" []
, sameKeyPropertyIds = []
}
......@@ -96,6 +101,7 @@ subscriptions : Model -> Sub InternalMsg
subscriptions model =
Sub.batch
[ Sub.map KeysAutocompleteMsg (Properties.KeysAutocomplete.State.subscriptions model.keysAutocompleteModel)
, Sub.map NewDebatePropertyMsg (Properties.New.State.subscriptions model.newDebatePropertyModel)
, Sub.map NewValueMsg (Values.New.State.subscriptions model.newValueModel)
]
......@@ -106,6 +112,17 @@ update msg model =
AddKey typedValue ->
update (LoadProperties typedValue.id) model
CloseDebateModal ->
( { model
| debatedIds = Nothing
, debateKeyId = "pros"
, httpError = Nothing
, debatePropertyIds = []
}
, Requests.getCard model.authentication model.cardId
|> Http.send (ForSelf << GotCard)
)
CloseEditPropertiesModal ->
( { model
| editedKeyId = Nothing
......@@ -133,6 +150,18 @@ update msg model =
(Task.succeed ())
)
DebatePropertyUpserted data ->
( { model
| data = mergeData data model.data
, debatePropertyIds =
if List.member data.id model.debatePropertyIds then
model.debatePropertyIds
else
data.id :: model.debatePropertyIds
}
, Cmd.none
)
DisplayUseItModal displayUseItModal ->
( { model | displayUseItModal = displayUseItModal }
, Cmd.none
......@@ -178,6 +207,17 @@ update msg model =
, cmd
)
GotDebateProperties (Err httpError) ->
( { model | httpError = Just httpError }, Cmd.none )
GotDebateProperties (Ok body) ->
( { model
| data = mergeData body.data model.data
, debatePropertyIds = body.data.ids
}
, Cmd.none
)
GotProperties (Err httpError) ->
( { model | httpError = Just httpError }, Cmd.none )
......@@ -219,6 +259,36 @@ update msg model =
|> Http.send (ForSelf << GotCard)
)
LoadDebateProperties debatedIds ->
case model.authentication of
Just _ ->
let
debatedId =
List.head debatedIds |> Maybe.withDefault model.cardId
in
( { model
| debatedIds = Just debatedIds
, debatePropertyIds = []
, httpError = Nothing
, newDebatePropertyModel =
Properties.New.State.init
model.authentication
model.language
(I18n.iso639_1FromLanguage model.language)
debatedId
[ "TextField" ]
}
, Requests.getDebateProperties model.authentication debatedId
|> Http.send (ForSelf << GotDebateProperties)
)
Nothing ->
( model
, Task.perform
(\_ -> ForParent <| RequireSignIn <| LoadDebateProperties debatedIds)
(Task.succeed ())
)
LoadProperties keyId ->
case model.authentication of
Just _ ->
......@@ -244,6 +314,17 @@ update msg model =
(Task.succeed ())
)
NewDebatePropertyMsg childMsg ->
let
( newDebatePropertyModel, childCmd ) =
model.newDebatePropertyModel
|> Properties.New.State.setContext model.authentication model.language
|> Properties.New.State.update childMsg
in
( { model | newDebatePropertyModel = newDebatePropertyModel }
, Cmd.map translateNewDebatePropertyMsg childCmd
)
NewValueMsg childMsg ->
let
( newValueModel, childCmd ) =
......@@ -300,7 +381,7 @@ update msg model =
editedKeyId
Nothing ->
Debug.crash "Cards.Item.State update ValuePosted: model.editedKeyId == Nothing"
Debug.crash "Cards.Item.State update ValueUpserted: model.editedKeyId == Nothing"
in
( { model | data = mergeData data model.data }
, Requests.postProperty model.authentication model.cardId editedKeyId data.id
......
......@@ -4,6 +4,7 @@ import Authenticator.Types exposing (Authentication)
import Http
import I18n
import Properties.KeysAutocomplete.Types
import Properties.New.Types
import Types exposing (..)
import Values.New.Types
......@@ -15,16 +16,21 @@ type ExternalMsg
type InternalMsg
= AddKey TypedValue
| CloseDebateModal
| CloseEditPropertiesModal
| CreateKey String
| DebatePropertyUpserted DataId
| DisplayUseItModal Bool
| GotCard (Result Http.Error DataIdBody)
| GotDebateProperties (Result Http.Error DataIdsBody)
| GotProperties (Result Http.Error DataIdsBody)
| KeyUpserted (Result Http.Error DataIdBody)
| KeysAutocompleteMsg Properties.KeysAutocomplete.Types.InternalMsg
| LoadCard String
| NewValueMsg Values.New.Types.InternalMsg
| LoadDebateProperties (List String)
| LoadProperties String
| KeysAutocompleteMsg Properties.KeysAutocomplete.Types.InternalMsg
| NewDebatePropertyMsg Properties.New.Types.InternalMsg
| NewValueMsg Values.New.Types.InternalMsg
| PropertyUpserted (Result Http.Error DataIdBody)
| RatingPosted (Result Http.Error DataIdBody)
| ShareOnFacebook String
......@@ -40,11 +46,15 @@ type alias Model =
{ authentication : Maybe Authentication
, cardId : String
, data : DataProxy {}
, debatedIds : Maybe (List String)
, debateKeyId : String
, debatePropertyIds : List String
, displayUseItModal : Bool
, editedKeyId : Maybe String
, httpError : Maybe Http.Error
, keysAutocompleteModel : Properties.KeysAutocomplete.Types.Model
, language : I18n.Language
, newDebatePropertyModel : Properties.New.Types.Model
, newValueModel : Values.New.Types.Model
, sameKeyPropertyIds : List String
}
......@@ -93,6 +103,14 @@ translateMsg { onInternalMsg, onRequireSignIn, onNavigate } msg =
onInternalMsg internalMsg
translateNewDebatePropertyMsg : Properties.New.Types.MsgTranslator Msg
translateNewDebatePropertyMsg =
Properties.New.Types.translateMsg
{ onInternalMsg = ForSelf << NewDebatePropertyMsg
, onPropertyUpserted = ForSelf << DebatePropertyUpserted
}
translateNewValueMsg : Values.New.Types.MsgTranslator Msg
translateNewValueMsg =
Values.New.Types.translateMsg
......
This diff is collapsed.
......@@ -7,6 +7,16 @@ import String
import Types exposing (..)
argumentDecoder : Decoder Argument
argumentDecoder =
succeed Argument
|: (field "keyId" string)
|: oneOf [ (field "rating" int), succeed 0 ]
|: oneOf [ (field "ratingCount" int), succeed 0 ]
|: oneOf [ (field "ratingSum" int), succeed 0 ]
|: (field "valueId" string)
ballotDecoder : Decoder Ballot
ballotDecoder =
succeed Ballot
......@@ -53,6 +63,7 @@ cardAutocompletionDecoder =
cardDecoder : Decoder Card
cardDecoder =
succeed Card
|: oneOf [ (field "arguments" (list argumentDecoder)), succeed [] ]
|: (field "createdAt" string)
|: oneOf [ (field "deleted" bool), succeed False ]
|: (field "id" string)
......@@ -155,6 +166,7 @@ messageBodyDecoder =
propertyDecoder : Decoder Property
propertyDecoder =
succeed Property
|: oneOf [ (field "arguments" (list argumentDecoder)), succeed [] ]
|: oneOf [ (field "ballotId" string), succeed "" ]
|: (field "createdAt" string)
|: oneOf [ (field "deleted" bool), succeed False ]
......
This diff is collapsed.
This diff is collapsed.
module Properties.New.State exposing (..)
import Authenticator.Types exposing (Authentication)
import Dict exposing (Dict)
import Http
import I18n
import Navigation
import Ports
import Properties.New.Types exposing (..)
import Requests
import Task
import Types exposing (initDataId, mergeData, mergeDataId)
import Urls
import Values.New.State
import Values.New.Types
init : Maybe Authentication -> I18n.Language -> String -> String -> List String -> Model
init authentication language languageIso639_1 objectId validFieldTypes =
{ authentication = authentication
, data = initDataId
, errors = Dict.empty
, httpError = Nothing
, keyId = ""
, language = language
, newValueModel = Values.New.State.init authentication language languageIso639_1 validFieldTypes
, objectId = objectId
, validFieldTypes = validFieldTypes
}
convertControls : Model -> Model
convertControls model =
let
keyIdError =
case model.keyId of
"" ->
Just I18n.MissingValue
"cons" ->
Nothing
"pros" ->
Nothing
_ ->
Just I18n.UnknownValue
in
{ model
| errors =
case keyIdError of
Just keyIdError ->
Dict.singleton "keyId" keyIdError
Nothing ->
Dict.empty
}
setContext : Maybe Authentication -> I18n.Language -> Model -> Model
setContext authentication language model =
{ model
| authentication = authentication
, language = language
}
subscriptions : Model -> Sub InternalMsg
subscriptions model =
Sub.map NewValueMsg (Values.New.State.subscriptions model.newValueModel)
update : InternalMsg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
KeyIdChanged keyId ->
( convertControls { model | keyId = keyId }, Cmd.none )
NewValueMsg childMsg ->
let
( newValueModel, childCmd ) =
model.newValueModel
|> Values.New.State.setContext model.authentication model.language
|> Values.New.State.update childMsg
in
( { model | newValueModel = newValueModel }
, Cmd.map translateNewValueMsg childCmd
)
Submit ->
let
newModel =
convertControls model
in
if Dict.isEmpty newModel.errors then
update (NewValueMsg Values.New.Types.Submit) newModel
else
( newModel, Cmd.none )
Upserted (Err httpError) ->
( { model | httpError = Just httpError }, Cmd.none )
Upserted (Ok body) ->
let
data =
mergeDataId body.data model.data
in
( { model | data = data }
, Task.perform (\_ -> ForParent <| PropertyUpserted data) (Task.succeed ())
)
ValueUpserted data ->
( { model | data = mergeData data model.data }
, Requests.postProperty model.authentication model.objectId model.keyId data.id
|> Http.send (ForSelf << Upserted)
)
urlUpdate : Maybe Authentication -> I18n.Language -> Navigation.Location -> Model -> ( Model, Cmd Msg )
urlUpdate authentication language location model =
( init authentication language (I18n.iso639_1FromLanguage language) model.objectId model.validFieldTypes
, Ports.setDocumentMetadata
{ description = I18n.translate language I18n.NewPropertyDescription
, imageUrl = Urls.appLogoFullUrl
, title = I18n.translate language I18n.NewProperty
}
)
module Properties.New.Types exposing (..)
import Authenticator.Types exposing (Authentication)
import Dict exposing (Dict)
import Http
import I18n
import Types exposing (..)
import Values.New.Types
type ExternalMsg
= PropertyUpserted DataId
type alias FormErrors =
Dict String I18n.TranslationId
type InternalMsg
= KeyIdChanged String
| NewValueMsg Values.New.Types.InternalMsg
| Submit
| Upserted (Result Http.Error DataIdBody)
| ValueUpserted DataId
type alias Model =
{ authentication : Maybe Authentication
, data : DataId
, errors : FormErrors
, httpError : Maybe Http.Error
, keyId : String
, language : I18n.Language
, newValueModel : Values.New.Types.Model
, objectId : String
, validFieldTypes : List String
}
type Msg
= ForParent ExternalMsg
| ForSelf InternalMsg
type alias MsgTranslation parentMsg =
{ onInternalMsg : InternalMsg -> parentMsg
, onPropertyUpserted : DataId -> parentMsg
}
type alias MsgTranslator parentMsg =
Msg -> parentMsg
translateMsg : MsgTranslation parentMsg -> MsgTranslator parentMsg
translateMsg { onInternalMsg, onPropertyUpserted } msg =
case msg of
ForParent (PropertyUpserted data) ->
onPropertyUpserted data
ForSelf internalMsg ->
onInternalMsg internalMsg
translateNewValueMsg : Values.New.Types.MsgTranslator Msg
translateNewValueMsg =
Values.New.Types.translateMsg
{ onInternalMsg = ForSelf << NewValueMsg
, onValueUpserted = ForSelf << ValueUpserted
}
module Properties.New.View exposing (..)
import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Attributes.Aria exposing (..)
import Html.Events exposing (..)
import Http.Error
import I18n
import Json.Decode
import Properties.New.Types exposing (..)
import Values.New.View
import Views exposing (errorInfos)
keyIdLabelCouples : List ( String, I18n.TranslationId )
keyIdLabelCouples =
[ ( "pros", I18n.DebateProsLabel )
, ( "cons", I18n.DebateConsLabel )
]
view : Model -> Html Msg
view model =
section []
[ h1 [] [ text <| I18n.translate model.language I18n.NewProperty ]
, viewForm I18n.Create model
]
viewForm : I18n.TranslationId -> Model -> Html Msg
viewForm submitButtonI18n model =
let
language =
model.language
alert =
case model.httpError of
Nothing ->
[]
Just httpError ->
[ div
[ class "alert alert-danger"
, role "alert"
]
[ strong []
[ text <|
I18n.translate language I18n.ValueCreationFailed
++ I18n.translate language I18n.Colon
]
, text <| Http.Error.toString language httpError
]
]
in
Html.form
[ onSubmit (ForSelf <| Submit) ]
(alert
++ (viewFormControls model)
++ [ button
[ class "btn btn-primary"
, disabled (not (Dict.isEmpty model.errors) || model.newValueModel.field == Nothing)
, type_ "submit"
]
[ text (I18n.translate language submitButtonI18n) ]
]
)
viewFormControls : Model -> List (Html Msg)
viewFormControls model =
let
language =
model.language
in
[ let
controlId =
"keyId"
( errorClass, errorAttributes, errorBlock ) =
errorInfos language controlId (Dict.get controlId model.errors)
in
div [ class ("form-group" ++ errorClass) ]
([ label
[ class "control-label", for controlId ]
[ text <| I18n.translate language I18n.Type ]
, select
([ class "form-control"
, id controlId
, on "change"
(Json.Decode.map (ForSelf << KeyIdChanged)
targetValue
)
]
++ errorAttributes
)
(keyIdLabelCouples
|> List.map
(\( symbol, labelI18n ) ->
( symbol
, I18n.translate language labelI18n
)
)
|> List.sortBy (\( symbol, label ) -> label)
|> (::) ( "", "" )
|> List.map
(\( keyId, label ) ->
option
[ selected (keyId == model.keyId)
, value keyId
]
[ text label ]
)
)
]
++ errorBlock
)
]
++ (Values.New.View.viewFormControls model.newValueModel
|> List.map (Html.map translateNewValueMsg)
)
......@@ -224,6 +224,19 @@ getCollectionsForAuthor authentication =
}
getDebateProperties : Maybe Authentication -> String -> Http.Request DataIdsBody
getDebateProperties authentication objectId =
Http.request
{ method = "GET"
, headers = authenticationHeaders authentication
, url = apiUrl ++ "objects/" ++ objectId ++ "/debate-properties" ++ "?show=ballots&show=values&depth=1"
, body = Http.emptyBody
, expect = Http.expectJson dataIdsBodyDecoder
, timeout = Nothing
, withCredentials = False
}
getObjectProperties : Maybe Authentication -> String -> String -> Http.Request DataIdsBody
getObjectProperties authentication objectId keyId =
Http.request
......
......@@ -4,6 +4,15 @@ import Dict exposing (Dict)
import Json.Decode
type alias Argument =
{ keyId : String
, rating : Int
, ratingCount : Int
, ratingSum : Int
, valueId : String
}
type alias Ballot =
{ deleted : Bool
, id : String
......@@ -21,7 +30,8 @@ type alias BijectiveCardReference =
type alias Card =
{ createdAt : String
{ arguments : List Argument
, createdAt : String
, deleted : Bool
, id : String
, properties : Dict String String
......@@ -149,7 +159,8 @@ type alias PopularTagsData =
type alias Property =
{ ballotId :
{ arguments : List Argument
, ballotId :
String
-- TODO Use Maybe
, createdAt : String
......
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment