module Main exposing (main) import Browser import Html exposing (Attribute, Html, button, div, hr, input, span, table, tbody, td, text, th, thead, tr) import Html.Attributes exposing (class, disabled, max, min, step, style, title, type_, value) import Html.Events exposing (onClick, onInput) import Http import Json.Decode exposing (Decoder, field, float, int, list, map, map2, map3, map4) import Json.Encode as Encode exposing (Value, object) import Round import Set exposing (Set) -- MAIN main = Browser.element { init = init, update = update, view = view, subscriptions = \_ -> Sub.none } -- MODEL type alias Capital = { principal : Float , interest : Float } capitalDecoder : Decoder Capital capitalDecoder = map2 Capital (field "principal" float) (field "interest" float) type alias Quota = { period : Int , payed : Capital , pending_principal : Float } quotaDecoder : Decoder Quota quotaDecoder = map3 Quota (field "period" int) (field "payed" capitalDecoder) (field "pending_principal" float) type alias Simulation = { history : List Quota , topay : Capital , payed : Capital , payed_amortized : Float } simDecoder : Decoder Simulation simDecoder = map4 Simulation (field "history" (list quotaDecoder)) (field "topay" capitalDecoder) (field "payed" capitalDecoder) (field "payed_amortized" float) type alias SimSpecsTxt = { principalTxt : String , i1Txt : String , yearsTxt : String } simSpecsParse : SimSpecsTxt -> Maybe SimSpecs simSpecsParse { principalTxt, i1Txt, yearsTxt } = case ( String.toFloat principalTxt, String.toFloat i1Txt, String.toInt yearsTxt ) of ( Just principal, Just i1, Just years ) -> Just { principal = principal, i1 = i1, years = years } _ -> Nothing type alias SimSpecs = { principal : Float , i1 : Float , years : Int } type alias Model = { error : String , simSpecsTxt : SimSpecsTxt , expandedYears : Set Int , simulation : Maybe Simulation } qs : List ( String, String ) -> String qs ss = String.join "&" (List.map (\( s, t ) -> String.join "=" [ s, t ]) ss) simSpecsToURL : SimSpecs -> String simSpecsToURL { principal, i1, years } = let base = "/api/simulate" in String.concat [ base , "?" , qs [ ( "principal", String.fromFloat principal ) , ( "i1" , String.fromFloat (i1 / 100) ) , ( "years", String.fromInt years ) ] ] runSimulation : SimSpecs -> Cmd Msg runSimulation simSpecs = Http.get { url = simSpecsToURL simSpecs , expect = Http.expectJson GotSimulation simDecoder } init : () -> ( Model, Cmd Msg ) init () = let simSpecsTxt = { principalTxt = "200000", i1Txt = "1.621", yearsTxt = "30" } in ( { error = "", simSpecsTxt = simSpecsTxt, expandedYears = Set.empty, simulation = Nothing }, Cmd.none ) -- UPDATE type SimSpecUpdate = Principal | I1 | Years type Msg = GotSimulation (Result Http.Error Simulation) | UpdateSimSpecs SimSpecUpdate String | RunSimulation SimSpecs | SetExpandedYears (Set Int) update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = let _ = Debug.log "UPDATE!" msg in case msg of GotSimulation (Ok simulation) -> ( { model | simulation = Just simulation }, Cmd.none ) GotSimulation (Err err) -> ( { model | error = errorToString err }, Cmd.none ) RunSimulation specs -> ( model, runSimulation specs ) UpdateSimSpecs u val -> let simSpecsTxt = model.simSpecsTxt newSimSpecsTxt = case u of Principal -> { simSpecsTxt | principalTxt = val } I1 -> { simSpecsTxt | i1Txt = val } Years -> { simSpecsTxt | yearsTxt = val } in ( { model | simSpecsTxt = newSimSpecsTxt }, Cmd.none ) SetExpandedYears eyears -> ( { model | expandedYears = eyears }, Cmd.none ) -- VIEW (THEME) butAttrs : List (Attribute Msg) butAttrs = [ class "px-3 rounded-md bg-lime-300 enabled:active:bg-lime-400 border border-lime-600 disabled:opacity-75" ] clickableAttrs : Msg -> List (Attribute Msg) clickableAttrs msg = [ onClick msg, class "text-lime-600", style "cursor" "pointer" ] -- VIEW errorToString : Http.Error -> String errorToString error = case error of Http.BadUrl url -> "The URL " ++ url ++ " was invalid" Http.Timeout -> "Unable to reach the server, try again" Http.NetworkError -> "Unable to reach the server, check your network connection" Http.BadStatus 500 -> "The server had a problem, try again later" Http.BadStatus 400 -> "Verify your information and try again" Http.BadStatus _ -> "Unknown error" Http.BadBody errorMessage -> errorMessage specsView : SimSpecsTxt -> Html Msg specsView simSpecsTxt = let { principalTxt, i1Txt, yearsTxt } = simSpecsTxt simSpecs = simSpecsParse simSpecsTxt simButAttrs = case simSpecs of Nothing -> [ disabled True ] Just specs -> [ onClick (RunSimulation specs) ] in div [] [ div [ class "flex" ] [ text "Principal: " , input [ type_ "range" , class "accent-lime-300" , Html.Attributes.min "0" , Html.Attributes.max "1000000" , step "10000" , value principalTxt , onInput (UpdateSimSpecs Principal) ] [] , text principalTxt ] , div [ class "flex" ] [ text "Interest rate: " , input [ Html.Attributes.min "0" , Html.Attributes.max "100" , value i1Txt , onInput (UpdateSimSpecs I1) ] [] ] , div [ class "flex" ] [ text "Years: " , input [ type_ "range" , class "accent-lime-300" , Html.Attributes.min "1" , Html.Attributes.max "50" , step "1" , value yearsTxt , onInput (UpdateSimSpecs Years) ] [] , text yearsTxt ] , button (butAttrs ++ simButAttrs) [ text "Simulate" ] ] historyView : Model -> List Quota -> Html Msg historyView m quotas = let titles = [ "Year", "Month", "Quota", "Pending" ] head = thead [ class "bg-lime-100" ] [ tr [] (List.map (\t -> th [ class "px-3 py-1 border border-gray-300" ] [ text t ]) titles) ] in div [ class "py-4" ] [ table [ class "border border-collapse border-gray-400" ] [ head , tbody [] (List.map (quotaView m) quotas ) ] ] capitalSumView : Capital -> Html Msg capitalSumView { principal, interest } = let partsTitle = String.concat [ "Principal: ", Round.round 2 principal, "\nInterest: ", Round.round 2 interest ] in span [ class "underline", title partsTitle ] [ text (Round.round 2 (principal + interest)) ] periodToYear : Int -> Int periodToYear period = ((period - 1) // 12) + 1 quotaView : Model -> Quota -> Html Msg quotaView m { period, payed, pending_principal } = let year = periodToYear period yearExpanded = Set.member year m.expandedYears in if modBy 12 (period - 1) == 0 then tr [] (List.map (\t -> td [ class "px-3 py-1 border border-gray-300" ] [ t ]) [ div [] [ span (clickableAttrs (SetExpandedYears ((if yearExpanded then Set.remove else Set.insert ) year m.expandedYears ) ) ) [ text (if yearExpanded then "▼ " else "▶ " ) ] , text (String.fromInt year) ] , text (String.fromInt period) , capitalSumView payed , text (Round.round 2 pending_principal) ] ) else if yearExpanded then tr [] (List.map (\t -> td [ class "px-3 py-1 border border-gray-300" ] [ t ]) [ text "" , text (String.fromInt period) , capitalSumView payed , text (Round.round 2 pending_principal) ] ) else text "" simView : Model -> Simulation -> Html Msg simView m { history, topay, payed } = div [] [ historyView m history , div [] [ text "to pay: ", capitalSumView topay ] , div [] [ text "payed: ", capitalSumView payed ] ] view : Model -> Html Msg view m = div [ class "flex flex-row max-w-sm mx-auto" ] [ div [ class "flex flex-col items-center" ] [ specsView m.simSpecsTxt , case m.simulation of Nothing -> text "" Just sim -> simView m sim , div [] [ text m.error ] ] ]