1
0
mirror of https://github.com/jhillyerd/inbucket.git synced 2025-12-17 17:47:03 +00:00

ui: Easy renames and refactors

This commit is contained in:
James Hillyerd
2018-11-18 18:52:14 -08:00
parent 0ed0cd2d64
commit 5be2b57a12
11 changed files with 150 additions and 164 deletions

View File

@@ -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

View File

@@ -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)

View File

@@ -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)

View File

@@ -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))

View File

@@ -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

View File

@@ -19,15 +19,14 @@ type alias Model =
init : ( Model, Cmd Msg )
init =
( Model "", cmdGreeting )
cmdGreeting : Cmd Msg
cmdGreeting =
let
cmdGreeting =
Http.get
{ url = "/serve/greeting"
, expect = Http.expectString GreetingResult
, expect = Http.expectString GreetingLoaded
}
in
( Model "", cmdGreeting )
@@ -35,16 +34,16 @@ cmdGreeting =
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) )

View File

@@ -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
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
|> text

View File

@@ -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

View File

@@ -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 ) ]
]

View File

@@ -16,9 +16,10 @@ type Route
| Status
routeParser : Parser (Route -> a) a
routeParser =
oneOf
{-| 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)
@@ -27,6 +28,8 @@ routeParser =
]
{-| 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

View File

@@ -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)
]