ui: Get UI to compile with Elm 0.19

2025-12-17 17:47:03 +00:00 · 2018-11-13 22:03:36 -08:00
parent 5ccdece541
commit fe20854173
15 changed files with 210 additions and 180 deletions
--- a/ui/elm-package.json
+++ b/ui/elm-package.json
@@ -1,35 +0,0 @@
-{
-    "version": "1.0.0",
-    "summary": "Elm powered UI for Inbucket",
-    "repository": "https://github.com/jhillyerd/inbucket.git",
-    "license": "MIT",
-    "source-directories": [
-        "src"
-    ],
-    "exposed-modules": [],
-    "proxy": {
-      "/api": {
-        "target": "http://localhost:9000",
-        "ws": true
-      },
-      "/debug": {
-        "target": "http://localhost:9000"
-      },
-      "/serve": {
-        "target": "http://localhost:9000"
-      }
-    },
-    "dependencies": {
-        "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
-        "basti1302/elm-human-readable-filesize": "1.1.0 <= v < 2.0.0",
-        "elm-lang/core": "5.1.1 <= v < 6.0.0",
-        "elm-lang/html": "2.0.0 <= v < 3.0.0",
-        "elm-lang/http": "1.0.0 <= v < 2.0.0",
-        "elm-lang/navigation": "2.1.0 <= v < 3.0.0",
-        "elm-lang/svg": "2.0.0 <= v < 3.0.0",
-        "evancz/url-parser": "2.0.1 <= v < 3.0.0",
-        "jweir/sparkline": "3.0.0 <= v < 4.0.0",
-        "ryannhg/elm-date-format": "2.1.2 <= v < 3.0.0"
-    },
-    "elm-version": "0.18.0 <= v < 0.19.0"
-}
--- a/ui/elm.json
+++ b/ui/elm.json
@@ -0,0 +1,32 @@
+{
+    "type": "application",
+    "source-directories": [
+        "src"
+    ],
+    "elm-version": "0.19.0",
+    "dependencies": {
+        "direct": {
+            "NoRedInk/elm-json-decode-pipeline": "1.0.0",
+            "basti1302/elm-human-readable-filesize": "1.1.1",
+            "elm/browser": "1.0.1",
+            "elm/core": "1.0.0",
+            "elm/html": "1.0.0",
+            "elm/http": "1.0.0",
+            "elm/json": "1.0.0",
+            "elm/svg": "1.0.1",
+            "elm/time": "1.0.0",
+            "elm/url": "1.0.0",
+            "jweir/sparkline": "4.0.0",
+            "ryannhg/date-format": "2.1.0"
+        },
+        "indirect": {
+            "elm/regex": "1.0.0",
+            "elm/virtual-dom": "1.0.2",
+            "myrho/elm-round": "1.0.4"
+        }
+    },
+    "test-dependencies": {
+        "direct": {},
+        "indirect": {}
+    }
+}
--- a/ui/src/Data/Date.elm
+++ b/ui/src/Data/Date.elm
@@ -1,21 +1,11 @@
 module Data.Date exposing (date)

-import Date exposing (Date)
 import Json.Decode as Decode exposing (..)
+import Time exposing (Posix)


-{-| Decode an ISO 8601 date
+{-| Decode a POSIX milliseconds timestamp. Currently faked until backend API is updated.
 -}
-date : Decoder Date
+date : Decoder Posix
 date =
-    let
-        convert : String -> Decoder Date
-        convert raw =
-            case Date.fromString raw of
-                Ok date ->
-                    succeed date
-
-                Err error ->
-                    fail error
-    in
-    string |> andThen convert
+    succeed (Time.millisToPosix 0)
--- a/ui/src/Data/Message.elm
+++ b/ui/src/Data/Message.elm
@@ -1,9 +1,9 @@
 module Data.Message exposing (Attachment, Message, attachmentDecoder, decoder)

 import Data.Date exposing (date)
-import Date exposing (Date)
 import Json.Decode as Decode exposing (..)
 import Json.Decode.Pipeline exposing (..)
+import Time exposing (Posix)


 type alias Message =
@@ -12,7 +12,7 @@ type alias Message =
    , from : String
    , to : List String
    , subject : String
-    , date : Date
+    , date : Posix
    , size : Int
    , seen : Bool
    , text : String
@@ -30,7 +30,7 @@ type alias Attachment =

 decoder : Decoder Message
 decoder =
-    decode Message
+    succeed Message
        |> required "mailbox" string
        |> required "id" string
        |> optional "from" string ""
@@ -46,7 +46,7 @@ decoder =

 attachmentDecoder : Decoder Attachment
 attachmentDecoder =
-    decode Attachment
+    succeed Attachment
        |> required "id" string
        |> required "filename" string
        |> required "content-type" string
--- a/ui/src/Data/MessageHeader.elm
+++ b/ui/src/Data/MessageHeader.elm
@@ -1,9 +1,9 @@
 module Data.MessageHeader exposing (MessageHeader, decoder)

 import Data.Date exposing (date)
-import Date exposing (Date)
 import Json.Decode as Decode exposing (..)
 import Json.Decode.Pipeline exposing (..)
+import Time exposing (Posix)


 type alias MessageHeader =
@@ -12,7 +12,7 @@ type alias MessageHeader =
    , from : String
    , to : List String
    , subject : String
-    , date : Date
+    , date : Posix
    , size : Int
    , seen : Bool
    }
@@ -20,7 +20,7 @@ type alias MessageHeader =

 decoder : Decoder MessageHeader
 decoder =
-    decode MessageHeader
+    succeed MessageHeader
        |> required "mailbox" string
        |> required "id" string
        |> optional "from" string ""
--- a/ui/src/Data/Metrics.elm
+++ b/ui/src/Data/Metrics.elm
@@ -31,7 +31,7 @@ type alias Metrics =

 decoder : Decoder Metrics
 decoder =
-    decode Metrics
+    succeed Metrics
        |> requiredAt [ "memstats", "Sys" ] int
        |> requiredAt [ "memstats", "HeapSys" ] int
        |> requiredAt [ "memstats", "HeapAlloc" ] int
@@ -59,4 +59,4 @@ decoder =
 -}
 decodeIntList : Decoder (List Int)
 decodeIntList =
-    map (String.split "," >> List.map (String.toInt >> Result.withDefault 0)) string
+    map (String.split "," >> List.map (String.toInt >> Maybe.withDefault 0)) string
--- a/ui/src/Data/Session.elm
+++ b/ui/src/Data/Session.elm
@@ -9,13 +9,15 @@ module Data.Session exposing
    , update
    )

-import Json.Decode as Decode exposing (..)
+import Browser.Navigation as Nav
+import Json.Decode exposing (..)
 import Json.Decode.Pipeline exposing (..)
-import Navigation exposing (Location)
+import Url exposing (Url)


 type alias Session =
-    { host : String
+    { key : Nav.Key
+    , host : String
    , flash : String
    , routing : Bool
    , persistent : Persistent
@@ -36,9 +38,9 @@ type Msg
    | AddRecent String


-init : Location -> Persistent -> Session
-init location persistent =
-    Session location.host "" True persistent
+init : Nav.Key -> Url -> Persistent -> Session
+init key location persistent =
+    Session key location.host "" True persistent


 update : Msg -> Session -> Session
@@ -84,10 +86,10 @@ none =

 decoder : Decoder Persistent
 decoder =
-    decode Persistent
+    succeed Persistent
        |> optional "recentMailboxes" (list string) []


 decodeValueWithDefault : Value -> Persistent
 decodeValueWithDefault =
-    Decode.decodeValue decoder >> Result.withDefault { recentMailboxes = [] }
+    decodeValue decoder >> Result.withDefault { recentMailboxes = [] }
--- a/ui/src/HttpUtil.elm
+++ b/ui/src/HttpUtil.elm
@@ -42,11 +42,11 @@ errorString error =
            "HTTP Network error"

        Http.BadStatus res ->
-            "Bad HTTP status: " ++ toString res.status.code
+            "Bad HTTP status: " ++ String.fromInt res.status.code

        Http.BadPayload msg res ->
            "Bad HTTP payload: "
                ++ msg
                ++ " ("
-                ++ toString res.status.code
+                ++ String.fromInt res.status.code
                ++ ")"
--- a/ui/src/Main.elm
+++ b/ui/src/Main.elm
@@ -1,15 +1,31 @@
-module Main exposing (Model, Msg(..), Page(..), applySession, init, main, pageSubscriptions, sessionChange, setRoute, subscriptions, update, updatePage, view)
+module Main exposing
+    ( Model
+    , Msg(..)
+    , Page(..)
+    , applySession
+    , init
+    , main
+    , pageSubscriptions
+    , sessionChange
+    , setRoute
+    , subscriptions
+    , update
+    , updatePage
+    , view
+    )

+import Browser exposing (Document, UrlRequest)
+import Browser.Navigation as Nav
 import Data.Session as Session exposing (Session, decoder)
 import Html exposing (..)
-import Json.Decode as Decode exposing (Value)
-import Navigation exposing (Location)
+import Json.Decode as D exposing (Value)
 import Page.Home as Home
 import Page.Mailbox as Mailbox
 import Page.Monitor as Monitor
 import Page.Status as Status
 import Ports
 import Route exposing (Route)
+import Url exposing (Url)
 import Views.Page as Page exposing (ActivePage(..), frame)


@@ -31,11 +47,11 @@ type alias Model =
    }


-init : Value -> Location -> ( Model, Cmd Msg )
-init sessionValue location =
+init : Value -> Url -> Nav.Key -> ( Model, Cmd Msg )
+init sessionValue location key =
    let
        session =
-            Session.init location (Session.decodeValueWithDefault sessionValue)
+            Session.init key location (Session.decodeValueWithDefault sessionValue)

        ( subModel, _ ) =
            Home.init
@@ -47,15 +63,16 @@ init sessionValue location =
            }

        route =
-            Route.fromLocation location
+            Route.fromUrl location
    in
    applySession (setRoute route model)


 type Msg
    = SetRoute Route
-    | NewRoute Route
-    | UpdateSession (Result String Session.Persistent)
+    | UrlChanged Url
+    | LinkClicked UrlRequest
+    | UpdateSession (Result D.Error Session.Persistent)
    | MailboxNameInput String
    | ViewMailbox String
    | HomeMsg Home.Msg
@@ -76,9 +93,9 @@ subscriptions model =
        ]


-sessionChange : Sub (Result String Session.Persistent)
+sessionChange : Sub (Result D.Error Session.Persistent)
 sessionChange =
-    Ports.onSessionChange (Decode.decodeValue Session.decoder)
+    Ports.onSessionChange (D.decodeValue Session.decoder)


 pageSubscriptions : Page -> Sub Msg
@@ -105,19 +122,27 @@ update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
    applySession <|
        case msg of
-            SetRoute route ->
-                -- Updates broser URL to requested route.
-                ( model, Route.newUrl route, Session.none )
+            LinkClicked req ->
+                case req of
+                    Browser.Internal url ->
+                        ( model, Nav.pushUrl model.session.key (Url.toString url), Session.none )

-            NewRoute route ->
+                    _ ->
+                        Debug.todo "implement external links"
+
+            UrlChanged url ->
                -- Responds to new browser URL.
                if model.session.routing then
-                    setRoute route model
+                    setRoute (Route.fromUrl url) model

                else
                    -- Skip once, but re-enable routing.
                    ( model, Cmd.none, Session.EnableRouting )

+            SetRoute route ->
+                -- Updates broser URL to requested route.
+                ( model, Route.newUrl model.session.key route, Session.none )
+
            UpdateSession (Ok persistent) ->
                let
                    session =
@@ -140,7 +165,7 @@ update msg model =

            ViewMailbox name ->
                ( { model | mailboxName = "" }
-                , Route.newUrl (Route.Mailbox name)
+                , Route.newUrl model.session.key (Route.Mailbox name)
                , Session.none
                )

@@ -269,7 +294,7 @@ applySession ( model, cmd, sessionMsg ) =
 -- VIEW


-view : Model -> Html Msg
+view : Model -> Document Msg
 view model =
    let
        mailbox =
@@ -291,22 +316,24 @@ view model =
        frame =
            Page.frame controls model.session
    in
-    case model.page of
-        Home subModel ->
-            Html.map HomeMsg (Home.view model.session subModel)
-                |> frame Page.Other
+    Document "Inbucket Document"
+        [ case model.page of
+            Home subModel ->
+                Html.map HomeMsg (Home.view model.session subModel)
+                    |> frame Page.Other

-        Mailbox subModel ->
-            Html.map MailboxMsg (Mailbox.view model.session subModel)
-                |> frame Page.Mailbox
+            Mailbox subModel ->
+                Html.map MailboxMsg (Mailbox.view model.session subModel)
+                    |> frame Page.Mailbox

-        Monitor subModel ->
-            Html.map MonitorMsg (Monitor.view model.session subModel)
-                |> frame Page.Monitor
+            Monitor subModel ->
+                Html.map MonitorMsg (Monitor.view model.session subModel)
+                    |> frame Page.Monitor

-        Status subModel ->
-            Html.map StatusMsg (Status.view model.session subModel)
-                |> frame Page.Status
+            Status subModel ->
+                Html.map StatusMsg (Status.view model.session subModel)
+                    |> frame Page.Status
+        ]



@@ -315,9 +342,11 @@ view model =

 main : Program Value Model Msg
 main =
-    Navigation.programWithFlags (Route.fromLocation >> NewRoute)
+    Browser.application
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
+        , onUrlChange = UrlChanged
+        , onUrlRequest = LinkClicked
        }
--- a/ui/src/Page/Mailbox.elm
+++ b/ui/src/Page/Mailbox.elm
@@ -3,7 +3,6 @@ module Page.Mailbox exposing (Model, Msg, init, load, subscriptions, update, vie
 import Data.Message as Message exposing (Message)
 import Data.MessageHeader as MessageHeader exposing (MessageHeader)
 import Data.Session as Session exposing (Session)
-import Date exposing (Date)
 import DateFormat
 import DateFormat.Relative as Relative
 import Html exposing (..)
@@ -11,7 +10,7 @@ import Html.Attributes
    exposing
        ( class
        , classList
-        , downloadAs
+        , download
        , href
        , id
        , placeholder
@@ -28,7 +27,7 @@ import Json.Encode as Encode
 import Ports
 import Route
 import Task
-import Time exposing (Time)
+import Time exposing (Posix)



@@ -65,7 +64,7 @@ type alias MessageList =

 type alias VisibleMessage =
    { message : Message
-    , markSeenAt : Maybe Time
+    , markSeenAt : Maybe Int
    }


@@ -74,13 +73,13 @@ type alias Model =
    , state : State
    , bodyMode : Body
    , searchInput : String
-    , now : Date
+    , now : Posix
    }


 init : String -> Maybe MessageID -> ( Model, Cmd Msg )
 init mailboxName selection =
-    ( Model mailboxName (LoadingList selection) SafeHtmlBody "" (Date.fromTime 0)
+    ( Model mailboxName (LoadingList selection) SafeHtmlBody "" (Time.millisToPosix 0)
    , load mailboxName
    )

@@ -108,13 +107,13 @@ subscriptions model =
                        Sub.none

                    else
-                        Time.every (250 * Time.millisecond) SeenTick
+                        Time.every 250 SeenTick

                _ ->
                    Sub.none
    in
    Sub.batch
-        [ Time.every (30 * Time.second) Tick
+        [ Time.every (30 * 1000) Tick
        , subSeen
        ]

@@ -131,12 +130,12 @@ type Msg
    | MarkSeenResult (Result Http.Error ())
    | MessageResult (Result Http.Error Message)
    | MessageBody Body
-    | OpenedTime Time
+    | OpenedTime Posix
    | Purge
    | PurgeResult (Result Http.Error ())
    | SearchInput String
-    | SeenTick Time
-    | Tick Time
+    | SeenTick Posix
+    | Tick Posix
    | ViewMessage MessageID


@@ -147,7 +146,7 @@ update session msg model =
            ( updateSelected model id
            , Cmd.batch
                [ -- Update browser location.
-                  Route.newUrl (Route.Message model.mailboxName id)
+                  Route.newUrl session.key (Route.Message model.mailboxName id)
                , getMessage model.mailboxName id
                ]
            , Session.DisableRouting
@@ -216,13 +215,17 @@ update session msg model =
                        ( model, Cmd.none, Session.none )

                    else
-                        -- Set delay before reporting message as seen to backend.
+                        -- Set 1500ms delay before reporting message as seen to backend.
+                        let
+                            markSeenAt =
+                                Time.posixToMillis time + 1500
+                        in
                        ( { model
                            | state =
                                ShowingList list
                                    (ShowingMessage
                                        { visible
-                                            | markSeenAt = Just (time + (1.5 * Time.second))
+                                            | markSeenAt = Just markSeenAt
                                        }
                                    )
                          }
@@ -247,7 +250,7 @@ update session msg model =
                ShowingList _ (ShowingMessage { message, markSeenAt }) ->
                    case markSeenAt of
                        Just deadline ->
-                            if now >= deadline then
+                            if Time.posixToMillis now >= deadline then
                                updateMarkMessageSeen model message

                            else
@@ -260,7 +263,7 @@ update session msg model =
                    ( model, Cmd.none, Session.none )

        Tick now ->
-            ( { model | now = Date.fromTime now }, Cmd.none, Session.none )
+            ( { model | now = now }, Cmd.none, Session.none )


 {-| Replace the currently displayed message.
@@ -530,14 +533,14 @@ messageChip model selected message =
 viewMessage : Message -> Body -> Html Msg
 viewMessage message bodyMode =
    let
-        sourceUrl message =
+        sourceUrl =
            "/serve/m/" ++ message.mailbox ++ "/" ++ message.id ++ "/source"
    in
    div []
        [ div [ class "button-bar" ]
            [ button [ class "danger", onClick (DeleteMessage message) ] [ text "Delete" ]
            , a
-                [ href (sourceUrl message), target "_blank" ]
+                [ href sourceUrl, target "_blank" ]
                [ button [] [ text "Source" ] ]
            ]
        , dl [ id "message-header" ]
@@ -616,16 +619,16 @@ attachmentRow baseUrl attach =
            [ a [ href url, target "_blank" ] [ text attach.fileName ]
            , text (" (" ++ attach.contentType ++ ") ")
            ]
-        , td [] [ a [ href url, downloadAs attach.fileName, class "button" ] [ text "Download" ] ]
+        , td [] [ a [ href url, download attach.fileName, class "button" ] [ text "Download" ] ]
        ]


-relativeDate : Model -> Date -> Html Msg
+relativeDate : Model -> Posix -> Html Msg
 relativeDate model date =
    Relative.relativeTime model.now date |> text


-verboseDate : Date -> Html Msg
+verboseDate : Posix -> Html Msg
 verboseDate date =
    DateFormat.format
        [ DateFormat.monthNameFull
@@ -642,6 +645,7 @@ verboseDate date =
        , DateFormat.text " "
        , DateFormat.amPmUppercase
        ]
+        Time.utc
        date
        |> text

--- a/ui/src/Page/Monitor.elm
+++ b/ui/src/Page/Monitor.elm
@@ -2,7 +2,6 @@ module Page.Monitor exposing (Model, Msg, init, subscriptions, update, view)

 import Data.MessageHeader as MessageHeader exposing (MessageHeader)
 import Data.Session as Session exposing (Session)
-import Date exposing (Date)
 import DateFormat
    exposing
        ( amPmUppercase
@@ -10,7 +9,7 @@ import DateFormat
        , format
        , hourNumber
        , minuteFixed
-        , monthNameFirstThree
+        , monthNameAbbreviated
        )
 import Html exposing (..)
 import Html.Attributes exposing (..)
@@ -18,6 +17,7 @@ import Html.Events as Events
 import Json.Decode as D
 import Ports
 import Route
+import Time exposing (Posix)



@@ -63,7 +63,7 @@ subscriptions model =


 type Msg
-    = MonitorResult (Result String MonitorMessage)
+    = MonitorResult (Result D.Error MonitorMessage)
    | OpenMessage MessageHeader


@@ -78,15 +78,15 @@ update session msg model =
        MonitorResult (Ok (Connected status)) ->
            ( { model | connected = status }, Cmd.none, Session.none )

-        MonitorResult (Ok (Message msg)) ->
-            ( { model | messages = msg :: model.messages }, Cmd.none, Session.none )
+        MonitorResult (Ok (Message header)) ->
+            ( { model | messages = header :: model.messages }, Cmd.none, Session.none )

        MonitorResult (Err err) ->
-            ( model, Cmd.none, Session.SetFlash err )
+            ( model, Cmd.none, Session.SetFlash (D.errorToString err) )

-        OpenMessage msg ->
+        OpenMessage header ->
            ( model
-            , Route.newUrl (Route.Message msg.mailbox msg.id)
+            , Route.newUrl session.key (Route.Message header.mailbox header.id)
            , Session.none
            )

@@ -133,12 +133,12 @@ viewMessage message =
        ]


-shortDate : Date -> Html Msg
+shortDate : Posix -> Html Msg
 shortDate date =
    format
        [ dayOfMonthFixed
        , DateFormat.text "-"
-        , monthNameFirstThree
+        , monthNameAbbreviated
        , DateFormat.text " "
        , hourNumber
        , DateFormat.text ":"
@@ -146,5 +146,6 @@ shortDate date =
        , DateFormat.text " "
        , amPmUppercase
        ]
+        Time.utc
        date
        |> text
--- a/ui/src/Page/Status.elm
+++ b/ui/src/Page/Status.elm
@@ -9,7 +9,7 @@ import Http exposing (Error)
 import HttpUtil
 import Sparkline exposing (DataSet, Point, Size, sparkline)
 import Svg.Attributes as SvgAttrib
-import Time exposing (Time)
+import Time exposing (Posix)



@@ -84,7 +84,7 @@ load =

 subscriptions : Model -> Sub Msg
 subscriptions model =
-    Time.every (10 * Time.second) Tick
+    Time.every (10 * 1000) Tick



@@ -93,7 +93,7 @@ subscriptions model =

 type Msg
    = NewMetrics (Result Http.Error Metrics)
-    | Tick Time
+    | Tick Posix


 update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg )
@@ -256,7 +256,7 @@ viewMetric metric =
        , div [ class "value" ] [ text (metric.formatter metric.value) ]
        , div [ class "graph" ]
            [ metric.graph metric.history
-            , text ("(" ++ toString metric.minutes ++ "min)")
+            , text ("(" ++ String.fromInt metric.minutes ++ "min)")
            ]
        ]

@@ -280,7 +280,11 @@ graphNull =

 graphSize : Size
 graphSize =
-    ( 180, 16, 0, 0 )
+    { width = 180
+    , height = 16
+    , marginLR = 0
+    , marginTB = 0
+    }


 areaStyle : Sparkline.Param a -> Sparkline.Param a
@@ -400,4 +404,4 @@ fmtInt n =
            else
                thousands (String.slice 0 -3 str) ++ "," ++ String.right 3 str
    in
-    thousands (toString n)
+    thousands (String.fromInt n)
--- a/ui/src/Route.elm
+++ b/ui/src/Route.elm
@@ -1,9 +1,10 @@
-module Route exposing (Route(..), fromLocation, href, modifyUrl, newUrl)
+module Route exposing (Route(..), fromUrl, href, modifyUrl, newUrl)

+import Browser.Navigation as Navigation exposing (Key)
 import Html exposing (Attribute)
 import Html.Attributes as Attr
-import Navigation exposing (Location)
-import UrlParser as Url exposing ((</>), Parser, parseHash, s, string)
+import Url exposing (Url)
+import Url.Parser as Parser exposing ((</>), Parser, map, oneOf, s, string, top)


 type Route
@@ -15,14 +16,14 @@ type Route
    | Status


-matcher : Parser (Route -> a) a
-matcher =
-    Url.oneOf
-        [ Url.map Home (s "")
-        , Url.map Message (s "m" </> string </> string)
-        , Url.map Mailbox (s "m" </> string)
-        , Url.map Monitor (s "monitor")
-        , Url.map Status (s "status")
+routeParser : Parser (Route -> a) a
+routeParser =
+    oneOf
+        [ map Home top
+        , map Message (s "m" </> string </> string)
+        , map Mailbox (s "m" </> string)
+        , map Monitor (s "monitor")
+        , map Status (s "status")
        ]


@@ -49,37 +50,35 @@ routeToString page =
                Status ->
                    [ "status" ]
    in
-    "/#/" ++ String.join "/" pieces
+    "/" ++ String.join "/" pieces



 -- PUBLIC HELPERS


-href : Route -> Attribute msg
-href route =
+href : Key -> Route -> Attribute msg
+href key route =
    Attr.href (routeToString route)


-modifyUrl : Route -> Cmd msg
-modifyUrl =
-    routeToString >> Navigation.modifyUrl
+modifyUrl : Key -> Route -> Cmd msg
+modifyUrl key =
+    routeToString >> Navigation.replaceUrl key


-newUrl : Route -> Cmd msg
-newUrl =
-    routeToString >> Navigation.newUrl
+newUrl : Key -> Route -> Cmd msg
+newUrl key =
+    routeToString >> Navigation.pushUrl key


-fromLocation : Location -> Route
-fromLocation location =
-    if String.isEmpty location.hash then
-        Home
+{-| Returns the Route for a given URL; by matching the path after # (fragment.)
+-}
+fromUrl : Url -> Route
+fromUrl location =
+    case Parser.parse routeParser location of
+        Nothing ->
+            Unknown location.path

-    else
-        case parseHash matcher location of
-            Nothing ->
-                Unknown location.hash
-
-            Just route ->
-                route
+        Just route ->
+            route
--- a/ui/src/Views/Page.elm
+++ b/ui/src/Views/Page.elm
@@ -39,10 +39,11 @@ frame controls session page content =
    div [ id "app" ]
        [ header []
            [ ul [ class "navbar", attribute "role" "navigation" ]
-                [ li [ id "navbar-brand" ] [ a [ Route.href Route.Home ] [ text "@ inbucket" ] ]
-                , navbarLink page Route.Monitor [ text "Monitor" ]
-                , navbarLink page Route.Status [ text "Status" ]
-                , navbarRecent page controls
+                [ li [ id "navbar-brand" ]
+                    [ a [ Route.href session.key Route.Home ] [ text "@ inbucket" ] ]
+                , navbarLink session page Route.Monitor [ text "Monitor" ]
+                , navbarLink session page Route.Status [ text "Status" ]
+                , navbarRecent session page controls
                , li [ id "navbar-mailbox" ]
                    [ form [ Events.onSubmit (controls.viewMailbox controls.mailboxValue) ]
                        [ input
@@ -70,19 +71,19 @@ frame controls session page content =
        ]


-navbarLink : ActivePage -> Route -> List (Html a) -> Html a
-navbarLink page route linkContent =
+navbarLink : Session -> ActivePage -> Route -> List (Html a) -> Html a
+navbarLink session page route linkContent =
    li [ classList [ ( "navbar-active", isActive page route ) ] ]
-        [ a [ Route.href route ] linkContent ]
+        [ a [ Route.href session.key route ] linkContent ]


 {-| Renders list of recent mailboxes, selecting the currently active mailbox.
 -}
-navbarRecent : ActivePage -> FrameControls msg -> Html msg
-navbarRecent page controls =
+navbarRecent : Session -> ActivePage -> FrameControls msg -> Html msg
+navbarRecent session page controls =
    let
        recentItemLink mailbox =
-            a [ Route.href (Route.Mailbox mailbox) ] [ text mailbox ]
+            a [ Route.href session.key (Route.Mailbox mailbox) ] [ text mailbox ]

        active =
            page == Mailbox
--- a/ui/src/index.js
+++ b/ui/src/index.js
@@ -1,10 +1,13 @@
 import './main.css'
-import { Main } from './Main.elm'
+import { Elm } from './Main.elm'
 import registerServiceWorker from './registerServiceWorker'
 import registerMonitorPorts from './registerMonitor'

 // App startup.
-var app = Main.embed(document.getElementById('root'), sessionObject())
+var app = Elm.Main.init({
+  node: document.getElementById('root'),
+  flags: sessionObject()
+})

 // Message monitor.
 registerMonitorPorts(app)