diff --git a/ui/src/Data/Date.elm b/ui/src/Data/Date.elm index 2595f4c..51ab39c 100644 --- a/ui/src/Data/Date.elm +++ b/ui/src/Data/Date.elm @@ -1,6 +1,6 @@ module Data.Date exposing (date) -import Json.Decode as Decode exposing (..) +import Json.Decode exposing (..) import Time exposing (Posix) @@ -8,4 +8,4 @@ import Time exposing (Posix) -} date : Decoder Posix date = - int |> andThen (Time.millisToPosix >> succeed) + int |> map Time.millisToPosix diff --git a/ui/src/Data/Message.elm b/ui/src/Data/Message.elm index acd77fa..54c568d 100644 --- a/ui/src/Data/Message.elm +++ b/ui/src/Data/Message.elm @@ -1,7 +1,7 @@ module Data.Message exposing (Attachment, Message, attachmentDecoder, decoder) import Data.Date exposing (date) -import Json.Decode as Decode exposing (..) +import Json.Decode exposing (..) import Json.Decode.Pipeline exposing (..) import Time exposing (Posix) diff --git a/ui/src/Data/MessageHeader.elm b/ui/src/Data/MessageHeader.elm index b791303..e796201 100644 --- a/ui/src/Data/MessageHeader.elm +++ b/ui/src/Data/MessageHeader.elm @@ -1,7 +1,7 @@ module Data.MessageHeader exposing (MessageHeader, decoder) import Data.Date exposing (date) -import Json.Decode as Decode exposing (..) +import Json.Decode exposing (..) import Json.Decode.Pipeline exposing (..) import Time exposing (Posix) diff --git a/ui/src/Data/Metrics.elm b/ui/src/Data/Metrics.elm index dcc3076..cbe0821 100644 --- a/ui/src/Data/Metrics.elm +++ b/ui/src/Data/Metrics.elm @@ -59,4 +59,6 @@ decoder = -} decodeIntList : Decoder (List Int) decodeIntList = - map (String.split "," >> List.map (String.toInt >> Maybe.withDefault 0)) string + string + |> map (String.split ",") + |> map (List.map (String.toInt >> Maybe.withDefault 0)) diff --git a/ui/src/Main.elm b/ui/src/Main.elm index c2b3f91..5c2e95d 100644 --- a/ui/src/Main.elm +++ b/ui/src/Main.elm @@ -1,18 +1,4 @@ -module Main exposing - ( Model - , Msg(..) - , Page(..) - , applySession - , init - , main - , pageSubscriptions - , sessionChange - , setRoute - , subscriptions - , update - , updatePage - , view - ) +module Main exposing (main) import Browser exposing (Document, UrlRequest) import Browser.Navigation as Nav @@ -73,7 +59,7 @@ type Msg | UrlChanged Url | LinkClicked UrlRequest | UpdateSession (Result D.Error Session.Persistent) - | MailboxNameInput String + | OnMailboxNameInput String | ViewMailbox String | HomeMsg Home.Msg | MailboxMsg Mailbox.Msg @@ -159,7 +145,7 @@ update msg model = , Session.SetFlash ("Error decoding session: " ++ D.errorToString error) ) - MailboxNameInput name -> + OnMailboxNameInput name -> ( { model | mailboxName = name }, Cmd.none, Session.none ) ViewMailbox name -> @@ -303,7 +289,7 @@ view model = controls = { viewMailbox = ViewMailbox - , mailboxOnInput = MailboxNameInput + , mailboxOnInput = OnMailboxNameInput , mailboxValue = model.mailboxName , recentOptions = model.session.persistent.recentMailboxes , recentActive = mailbox diff --git a/ui/src/Page/Home.elm b/ui/src/Page/Home.elm index 9611f8c..baf0cab 100644 --- a/ui/src/Page/Home.elm +++ b/ui/src/Page/Home.elm @@ -19,32 +19,31 @@ type alias Model = init : ( Model, Cmd Msg ) init = + let + cmdGreeting = + Http.get + { url = "/serve/greeting" + , expect = Http.expectString GreetingLoaded + } + in ( Model "", cmdGreeting ) -cmdGreeting : Cmd Msg -cmdGreeting = - Http.get - { url = "/serve/greeting" - , expect = Http.expectString GreetingResult - } - - -- UPDATE -- type Msg - = GreetingResult (Result Http.Error String) + = GreetingLoaded (Result Http.Error String) update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) update session msg model = case msg of - GreetingResult (Ok greeting) -> + GreetingLoaded (Ok greeting) -> ( Model greeting, Cmd.none, Session.none ) - GreetingResult (Err err) -> + GreetingLoaded (Err err) -> ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) ) diff --git a/ui/src/Page/Mailbox.elm b/ui/src/Page/Mailbox.elm index acb7c52..7afed54 100644 --- a/ui/src/Page/Mailbox.elm +++ b/ui/src/Page/Mailbox.elm @@ -3,7 +3,7 @@ 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 DateFormat +import DateFormat as DF import DateFormat.Relative as Relative import Html exposing (..) import Html.Attributes @@ -106,7 +106,7 @@ subscriptions model = Sub.none else - Time.every 250 SeenTick + Time.every 250 MarkSeenTick _ -> Sub.none @@ -122,20 +122,20 @@ subscriptions model = type Msg - = ClickMessage MessageID - | DeleteMessage Message - | DeleteMessageResult (Result Http.Error ()) - | ListResult (Result Http.Error (List MessageHeader)) - | MarkSeenResult (Result Http.Error ()) - | MessageResult (Result Http.Error Message) + = ListLoaded (Result Http.Error (List MessageHeader)) + | ClickMessage MessageID + | OpenMessage MessageID + | MessageLoaded (Result Http.Error Message) | MessageBody Body | OpenedTime Posix - | Purge - | PurgeResult (Result Http.Error ()) - | SearchInput String - | SeenTick Posix + | MarkSeenTick Posix + | MarkedSeen (Result Http.Error ()) + | DeleteMessage Message + | DeletedMessage (Result Http.Error ()) + | PurgeMailbox + | PurgedMailbox (Result Http.Error ()) + | OnSearchInput String | Tick Posix - | ViewMessage MessageID update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) @@ -151,22 +151,19 @@ update session msg model = , Session.DisableRouting ) - ViewMessage id -> - ( updateSelected model id - , getMessage model.mailboxName id - , Session.AddRecent model.mailboxName - ) + OpenMessage id -> + updateOpenMessage session model id DeleteMessage message -> updateDeleteMessage model message - DeleteMessageResult (Ok _) -> + DeletedMessage (Ok _) -> ( model, Cmd.none, Session.none ) - DeleteMessageResult (Err err) -> + DeletedMessage (Err err) -> ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) ) - ListResult (Ok headers) -> + ListLoaded (Ok headers) -> case model.state of LoadingList selection -> let @@ -177,8 +174,7 @@ update session msg model = in case selection of Just id -> - -- Recurse to select message id. - update session (ViewMessage id) newModel + updateOpenMessage session newModel id Nothing -> ( newModel, Cmd.none, Session.AddRecent model.mailboxName ) @@ -186,25 +182,25 @@ update session msg model = _ -> ( model, Cmd.none, Session.none ) - ListResult (Err err) -> + ListLoaded (Err err) -> ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) ) - MarkSeenResult (Ok _) -> + MarkedSeen (Ok _) -> ( model, Cmd.none, Session.none ) - MarkSeenResult (Err err) -> + MarkedSeen (Err err) -> ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) ) - MessageResult (Ok message) -> + MessageLoaded (Ok message) -> updateMessageResult model message - MessageResult (Err err) -> + MessageLoaded (Err err) -> ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) ) MessageBody bodyMode -> ( { model | bodyMode = bodyMode }, Cmd.none, Session.none ) - SearchInput searchInput -> + OnSearchInput searchInput -> updateSearchInput model searchInput OpenedTime time -> @@ -235,16 +231,16 @@ update session msg model = _ -> ( model, Cmd.none, Session.none ) - Purge -> + PurgeMailbox -> updatePurge model - PurgeResult (Ok _) -> + PurgedMailbox (Ok _) -> ( model, Cmd.none, Session.none ) - PurgeResult (Err err) -> + PurgedMailbox (Err err) -> ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) ) - SeenTick now -> + MarkSeenTick now -> case model.state of ShowingList _ (ShowingMessage { message, markSeenAt }) -> case markSeenAt of @@ -300,7 +296,7 @@ updatePurge model = cmd = "/api/v1/mailbox/" ++ model.mailboxName - |> HttpUtil.delete PurgeResult + |> HttpUtil.delete PurgedMailbox in case model.state of ShowingList list _ -> @@ -372,7 +368,7 @@ updateDeleteMessage model message = "/api/v1/mailbox/" ++ message.mailbox ++ "/" ++ message.id cmd = - HttpUtil.delete DeleteMessageResult url + HttpUtil.delete DeletedMessage url filter f messageList = { messageList | headers = List.filter f messageList.headers } @@ -411,7 +407,7 @@ updateMarkMessageSeen model message = -- desired change in the body. Encode.object [ ( "seen", Encode.bool True ) ] |> Http.jsonBody - |> HttpUtil.patch MarkSeenResult url + |> HttpUtil.patch MarkedSeen url map f messageList = { messageList | headers = List.map f messageList.headers } @@ -434,6 +430,14 @@ updateMarkMessageSeen model message = ( model, Cmd.none, Session.none ) +updateOpenMessage : Session -> Model -> String -> ( Model, Cmd Msg, Session.Msg ) +updateOpenMessage session model id = + ( updateSelected model id + , getMessage model.mailboxName id + , Session.AddRecent model.mailboxName + ) + + getList : String -> Cmd Msg getList mailboxName = let @@ -442,7 +446,7 @@ getList mailboxName = in Http.get { url = url - , expect = Http.expectJson ListResult (Decode.list MessageHeader.decoder) + , expect = Http.expectJson ListLoaded (Decode.list MessageHeader.decoder) } @@ -454,7 +458,7 @@ getMessage mailboxName id = in Http.get { url = url - , expect = Http.expectJson MessageResult Message.decoder + , expect = Http.expectJson MessageLoaded Message.decoder } @@ -497,11 +501,11 @@ viewMessageList session model = [ input [ type_ "search" , placeholder "search" - , onInput SearchInput + , onInput OnSearchInput , value model.searchInput ] [] - , button [ onClick Purge ] [ text "Purge" ] + , button [ onClick PurgeMailbox ] [ text "Purge" ] ] , case model.state of LoadingList _ -> @@ -633,24 +637,24 @@ relativeDate model date = verboseDate : Posix -> Html Msg verboseDate date = - DateFormat.format - [ DateFormat.monthNameFull - , DateFormat.text " " - , DateFormat.dayOfMonthSuffix - , DateFormat.text ", " - , DateFormat.yearNumber - , DateFormat.text " " - , DateFormat.hourNumber - , DateFormat.text ":" - , DateFormat.minuteFixed - , DateFormat.text ":" - , DateFormat.secondFixed - , DateFormat.text " " - , DateFormat.amPmUppercase - ] - Time.utc - date - |> text + text <| + DF.format + [ DF.monthNameFull + , DF.text " " + , DF.dayOfMonthSuffix + , DF.text ", " + , DF.yearNumber + , DF.text " " + , DF.hourNumber + , DF.text ":" + , DF.minuteFixed + , DF.text ":" + , DF.secondFixed + , DF.text " " + , DF.amPmUppercase + ] + Time.utc + date diff --git a/ui/src/Page/Monitor.elm b/ui/src/Page/Monitor.elm index 7fe1ba0..1fc1e1d 100644 --- a/ui/src/Page/Monitor.elm +++ b/ui/src/Page/Monitor.elm @@ -2,15 +2,7 @@ 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 DateFormat - exposing - ( amPmUppercase - , dayOfMonthFixed - , format - , hourNumber - , minuteFixed - , monthNameAbbreviated - ) +import DateFormat as DF import Html exposing (..) import Html.Attributes exposing (..) import Html.Events as Events @@ -30,6 +22,11 @@ type alias Model = } +type MonitorMessage + = Connected Bool + | Message MessageHeader + + init : ( Model, Cmd Msg ) init = ( Model False [], Ports.monitorCommand True ) @@ -50,7 +47,7 @@ subscriptions model = |> D.decodeValue |> Ports.monitorMessage in - Sub.map MonitorResult monitorMessage + Sub.map MessageReceived monitorMessage @@ -58,25 +55,20 @@ subscriptions model = type Msg - = MonitorResult (Result D.Error MonitorMessage) + = MessageReceived (Result D.Error MonitorMessage) | OpenMessage MessageHeader -type MonitorMessage - = Connected Bool - | Message MessageHeader - - update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) update session msg model = case msg of - MonitorResult (Ok (Connected status)) -> + MessageReceived (Ok (Connected status)) -> ( { model | connected = status }, Cmd.none, Session.none ) - MonitorResult (Ok (Message header)) -> + MessageReceived (Ok (Message header)) -> ( { model | messages = header :: model.messages }, Cmd.none, Session.none ) - MonitorResult (Err err) -> + MessageReceived (Err err) -> ( model, Cmd.none, Session.SetFlash (D.errorToString err) ) OpenMessage header -> @@ -133,16 +125,16 @@ viewMessage message = shortDate : Posix -> Html Msg shortDate date = - format - [ dayOfMonthFixed - , DateFormat.text "-" - , monthNameAbbreviated - , DateFormat.text " " - , hourNumber - , DateFormat.text ":" - , minuteFixed - , DateFormat.text " " - , amPmUppercase + DF.format + [ DF.dayOfMonthFixed + , DF.text "-" + , DF.monthNameAbbreviated + , DF.text " " + , DF.hourNumber + , DF.text ":" + , DF.minuteFixed + , DF.text " " + , DF.amPmUppercase ] Time.utc date diff --git a/ui/src/Page/Status.elm b/ui/src/Page/Status.elm index 3f49d03..915d727 100644 --- a/ui/src/Page/Status.elm +++ b/ui/src/Page/Status.elm @@ -7,7 +7,7 @@ import Html exposing (..) import Html.Attributes exposing (..) import Http exposing (Error) import HttpUtil -import Sparkline exposing (DataSet, Point, Size, sparkline) +import Sparkline as Spark import Svg.Attributes as SvgAttrib import Time exposing (Posix) @@ -40,8 +40,8 @@ type alias Metric = { label : String , value : Int , formatter : Int -> String - , graph : DataSet -> Html Msg - , history : DataSet + , graph : Spark.DataSet -> Html Msg + , history : Spark.DataSet , minutes : Int } @@ -67,7 +67,7 @@ init = } -initDataSet : DataSet +initDataSet : Spark.DataSet initDataSet = List.range 0 59 |> List.map (\x -> ( toFloat x, 0 )) @@ -92,17 +92,17 @@ subscriptions model = type Msg - = NewMetrics (Result Http.Error Metrics) + = MetricsReceived (Result Http.Error Metrics) | Tick Posix update : Session -> Msg -> Model -> ( Model, Cmd Msg, Session.Msg ) update session msg model = case msg of - NewMetrics (Ok metrics) -> + MetricsReceived (Ok metrics) -> ( updateMetrics metrics model, Cmd.none, Session.none ) - NewMetrics (Err err) -> + MetricsReceived (Err err) -> ( model, Cmd.none, Session.SetFlash (HttpUtil.errorString err) ) Tick time -> @@ -209,7 +209,7 @@ getMetrics : Cmd Msg getMetrics = Http.get { url = "/debug/vars" - , expect = Http.expectJson NewMetrics Metrics.decoder + , expect = Http.expectJson MetricsReceived Metrics.decoder } @@ -283,7 +283,7 @@ graphNull = div [] [] -graphSize : Size +graphSize : Spark.Size graphSize = { width = 180 , height = 16 @@ -292,25 +292,25 @@ graphSize = } -areaStyle : Sparkline.Param a -> Sparkline.Param a +areaStyle : Spark.Param a -> Spark.Param a areaStyle = - Sparkline.Style + Spark.Style [ SvgAttrib.fill "rgba(50,100,255,0.3)" , SvgAttrib.stroke "rgba(50,100,255,1.0)" , SvgAttrib.strokeWidth "1.0" ] -barStyle : Sparkline.Param a -> Sparkline.Param a +barStyle : Spark.Param a -> Spark.Param a barStyle = - Sparkline.Style + Spark.Style [ SvgAttrib.fill "rgba(50,200,50,0.7)" ] -zeroStyle : Sparkline.Param a -> Sparkline.Param a +zeroStyle : Spark.Param a -> Spark.Param a zeroStyle = - Sparkline.Style + Spark.Style [ SvgAttrib.stroke "rgba(0,0,0,0.2)" , SvgAttrib.strokeWidth "1.0" ] @@ -318,7 +318,7 @@ zeroStyle = {-| Bar graph to be used with updateRemoteTotal metrics (change instead of absolute values). -} -graphChange : DataSet -> Html a +graphChange : Spark.DataSet -> Html a graphChange data = let -- Used with Domain to stop sparkline forgetting about zero; continue scrolling graph. @@ -330,16 +330,16 @@ graphChange data = Just point -> Tuple.first point in - sparkline graphSize - [ Sparkline.Bar 2.5 data |> barStyle - , Sparkline.ZeroLine |> zeroStyle - , Sparkline.Domain [ ( x, 0 ), ( x, 1 ) ] + Spark.sparkline graphSize + [ Spark.Bar 2.5 data |> barStyle + , Spark.ZeroLine |> zeroStyle + , Spark.Domain [ ( x, 0 ), ( x, 1 ) ] ] {-| Zero based area graph, for charting absolute values relative to 0. -} -graphZero : DataSet -> Html a +graphZero : Spark.DataSet -> Html a graphZero data = let -- Used with Domain to stop sparkline forgetting about zero; continue scrolling graph. @@ -351,10 +351,10 @@ graphZero data = Just point -> Tuple.first point in - sparkline graphSize - [ Sparkline.Area data |> areaStyle - , Sparkline.ZeroLine |> zeroStyle - , Sparkline.Domain [ ( x, 0 ), ( x, 1 ) ] + Spark.sparkline graphSize + [ Spark.Area data |> areaStyle + , Spark.ZeroLine |> zeroStyle + , Spark.Domain [ ( x, 0 ), ( x, 1 ) ] ] diff --git a/ui/src/Route.elm b/ui/src/Route.elm index 3b73e08..349556e 100644 --- a/ui/src/Route.elm +++ b/ui/src/Route.elm @@ -16,17 +16,20 @@ type Route | 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") - ] +{-| Routes our application handles. +-} +routes : List (Parser (Route -> a) a) +routes = + [ map Home top + , map Message (s "m" string string) + , map Mailbox (s "m" string) + , map Monitor (s "monitor") + , map Status (s "status") + ] +{-| Convert route to a URI. +-} routeToString : Route -> String routeToString page = let @@ -72,11 +75,11 @@ newUrl key = routeToString >> Navigation.pushUrl key -{-| Returns the Route for a given URL; by matching the path after # (fragment.) +{-| Returns the Route for a given URL. -} fromUrl : Url -> Route fromUrl location = - case Parser.parse routeParser location of + case Parser.parse (oneOf routes) location of Nothing -> Unknown location.path diff --git a/ui/src/Views/Page.elm b/ui/src/Views/Page.elm index 8ebc33d..63374b8 100644 --- a/ui/src/Views/Page.elm +++ b/ui/src/Views/Page.elm @@ -89,13 +89,10 @@ navbarLink session page route linkContent = navbarRecent : Session -> ActivePage -> FrameControls msg -> Html msg navbarRecent session page controls = let - recentItemLink mailbox = - a [ Route.href session.key (Route.Mailbox mailbox) ] [ text mailbox ] - active = page == Mailbox - -- Navbar tab title, is current mailbox when active. + -- Recent tab title is the name of the current mailbox when active. title = if active then controls.recentActive @@ -103,20 +100,23 @@ navbarRecent session page controls = else "Recent Mailboxes" - -- Items to show in recent list, doesn't include active mailbox. - items = + -- Mailboxes to show in recent list, doesn't include active mailbox. + recentMailboxes = if active then List.tail controls.recentOptions |> Maybe.withDefault [] else controls.recentOptions + + recentLink mailbox = + a [ Route.href session.key (Route.Mailbox mailbox) ] [ text mailbox ] in li [ id "navbar-recent" , classList [ ( "navbar-dropdown", True ), ( "navbar-active", active ) ] ] [ span [] [ text title ] - , div [ class "navbar-dropdown-content" ] (List.map recentItemLink items) + , div [ class "navbar-dropdown-content" ] (List.map recentLink recentMailboxes) ]