module Main exposing (main) import Browser exposing (Document, UrlRequest(..)) import Browser.Navigation as Nav import Html exposing ( Attribute , Html , a , button , div , hr , input , span , table , tbody , td , text , th , thead , tr ) import Html.Attributes exposing ( class , disabled , href , max , min , placeholder , step , style , title , type_ , value ) import Html.Events exposing (onClick, onInput) import Http import Json.Decode exposing (Decoder, field, float, int, list, map2, map3, map4) import Json.Encode as Encode exposing (Value, object) import Platform.Cmd exposing (batch) import Round import Set exposing (Set) import Url exposing (Url) import Url.Builder as UB import Url.Parser as U exposing (()) import Url.Parser.Query as UQ -- MAIN main = Browser.application { init = init , update = update , view = view , subscriptions = \_ -> Sub.none , onUrlRequest = SetUrl , onUrlChange = ChangedUrl } -- MODEL 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 Capital = { principal : Float , interest : Float } capitalDecoder : Decoder Capital capitalDecoder = map2 Capital (field "principal" float) (field "interest" float) type alias MortgageSim = { history : List Quota , topay : Capital , payed : Capital , payed_amortized : Float } simDecoder : Decoder MortgageSim simDecoder = map4 MortgageSim (field "history" (list quotaDecoder)) (field "topay" capitalDecoder) (field "payed" capitalDecoder) (field "payed_amortized" float) type alias RawSpecs = { title : String , totalValue : String , initial : String , financedRate : String , i1 : String , years : String } defaultRawSpecs : RawSpecs defaultRawSpecs = { title = "" , totalValue = "200000" , initial = "40000" , financedRate = "80" , i1 = "1.621" , years = "30" } rawSpecsParser : UQ.Parser RawSpecs rawSpecsParser = UQ.map6 RawSpecs (UQ.map (Maybe.withDefault defaultRawSpecs.title) <| UQ.string "title") (UQ.map (Maybe.withDefault defaultRawSpecs.totalValue) <| UQ.string "totalValue") (UQ.map (Maybe.withDefault defaultRawSpecs.initial) <| UQ.string "initial") (UQ.map (Maybe.withDefault defaultRawSpecs.financedRate) <| UQ.string "financedRate") (UQ.map (Maybe.withDefault defaultRawSpecs.i1) <| UQ.string "i1") (UQ.map (Maybe.withDefault defaultRawSpecs.years) <| UQ.string "years") rawSpecsToURL : RawSpecs -> String rawSpecsToURL { title, totalValue, initial, financedRate, i1, years } = UB.toQuery <| [ UB.string "title" title , UB.string "totalValue" totalValue , UB.string "initial" initial , UB.string "financedRate" financedRate , UB.string "i1" i1 , UB.string "years" years ] type alias MortgageSpecs = { principal : Float , i1 : Float , years : Int } parseMortgageSpecs : RawSpecs -> Maybe MortgageSpecs parseMortgageSpecs { totalValue, financedRate, i1, years } = case ( List.map String.toFloat [ totalValue, i1 ] , List.map String.toInt [ financedRate, years ] ) of ( [ Just totalValueF, Just i1F ], [ Just rate, Just yearsI ] ) -> Just { principal = totalValueF * toFloat rate / 100, i1 = i1F, years = yearsI } _ -> Nothing mortgageSpecsToURL : MortgageSpecs -> String mortgageSpecsToURL { principal, i1, years } = UB.absolute [ "api", "simulate" ] [ UB.string "principal" (String.fromFloat principal) , UB.string "i1" (String.fromFloat (i1 / 100)) , UB.int "years" years ] runMortgageSim : Model -> MortgageSpecs -> Cmd Msg runMortgageSim m mortgageSpecs = Http.get { url = mortgageSpecsToURL mortgageSpecs , expect = Http.expectJson (GotMortgageSim m) simDecoder } type alias Model = { error : String , navKey : Nav.Key , rawSpecs : RawSpecs , expandedYears : Set Int , simulation : Maybe ( RawSpecs, MortgageSim ) } type Route = NotFound | Root RawSpecs routeQuery : Route -> RawSpecs routeQuery route = case route of NotFound -> defaultRawSpecs Root query -> query routeParser : U.Parser (Route -> a) a routeParser = U.oneOf [ U.map Root (U.top rawSpecsParser) ] toRoute : Url -> Route toRoute url = Maybe.withDefault NotFound (U.parse routeParser url) init : () -> Url -> Nav.Key -> ( Model, Cmd Msg ) init () url navKey = ( { navKey = navKey , error = "" , rawSpecs = routeQuery (toRoute url) , expandedYears = Set.empty , simulation = Nothing } , Cmd.none ) -- UPDATE initialToRate : Float -> Int -> Float initialToRate initial principal = 100 - (100 * initial / toFloat principal) rateToInitial : Float -> Int -> Float rateToInitial rate principal = toFloat principal * ((100 - rate) / 100) convertInitialRate : (Float -> Int -> Float) -> String -> String -> Maybe String convertInitialRate convert val totalValue = case ( String.toFloat val, String.toInt totalValue ) of ( Just x, Just totalValueF ) -> Just <| String.fromFloat <| convert x totalValueF _ -> Nothing 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 type SpecField = Title | Principal | Rate | Initial | I1 | Years type Msg = SetUrl UrlRequest | ChangedUrl Url | UpdateSpecs SpecField String | RunMortgageSim MortgageSpecs | GotMortgageSim Model (Result Http.Error MortgageSim) | SetExpandedYears (Set Int) update : Msg -> Model -> ( Model, Cmd Msg ) update msg m = let _ = Debug.log "UPDATE!" msg in case msg of GotMortgageSim old_m (Ok msim) -> ( { m | simulation = Just ( old_m.rawSpecs, msim ) } , Cmd.none ) GotMortgageSim _ (Err err) -> ( { m | error = errorToString err }, Cmd.none ) RunMortgageSim specs -> ( m , batch [ runMortgageSim m specs , Nav.pushUrl m.navKey (rawSpecsToURL m.rawSpecs) ] ) SetUrl (Internal url) -> ( m, Nav.pushUrl m.navKey (Url.toString url) ) SetUrl (External url) -> ( m, Nav.load url ) ChangedUrl url -> ( { m | rawSpecs = routeQuery (toRoute url) }, Cmd.none ) UpdateSpecs field val -> let rawSpecs = m.rawSpecs newRawSpecs = case field of Title -> { rawSpecs | title = val } Principal -> { rawSpecs | totalValue = val , initial = Maybe.withDefault rawSpecs.initial <| convertInitialRate rateToInitial rawSpecs.financedRate val } Rate -> { rawSpecs | financedRate = val , initial = Maybe.withDefault rawSpecs.initial <| convertInitialRate rateToInitial val rawSpecs.totalValue } Initial -> { rawSpecs | initial = val , financedRate = Maybe.withDefault rawSpecs.financedRate <| convertInitialRate initialToRate val rawSpecs.totalValue } I1 -> { rawSpecs | i1 = val } Years -> { rawSpecs | years = val } in ( { m | rawSpecs = newRawSpecs }, Cmd.none ) SetExpandedYears eyears -> ( { m | 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" ] txtInput : List (Attribute Msg) -> (String -> Msg) -> String -> Html Msg txtInput attributes onInputMsg valueTxt = input ([ class "border border-lime-500 border-2 px-2 focus:outline focus:outline-lime-500" , onInput onInputMsg , value valueTxt ] ++ attributes ) [] slider : List (Attribute Msg) -> (String -> Msg) -> String -> Html Msg slider attributes onInputMsg valueTxt = input (attributes ++ [ type_ "range" , class "mx-1 accent-lime-400" , onInput onInputMsg , value valueTxt ] ) [] -- VIEW specsView : RawSpecs -> Html Msg specsView rawSpecs = let { title, totalValue, financedRate, initial, i1, years } = rawSpecs simButAttrs = case parseMortgageSpecs rawSpecs of Nothing -> [ disabled True ] Just specs -> [ onClick (RunMortgageSim specs) ] in div [] [ div [] [ input [ class "min-w-full mb-2 py-1 px-3 text-xl font-bold lime-100" , placeholder "Title..." , value title , onInput (UpdateSpecs Title) ] [] ] , div [ class "flex my-1" ] [ text "Property price: " , slider [ Html.Attributes.min "0", Html.Attributes.max "1000000", step "5000" ] (UpdateSpecs Principal) totalValue , txtInput [ class "w-[100px]", Html.Attributes.min "0", Html.Attributes.max "1000000" ] (UpdateSpecs Principal) totalValue ] , div [ class "flex my-1" ] [ div [ class "" ] [ text "Initial contribution: " , txtInput [ class "w-[100px]", Html.Attributes.min "0", Html.Attributes.max totalValue ] (UpdateSpecs Initial) initial ] , div [ class "ml-4" ] [ text " (" , txtInput [ class "w-[55px]", Html.Attributes.min "10", Html.Attributes.max "100" ] (UpdateSpecs Rate) financedRate , text "%)" ] ] , div [ class "my-1" ] [ text "Interest rate: " , txtInput [ class "w-[80px]", Html.Attributes.min "0", Html.Attributes.max "100" ] (UpdateSpecs I1) i1 , text " % (nominal)" ] , div [ class "flex my-1 mb-2" ] [ text "Years: " , slider [ Html.Attributes.min "1", Html.Attributes.max "50", step "1" ] (UpdateSpecs Years) years , text years ] , 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 "pt-4 flex flex-col items-center" ] [ table [ class "border border-collapse bg-gray-50 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 , " (" , Round.round 2 (100 * interest / (principal + interest)) , "% from total)" ] 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 -> ( RawSpecs, MortgageSim ) -> Html Msg simView m ( rawSpecs, { history, topay, payed } ) = let initial = Maybe.withDefault 0 <| String.toFloat rawSpecs.initial total = topay.principal + topay.interest + initial in div [] [ hr [ class "my-5" ] [] , div [] [ text "To pay: " , text <| Round.round 2 total , text " (" , text <| Round.round 2 initial , text " initial + " , capitalSumView topay , text " financed)" ] -- , div [] [ text "payed: ", capitalSumView payed ] , historyView m history ] view : Model -> Document Msg view m = { title = "Hiccup" , body = [ div [ class "flex flex-col max-w-lg mx-auto items-center mt-2 p-3 border-2 rounded-md border-gray-500 bg-gray-100" ] [ div [ class "min-w-full" ] [ specsView m.rawSpecs , case m.simulation of Nothing -> text "" Just sim -> simView m sim , text m.error ] ] ] }