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
      ]