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
......
......@@ -12,12 +12,13 @@ import Http
import I18n
import Json.Decode as Decode
import Properties.KeysAutocomplete.View
import Properties.New.View
import Set
import String
import Types exposing (..)
import Urls
import Values.New.View
import Values.ViewsHelpers exposing (viewValueTypeLine)
import Values.ViewsHelpers exposing (viewValueIdLine, viewValueTypeLine)
import Views exposing (viewCardListItem, viewLoading)
......@@ -55,6 +56,13 @@ viewCard model card =
([ viewSidebar model card
, viewCardContent model card
]
++ (case model.debatedIds of
Just debatedIds ->
[ viewDebateModal model card debatedIds ]
Nothing ->
[]
)
++ (case model.editedKeyId of
Just editedKeyId ->
[ viewEditPropertyModal model card editedKeyId ]
......@@ -277,6 +285,95 @@ viewCardContent model card =
]
]
)
, div [ class "panel panel-default" ]
(let
panelTitle =
div [ class "col-xs-8 text-left" ]
[ h3 [ class "panel-title" ]
[ text (I18n.translate language I18n.ProsAndCons) ]
]
cardType =
getCardType card
in
if List.isEmpty card.arguments then
[ div [ class "panel-heading" ]
[ div [ class "row" ]
[ panelTitle ]
]
, div [ class "panel-body" ]
[ div [ class "call-container" ]
[ p [] [ text (I18n.translate language (I18n.MissingArguments)) ]
, button
[ class "button call-add"
, onClick (ForSelf (LoadDebateProperties []))
]
[ text (I18n.translate language (I18n.CallToActionForArguments cardType)) ]
]
]
]
else
[ div [ class "panel-heading" ]
[ div [ class "row" ]
[ panelTitle
, div [ class "col-xs-4 text-right up7" ]
[ a [ class "show-more" ]
[ bestOf descriptionKeys ]
, button
[ attribute "data-target" "#debate-content"
, attribute "data-toggle" "modal"
, class "btn btn-default btn-xs btn-action"
, onClick (ForSelf (LoadDebateProperties []))
, type_ "button"
]
[ text (I18n.translate language (I18n.Debate)) ]
]
]
]
, div [ class "panel-body" ]
[ ul []
(List.map
(\argument ->
let
keyLabel =
Dict.get
argument.keyId
(Dict.fromList Properties.New.View.keyIdLabelCouples)
|> Maybe.map (I18n.translate language)
|> Maybe.withDefault argument.keyId
in
li []
[ text keyLabel
, text " "
, text (toString argument.ratingSum)
, text " "
, viewValueIdLine
language
(Just navigate)
data
False
argument.valueId
, text " "
, button
[ attribute "data-target" "#debate-content"
, attribute "data-toggle" "modal"
, class "btn btn-default btn-xs btn-action"
, onClick
(ForSelf
(LoadDebateProperties
[ argument.valueId ]
)
)
, type_ "button"
]
[ text (I18n.translate language (I18n.Debate)) ]
]
)
card.arguments
)
]
]
)
]
)
++ [ div [ class "panel panel-default panel-collapse up20" ]
......@@ -571,6 +668,211 @@ viewCardContent model card =
]
viewDebateModal : Model -> Card -> List String -> Html Msg
viewDebateModal model card debatedIds =
-- The first item of debatedIds is the currently debated value, the next id is its parent value, etc.
-- When debatedIds is empty, the subject of the debate is the card.
let
data =
model.data
cards =
data.cards
language =
model.language
values =
data.values
viewParentDebateButton =
case debatedIds of
[] ->
text ""
_ :: parentDebatedIds ->
button
[ attribute "data-target" "#debate-content"
, attribute "data-toggle" "modal"
, class "btn btn-default"
, onClick
(ForSelf
(LoadDebateProperties parentDebatedIds)
)
, type_ "button"
]
[ text "<" ]
viewProperty index property =
let
keyLabel =
Dict.get property.keyId (Dict.fromList Properties.New.View.keyIdLabelCouples)
|> Maybe.map (I18n.translate language)
|> Maybe.withDefault property.keyId
value =
Dict.get property.valueId values
ballot =
Dict.get property.ballotId data.ballots
in
li [ classList [ ( "media", True ), ( "best", index == 0 ) ] ]
[ div [ class "media-body" ]
(case value of
Nothing ->
[]
Just value ->
[ div []
[ h4 [ class "media-heading" ] [ text keyLabel ]
, viewValueTypeLine language (Just navigate) data False value.value
]
, button
[ attribute "data-target" "#debate-content"
, attribute "data-toggle" "modal"
, class "btn btn-default btn-xs btn-action"
, onClick
(ForSelf
(LoadDebateProperties (property.valueId :: debatedIds))
)
, type_ "button"
]
[ text (I18n.translate language (I18n.Debate)) ]
]
)
, div [ class "media-right" ]
[ a [ class "btn-vote" ]
[ span
[ attribute "aria-hidden" "true"
, class "glyphicon glyphicon-arrow-up"
, onClick (ForSelf (VotePropertyUp property.id))
, style
(case ballot of
Nothing ->
[]
Just ballot ->
if ballot.rating == 1 then
[ ( "color", "blue" ) ]
else
[]
)
-- TODO replace with "active" class
]
[]
]
, div [ class "count" ]
[ text (toString property.ratingSum) ]
, a [ class "btn-vote" ]
[ span
[ attribute "aria-hidden" "true"
, class "glyphicon glyphicon-arrow-down"
, onClick (ForSelf (VotePropertyDown property.id))
, style
(case ballot of
Nothing ->
[]
Just ballot ->
if ballot.rating == -1 then
[ ( "color", "blue" ) ]
else
[]
)
-- TODO replace with "active" class
]
[]
]
]
]
in
div []
[ div
[ attribute "aria-labelledby" "myModalLabel"
, class "modal fade in"
, id "edit-content"
, attribute "role" "dialog"
, attribute "tabindex" "-1"
, style [ ( "display", "block" ) ]
]
[ div [ class "modal-dialog", id "edit-overlay" ]
[ div [ class "modal-content" ]
[ div [ class "modal-header" ]
[ button
[ attribute "data-dismiss" "modal"
, class "close"
, onClick (ForSelf CloseDebateModal)
, type_ "button"
]
[ span [ attribute "aria-hidden" "true" ]
[ text "×" ]
, span [ class "sr-only" ]
[ text "Close" ]
]
, h4 [ class "modal-title", id "myModalLabel" ]
([ viewParentDebateButton
, text " "
, text (I18n.translate language I18n.DebateTitle)
, text " — "
]
++ (case List.head debatedIds of
Just debatedValueId ->
case Dict.get debatedValueId values of
Just debatedTypedValue ->
[ case I18n.getOneStringFromValueType language values debatedTypedValue.value of
Just str ->
text str
Nothing ->
Debug.crash "viewDebateModal: value should have a string value"
]
Nothing ->
[ text ("Missing value for id " ++ debatedValueId) ]
Nothing ->
case Dict.get model.cardId cards of
Just card ->
[ text (I18n.getName language card values) ]
Nothing ->
[ text ("Missing card for id " ++ model.cardId) ]
)
-- ++ [ span []
-- [ text
-- (I18n.translate language
-- (I18n.CountArgumentsAvailable (List.length model.debatePropertyIds))
-- )
-- ]
-- ]
)
]
, div [ class "modal-body", style [ ( "min-height", "35em" ) ] ]
[ div [ class "row" ]
[ div [ class "col-xs-8" ]
[ ul [ class "media-list" ]
(model.debatePropertyIds
|> List.map (getProperty data.properties)
|> List.indexedMap viewProperty
)
]
, div [ class "col-xs-4 grey fullheight-right" ]
[ div []
[ h5 [ attribute "aria-hidden" "true" ]
[ text (I18n.translate language I18n.AddYourArguments) ]
, Properties.New.View.viewForm I18n.Add model.newDebatePropertyModel
|> Html.map translateNewDebatePropertyMsg
]
]
]
]
]
]
]
, div [ class "modal-backdrop in" ] []
]
viewEditPropertyModal : Model -> Card -> String -> Html Msg
viewEditPropertyModal model card editedKeyId =
let
......
......@@ -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 =