first commit
This commit is contained in:
Christian Lawson-Perfect
commit
24fa9a2d77
15 changed files with 1870 additions and 0 deletions
479
src/App.elm
Normal file
479
src/App.elm
Normal file
|
|
@ -0,0 +1,479 @@
|
|||
port module App exposing (..)
|
||||
|
||||
import Browser
|
||||
import Dict exposing (Dict)
|
||||
import Html as H exposing (Html)
|
||||
import Html.Keyed
|
||||
import Html.Attributes as HA
|
||||
import Html.Events as HE
|
||||
import Json.Decode as JD
|
||||
import Json.Decode.Pipeline as JDP exposing (required, requiredAt)
|
||||
import Json.Encode as JE exposing (Value)
|
||||
import Tuple exposing (pair, first, second)
|
||||
|
||||
port sendMessage : Value -> Cmd msg
|
||||
port receiveMessage : (Value -> msg) -> Sub msg
|
||||
port receiveClick : (Value -> msg) -> Sub msg
|
||||
|
||||
main = Browser.element
|
||||
{ init = init
|
||||
, update = update
|
||||
, subscriptions = subscriptions
|
||||
, view = view
|
||||
}
|
||||
|
||||
type alias Exam =
|
||||
{ object : JE.Value
|
||||
, currentQuestion : Int
|
||||
, questions : List Question
|
||||
}
|
||||
|
||||
type alias Question =
|
||||
{ isDirty : Bool
|
||||
, score : Float
|
||||
, object : JE.Value
|
||||
, name : String
|
||||
, parts : List Part
|
||||
, number : Int
|
||||
, statement : JE.Value
|
||||
}
|
||||
|
||||
type alias QuestionMessage =
|
||||
{ questionNumber : Int
|
||||
, type_ : String
|
||||
, msg : JE.Value
|
||||
}
|
||||
|
||||
type PartType
|
||||
= InformationOnlyPart
|
||||
| NumberEntryPart
|
||||
| MathematicalExpressionPart
|
||||
| PatternMatchPart
|
||||
| GapFillPart
|
||||
| CustomPart String
|
||||
|
||||
type alias Part =
|
||||
{ object : JE.Value
|
||||
, name : String
|
||||
, type_ : PartType
|
||||
, path : String
|
||||
, score : Float
|
||||
, marks: Float
|
||||
, prompt : JE.Value
|
||||
, marking_feedback : List FeedbackMessage
|
||||
, gaps : Gaps
|
||||
}
|
||||
|
||||
type Gaps = Gaps (List Part)
|
||||
|
||||
type alias FeedbackMessage =
|
||||
{ op : String
|
||||
, credit : Maybe Float
|
||||
, message : JE.Value
|
||||
, reason : Maybe String
|
||||
, credit_change : Maybe String
|
||||
}
|
||||
|
||||
type alias PartMessage =
|
||||
{ partPath : String
|
||||
, type_ : String
|
||||
, msg : JE.Value
|
||||
}
|
||||
|
||||
type ViewMode
|
||||
= ViewWholeExam
|
||||
| ViewQuestion Int
|
||||
| ViewPart Int String
|
||||
| ViewPartAnswer Int String
|
||||
|
||||
decode_default : JD.Decoder a -> a -> JE.Value -> a
|
||||
decode_default decoder default =
|
||||
JD.decodeValue decoder >> Result.withDefault default
|
||||
|
||||
decode_view_mode =
|
||||
JD.field "mode" JD.string
|
||||
|> JD.andThen (\mode -> case mode of
|
||||
"exam" -> JD.succeed ViewWholeExam
|
||||
"question" -> JD.field "questionNumber" JD.int |> JD.map ViewQuestion
|
||||
"part" ->
|
||||
JD.map2
|
||||
ViewPart
|
||||
(JD.field "questionNumber" JD.int)
|
||||
(JD.field "partPath" JD.string)
|
||||
"part_answer" ->
|
||||
JD.map2
|
||||
ViewPartAnswer
|
||||
(JD.field "questionNumber" JD.int)
|
||||
(JD.field "partPath" JD.string)
|
||||
_ -> JD.fail <| "Unrecognised view mode: "++mode
|
||||
)
|
||||
|
||||
type alias Model =
|
||||
{ exam : Maybe Exam
|
||||
, messages : List String
|
||||
, view_mode : ViewMode
|
||||
}
|
||||
|
||||
init_model : JE.Value -> Model
|
||||
init_model flags =
|
||||
let
|
||||
exam =
|
||||
JD.decodeValue (JD.field "exam" JD.value) flags
|
||||
|> Result.toMaybe
|
||||
|> Maybe.map (\e ->
|
||||
{ object = e
|
||||
, currentQuestion = -1
|
||||
, questions = get_questions e
|
||||
}
|
||||
)
|
||||
|
||||
view_mode =
|
||||
JD.decodeValue
|
||||
(JD.field "view_mode" decode_view_mode)
|
||||
flags
|
||||
|> Result.withDefault ViewWholeExam
|
||||
in
|
||||
{ exam = exam
|
||||
, messages = []
|
||||
, view_mode = view_mode
|
||||
}
|
||||
|
||||
type Msg
|
||||
= ReceiveMessage Value
|
||||
| SendPartMessage Question Part String (List (String, JE.Value))
|
||||
|
||||
init : JE.Value -> (Model, Cmd msg)
|
||||
init flags = (init_model flags, Cmd.none)
|
||||
|
||||
listGet : Int -> List a -> Maybe a
|
||||
listGet i = List.drop i >> List.head
|
||||
|
||||
decode_message =
|
||||
JD.map2 pair
|
||||
(JD.field "type" JD.string)
|
||||
(JD.field "arg" JD.value)
|
||||
|
||||
update msg model = case msg of
|
||||
ReceiveMessage value ->
|
||||
case JD.decodeValue decode_message value of
|
||||
Ok (kind,arg) -> ({ model | messages = if kind /= "showTiming" then kind::model.messages else model.messages } |> handle_exam_message kind arg, Cmd.none)
|
||||
Err s -> ({ model | messages = (Debug.toString s)::model.messages }, Cmd.none)
|
||||
|
||||
SendPartMessage question part msgtype extras ->
|
||||
(model, sendMessage (encode_part_message question part msgtype extras))
|
||||
|
||||
encode_message msgtype extras =
|
||||
JE.object
|
||||
([("msgtype", JE.string msgtype)]++extras)
|
||||
|
||||
encode_question_message question msgtype extras =
|
||||
encode_message "question" [ ("msg", JE.object ([("msgtype", JE.string msgtype)]++extras)), ("questionNumber", JE.int question.number) ]
|
||||
|
||||
encode_part_message question part msgtype extras =
|
||||
encode_question_message question "part" [ ("msg", JE.object ([("msgtype", JE.string msgtype)]++extras)), ("partPath", JE.string part.path)]
|
||||
|
||||
{- update the ith item in a list using the given map function -}
|
||||
update_list : Int -> (a -> a) -> List a -> List a
|
||||
update_list i fn list = list |> List.indexedMap pair |> List.map (\(j,a) -> if i==j then fn a else a)
|
||||
|
||||
map_exam : (Exam -> Exam) -> Model -> Model
|
||||
map_exam fn model = { model | exam = Maybe.map fn model.exam }
|
||||
|
||||
map_question : Int -> (Question -> Question) -> Model -> Model
|
||||
map_question i fn model = model |> map_exam (\exam -> { exam | questions = update_list i fn exam.questions })
|
||||
|
||||
map_part : String -> (Part -> Part) -> Question -> Question
|
||||
map_part path fn question = { question | parts = List.map (\p -> if p.path==path then fn p else p) question.parts }
|
||||
|
||||
show_question : Model -> Model
|
||||
show_question model =
|
||||
case model.exam of
|
||||
Nothing -> model
|
||||
Just exam -> case JD.decodeValue (JD.field "currentQuestionNumber" JD.int) exam.object of
|
||||
Ok n ->
|
||||
let
|
||||
nexam = { exam | currentQuestion = n }
|
||||
in
|
||||
{model | exam = Just nexam}
|
||||
Err _ -> model
|
||||
|
||||
update_question_list = map_exam (\e -> {e | questions = get_questions e.object })
|
||||
|
||||
type alias MessageHandler m = String -> Value -> m -> m
|
||||
|
||||
handle_message : Dict String (Value -> m -> m) -> MessageHandler m
|
||||
handle_message message_handlers kind value model =
|
||||
let
|
||||
handler = Dict.get kind message_handlers |> Maybe.withDefault (\_ -> identity)
|
||||
in
|
||||
handler value model
|
||||
|
||||
handle_exam_message : MessageHandler Model
|
||||
handle_exam_message = handle_message <| Dict.fromList
|
||||
[ ("showQuestion", \_ -> show_question)
|
||||
, ("updateQuestionList", \_ -> update_question_list)
|
||||
, ("question", \value model ->
|
||||
let
|
||||
mexam : Maybe Exam
|
||||
mexam = model.exam
|
||||
|
||||
q = Debug.log "question message" minfo
|
||||
|
||||
minfo = value |> JD.decodeValue
|
||||
(JD.map3 QuestionMessage
|
||||
(JD.field "questionNumber" JD.int)
|
||||
(JD.field "type" JD.string)
|
||||
(JD.field "arg" JD.value)
|
||||
)
|
||||
|> Result.toMaybe
|
||||
|
||||
mquestion : Maybe Question
|
||||
mquestion = Maybe.map2 get_question mexam (Maybe.map .questionNumber minfo) |> Maybe.andThen identity
|
||||
in
|
||||
case (minfo, mexam) of
|
||||
(Just info, Just exam) -> map_question info.questionNumber (handle_question_message info.type_ info.msg) model
|
||||
_ -> model
|
||||
)
|
||||
]
|
||||
|
||||
handle_question_message : MessageHandler Question
|
||||
handle_question_message = handle_message <| Dict.fromList
|
||||
[ ("isDirty", \v q ->
|
||||
v |> JD.decodeValue (JD.bool) |> Result.map (\dirty -> {q | isDirty = dirty}) |> Result.withDefault q
|
||||
)
|
||||
, ("showScore", \_ q -> {q | score = JD.decodeValue (JD.field "score" JD.float) q.object |> Result.withDefault q.score })
|
||||
, ("part", \value question ->
|
||||
let
|
||||
minfo = value |> JD.decodeValue
|
||||
(JD.map3 PartMessage
|
||||
(JD.field "partPath" JD.string)
|
||||
(JD.field "type" JD.string)
|
||||
(JD.field "arg" JD.value)
|
||||
)
|
||||
|> Result.toMaybe
|
||||
|
||||
q = Debug.log "part message" minfo
|
||||
|
||||
mpart = Maybe.map (.partPath >> get_part question) minfo
|
||||
in
|
||||
case (minfo, mpart) of
|
||||
(Just info, Just part) -> map_part info.partPath (handle_part_message info.type_ info.msg) question
|
||||
_ -> question
|
||||
)
|
||||
]
|
||||
|
||||
handle_part_message : MessageHandler Part
|
||||
handle_part_message = handle_message <| Dict.fromList
|
||||
[ ("showScore", \_ p ->
|
||||
let
|
||||
score = decode_default (JD.field "score" JD.float) 0 p.object
|
||||
marks = decode_default (JD.field "marks" JD.float) 0 p.object
|
||||
marking_feedback = decode_default (JD.field "markingFeedback" (JD.list decode_feedback_message)) [] p.object
|
||||
in
|
||||
{p | score = score, marks = marks, marking_feedback = marking_feedback })
|
||||
]
|
||||
|
||||
subscriptions model =
|
||||
Sub.batch
|
||||
[ receiveMessage ReceiveMessage
|
||||
]
|
||||
|
||||
get_exam_name : Exam -> String
|
||||
get_exam_name = .object >> JD.decodeValue (JD.at ["settings","name"] JD.string) >> Result.withDefault "Unnamed exam"
|
||||
|
||||
get_questions : JE.Value -> List Question
|
||||
get_questions = JD.decodeValue (JD.at ["questionList"] (JD.list decode_question)) >> Result.withDefault []
|
||||
|
||||
get_question : Exam -> Int -> Maybe Question
|
||||
get_question exam n = listGet n exam.questions
|
||||
|
||||
get_part : Question -> String -> Maybe Part
|
||||
get_part question path = question.parts |> List.filter (\p -> p.path == path) |> List.head
|
||||
|
||||
decode_question : JD.Decoder Question
|
||||
decode_question =
|
||||
JD.succeed Question
|
||||
|> JDP.hardcoded False
|
||||
|> JDP.hardcoded 0
|
||||
|> JDP.custom JD.value
|
||||
|> required "name" JD.string
|
||||
|> requiredAt ["display", "allParts"] (JD.list decode_part)
|
||||
|> required "number" JD.int
|
||||
|> JDP.optionalAt ["display", "statement"] JD.value (JE.string "")
|
||||
|
||||
decode_part : JD.Decoder Part
|
||||
decode_part =
|
||||
JD.succeed Part
|
||||
|> JDP.custom JD.value
|
||||
|> required "name" JD.string
|
||||
|> required "type" decode_part_type
|
||||
|> required "path" JD.string
|
||||
|> required "score" JD.float
|
||||
|> required "marks" JD.float
|
||||
|> JDP.optionalAt ["display", "prompt"] JD.value (JE.string "")
|
||||
|> JDP.optional "markingFeedback" (JD.list decode_feedback_message) []
|
||||
|> JDP.optional "gaps" (JD.map Gaps <| JD.list (JD.lazy (\_ -> decode_part))) (Gaps [])
|
||||
|
||||
part_types : Dict String PartType
|
||||
part_types = Dict.fromList
|
||||
[ ("information", InformationOnlyPart)
|
||||
, ("numberentry", NumberEntryPart)
|
||||
, ("jme", MathematicalExpressionPart)
|
||||
, ("patternmatch", PatternMatchPart)
|
||||
]
|
||||
|
||||
decode_part_type : JD.Decoder PartType
|
||||
decode_part_type =
|
||||
JD.string |> JD.map (\t -> Dict.get t part_types |> Maybe.withDefault (CustomPart t))
|
||||
|
||||
decode_feedback_message =
|
||||
JD.succeed FeedbackMessage
|
||||
|> required "op" JD.string
|
||||
|> JDP.optional "credit" (JD.maybe JD.float) Nothing
|
||||
|> required "message" JD.value
|
||||
|> JDP.optional "reason" (JD.maybe JD.string) Nothing
|
||||
|> JDP.optional "credit_change" (JD.maybe JD.string) Nothing
|
||||
|
||||
external_html : JE.Value -> Html Msg
|
||||
external_html html =
|
||||
H.node "elm-html"
|
||||
[ HA.property "html" html ]
|
||||
[]
|
||||
|
||||
format_score : Float -> Float -> String
|
||||
format_score score marks = (String.fromFloat score)++"/"++(String.fromFloat marks)
|
||||
|
||||
view model = case model.exam of
|
||||
Nothing -> view_loading
|
||||
Just exam ->
|
||||
case model.view_mode of
|
||||
ViewWholeExam -> view_exam model exam
|
||||
|
||||
ViewQuestion n -> case get_question exam n of
|
||||
Just question -> view_question question
|
||||
Nothing -> H.text "That question doesn't exist"
|
||||
|
||||
ViewPart n path -> case get_question exam n |> Maybe.andThen (\q -> get_part q path |> Maybe.map (pair q)) of
|
||||
Just (question, part) -> view_part question part
|
||||
Nothing -> H.text "That part doesn't exist"
|
||||
|
||||
ViewPartAnswer n path -> case get_question exam n |> Maybe.andThen (\q -> get_part q path |> Maybe.map (pair q)) of
|
||||
Just (question, part) -> view_part_answer_input question part
|
||||
Nothing -> H.text <| "That part (q"++(String.fromInt n)++(path)++") doesn't exist"
|
||||
|
||||
view_loading = H.text "It's loading"
|
||||
|
||||
view_exam : Model -> Exam -> Html Msg
|
||||
view_exam model exam =
|
||||
let
|
||||
exam_name = get_exam_name exam
|
||||
questions = exam.questions
|
||||
|
||||
in
|
||||
H.div
|
||||
[]
|
||||
[ H.h1 [] [H.text <| exam_name]
|
||||
{-
|
||||
, H.ul
|
||||
[]
|
||||
(List.map (\msg -> H.li [] [H.text msg]) (List.take 5 model.messages))
|
||||
-}
|
||||
, H.ul
|
||||
[]
|
||||
(List.map (\q -> H.li [] [view_question q]) questions)
|
||||
]
|
||||
|
||||
view_question question =
|
||||
H.div
|
||||
[]
|
||||
[ H.h2 [] [H.text question.name, H.text <| if question.isDirty then " (dirty)" else " (clean)"]
|
||||
, H.p [] [H.text "Score: ", H.text <| String.fromFloat question.score]
|
||||
, external_html question.statement
|
||||
, H.ul
|
||||
[]
|
||||
(List.map (\p -> H.li [] [view_part question p]) question.parts)
|
||||
]
|
||||
|
||||
view_part : Question -> Part -> Html Msg
|
||||
view_part question part =
|
||||
let
|
||||
gaps = case part.gaps of
|
||||
Gaps g -> g
|
||||
in
|
||||
H.div
|
||||
[]
|
||||
[ H.h3 [] [H.text part.name]
|
||||
, H.p [] [H.text <| Debug.toString part.type_]
|
||||
, H.p [] [H.text <| "Score: " ++ (format_score part.score part.marks)]
|
||||
, external_html part.prompt
|
||||
, view_part_answer_input question part
|
||||
, H.ul
|
||||
[]
|
||||
(List.map (\f -> view_feedback_message f) part.marking_feedback)
|
||||
]
|
||||
|
||||
view_part_answer_input question part =
|
||||
let
|
||||
msgs =
|
||||
{ store_answer =
|
||||
pair "answer"
|
||||
>> List.singleton
|
||||
>> SendPartMessage question part "part_answer"
|
||||
|
||||
, submit_answer = SendPartMessage question part "submit" []
|
||||
}
|
||||
in
|
||||
case part.type_ of
|
||||
GapFillPart -> H.text ""
|
||||
InformationOnlyPart -> H.text ""
|
||||
_ ->
|
||||
H.form
|
||||
[ HE.onSubmit msgs.submit_answer
|
||||
, HA.attribute "part" "answer-input-form"
|
||||
, HE.on "focusout" (JD.succeed msgs.submit_answer)
|
||||
]
|
||||
[ case part.type_ of
|
||||
NumberEntryPart -> number_entry_input msgs
|
||||
MathematicalExpressionPart -> mathematical_expression_input msgs
|
||||
_ -> H.text ""
|
||||
]
|
||||
|
||||
type alias AnswerMessages =
|
||||
{ store_answer : JE.Value -> Msg
|
||||
, submit_answer : Msg
|
||||
}
|
||||
|
||||
type alias AnswerInput = AnswerMessages -> Html Msg
|
||||
|
||||
number_entry_input : AnswerInput
|
||||
number_entry_input msgs =
|
||||
H.input
|
||||
[ HE.onInput (
|
||||
JE.string
|
||||
>> msgs.store_answer
|
||||
)
|
||||
]
|
||||
[]
|
||||
|
||||
mathematical_expression_input : AnswerInput
|
||||
mathematical_expression_input msgs =
|
||||
H.input
|
||||
[ HE.onInput (
|
||||
JE.string
|
||||
>> msgs.store_answer
|
||||
)
|
||||
]
|
||||
[]
|
||||
|
||||
view_feedback_message f =
|
||||
let
|
||||
feedback_icon = case f.credit_change of
|
||||
Just "positive" -> H.text "+"
|
||||
Just "negative" -> H.text "-"
|
||||
_ -> H.text ""
|
||||
in
|
||||
H.li
|
||||
[HA.class "feedback-message"]
|
||||
[ feedback_icon
|
||||
, external_html f.message
|
||||
]
|
||||
Loading…
Add table
Add a link
Reference in a new issue