URLs

1 files changed, 151 insertions, 35 deletions

diff --git a/front/src/Main.elm b/front/src/Main.elm
index 4ead1d6..35ec06d 100644
--- a/front/src/Main.elm
+++ b/front/src/Main.elm
@@ -1,11 +1,30 @@
 module Main exposing (main)
 
-import Browser
-import Html exposing (Attribute, Html, button, div, hr, input, span, table, tbody, td, text, th, thead, tr)
+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
@@ -17,10 +36,15 @@ import Html.Attributes
         )
 import Html.Events exposing (onClick, onInput)
 import Http
-import Json.Decode exposing (Decoder, field, float, int, list, map, map2, map3, map4)
+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
 
 
 
@@ -28,7 +52,14 @@ import Set exposing (Set)
 
 
 main =
-    Browser.element { init = init, update = update, view = view, subscriptions = \_ -> Sub.none }
+    Browser.application
+        { init = init
+        , update = update
+        , view = view
+        , subscriptions = \_ -> Sub.none
+        , onUrlRequest = SetUrl
+        , onUrlChange = ChangedUrl
+        }
 
 
 
@@ -96,6 +127,47 @@ type alias SimSpecsRaw =
     }
 
 
+defaultSimSpecsRaw : SimSpecsRaw
+defaultSimSpecsRaw =
+    { title = ""
+    , totalValue = "200000"
+    , initial = "40000"
+    , financedRate = "80"
+    , i1 = "1.621"
+    , years = "30"
+    }
+
+
+simSpecsRawParser : UQ.Parser SimSpecsRaw
+simSpecsRawParser =
+    UQ.map6 SimSpecsRaw
+        (UQ.map (Maybe.withDefault defaultSimSpecsRaw.title) <| UQ.string "title")
+        (UQ.map (Maybe.withDefault defaultSimSpecsRaw.totalValue) <| UQ.string "totalValue")
+        (UQ.map (Maybe.withDefault defaultSimSpecsRaw.initial) <| UQ.string "initial")
+        (UQ.map (Maybe.withDefault defaultSimSpecsRaw.financedRate) <| UQ.string "financedRate")
+        (UQ.map (Maybe.withDefault defaultSimSpecsRaw.i1) <| UQ.string "i1")
+        (UQ.map (Maybe.withDefault defaultSimSpecsRaw.years) <| UQ.string "years")
+
+
+simSpecsRawToQS : SimSpecsRaw -> String
+simSpecsRawToQS { 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 SimSpecs =
+    { principal : Float
+    , i1 : Float
+    , years : Int
+    }
+
+
 simSpecsParse : SimSpecsRaw -> Maybe SimSpecs
 simSpecsParse { totalValue, financedRate, i1, years } =
     case
@@ -110,15 +182,9 @@ simSpecsParse { totalValue, financedRate, i1, years } =
             Nothing
 
 
-type alias SimSpecs =
-    { principal : Float
-    , i1 : Float
-    , years : Int
-    }
-
-
 type alias Model =
     { error : String
+    , navKey : Nav.Key
     , simSpecsRaw : SimSpecsRaw
     , expandedYears : Set Int
     , simulation : Maybe Simulation
@@ -157,19 +223,47 @@ runSimulation m simSpecs =
         }
 
 
-init : () -> ( Model, Cmd Msg )
-init () =
+type Route
+    = NotFound
+    | Root SimSpecsRaw
+
+
+routeQuery : Route -> SimSpecsRaw
+routeQuery route =
+    case route of
+        NotFound ->
+            defaultSimSpecsRaw
+
+        Root query ->
+            query
+
+
+routeParser : U.Parser (Route -> a) a
+routeParser =
+    U.oneOf
+        [ U.map Root (U.top <?> simSpecsRawParser)
+        ]
+
+
+toRoute : Url -> Route
+toRoute url =
+    Maybe.withDefault NotFound (U.parse routeParser url)
+
+
+init : () -> Url -> Nav.Key -> ( Model, Cmd Msg )
+init () url navKey =
     let
         simSpecsRaw =
-            { title = ""
-            , totalValue = "200000"
-            , financedRate = "80"
-            , initial = "40000"
-            , i1 = "1.621"
-            , years = "30"
-            }
+            routeQuery (toRoute url)
     in
-    ( { error = "", simSpecsRaw = simSpecsRaw, expandedYears = Set.empty, simulation = Nothing }, Cmd.none )
+    ( { navKey = navKey
+      , error = ""
+      , simSpecsRaw = simSpecsRaw
+      , expandedYears = Set.empty
+      , simulation = Nothing
+      }
+    , Cmd.none
+    )
 
 
 
@@ -210,6 +304,8 @@ type Msg
     | UpdateSimSpecs SimSpecUpdate String
     | RunSimulation SimSpecs
     | SetExpandedYears (Set Int)
+    | SetUrl UrlRequest
+    | ChangedUrl Url
 
 
 update : Msg -> Model -> ( Model, Cmd Msg )
@@ -234,14 +330,30 @@ update msg model =
             ( { model | error = errorToString err }, Cmd.none )
 
         RunSimulation specs ->
-            ( model, runSimulation model specs )
+            ( model
+            , batch
+                [ runSimulation model specs
+                , Nav.pushUrl model.navKey (simSpecsRawToQS model.simSpecsRaw)
+                ]
+            )
+
+        SetUrl (Internal url) ->
+            -- TODO
+            ( model, Nav.pushUrl model.navKey (Url.toString url) )
+
+        SetUrl (External url) ->
+            -- TODO
+            ( model, Nav.load url )
+
+        ChangedUrl url ->
+            ( model, Cmd.none )
 
         UpdateSimSpecs u val ->
             let
                 simSpecsRaw =
                     model.simSpecsRaw
 
-                newSimSpecsTxt =
+                newSimSpecsRaw =
                     case u of
                         Title ->
                             { simSpecsRaw | title = val }
@@ -276,7 +388,7 @@ update msg model =
                         Years ->
                             { simSpecsRaw | years = val }
             in
-            ( { model | simSpecsRaw = newSimSpecsTxt }, Cmd.none )
+            ( { model | simSpecsRaw = newSimSpecsRaw }, Cmd.none )
 
         SetExpandedYears eyears ->
             ( { model | expandedYears = eyears }, Cmd.none )
@@ -548,17 +660,21 @@ simView m { initial, financed } =
         ]
 
 
-view : Model -> Html Msg
+view : Model -> Document Msg
 view m =
-    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.simSpecsRaw
-            , case m.simulation of
-                Nothing ->
-                    text ""
-
-                Just sim ->
-                    simView m sim
-            , text m.error
+    { 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.simSpecsRaw
+                , case m.simulation of
+                    Nothing ->
+                        text ""
+
+                    Just sim ->
+                        simView m sim
+                , text m.error
+                ]
             ]
         ]
+    }