Commit 3fba4846 authored by Christopher League's avatar Christopher League 🖥

Various improvements, esp final page

parent 73dcaa11
Pipeline #537 passed with stage
in 1 minute and 14 seconds
...@@ -14,7 +14,11 @@ module BookingForm ...@@ -14,7 +14,11 @@ module BookingForm
, bookingMForm , bookingMForm
, eventFromBooking , eventFromBooking
, toSession , toSession
, fromSessionMaybe
, fromSession , fromSession
, b3Class
, inputSize
, labelSize
) where ) where
import Calendar import Calendar
...@@ -39,8 +43,8 @@ toSession Booking {..} = do ...@@ -39,8 +43,8 @@ toSession Booking {..} = do
setSession "subject" bookSubject setSession "subject" bookSubject
forM_ bookContact $ setSession "contact" forM_ bookContact $ setSession "contact"
fromSession' :: MonadHandler m => MaybeT m Booking fromSessionMaybe :: MonadHandler m => MaybeT m Booking
fromSession' = do fromSessionMaybe = do
bookName <- MaybeT $ lookupSession "name" bookName <- MaybeT $ lookupSession "name"
bookEmail <- MaybeT $ lookupSession "email" bookEmail <- MaybeT $ lookupSession "email"
bookSubject <- MaybeT $ lookupSession "subject" bookSubject <- MaybeT $ lookupSession "subject"
...@@ -48,20 +52,46 @@ fromSession' = do ...@@ -48,20 +52,46 @@ fromSession' = do
return Booking {..} return Booking {..}
fromSession :: Handler Booking fromSession :: Handler Booking
fromSession = runMaybeT fromSession' >>= maybe QF.noSessionError return fromSession = runMaybeT fromSessionMaybe >>= maybe QF.noSessionError return
bfs :: Text -> FieldSettings site bfs :: Text -> String -> FieldSettings site
bfs = B3.bfs . asText bfs label help =
(B3.bfs label) {fsTooltip = Just (fromString help)}
bookingAForm :: AForm Handler Booking bookingAForm :: Maybe Booking -> AForm Handler Booking
bookingAForm = bookingAForm bOpt =
Booking <$> areq textField (bfs "Name") Nothing <*> Booking <$> areq textField name (bookName <$> bOpt) <*>
areq emailField (bfs "Email") Nothing <*> areq emailField email (bookEmail <$> bOpt) <*>
areq textField (bfs "Subject") Nothing <*> areq textField subject (bookSubject <$> bOpt) <*>
aopt textField (bfs "Contact") Nothing aopt textField contact (bookContact <$> bOpt) <*
B3.bootstrapSubmit ("Submit" :: B3.BootstrapSubmit Text)
where
name = bfs "*Name" "Who are you?"
email = bfs "*Email" "You must use a valid email address"
subject = bfs "*Subject" "What course are you in? What do you want to talk about?"
contact = bfs "Contact" "For online meetings, how do I reach you?"
horizOffset :: B3.BootstrapGridOptions
horizOffset = B3.ColMd 0
labelSize :: B3.BootstrapGridOptions
labelSize = B3.ColMd 1
bookingMForm :: Html -> MForm Handler (FormResult Booking, Widget) inputSize :: B3.BootstrapGridOptions
bookingMForm = B3.renderBootstrap3 B3.BootstrapBasicForm bookingAForm inputSize = B3.ColMd 4
b3Class :: B3.BootstrapGridOptions -> Text
b3Class g =
case g of
B3.ColXs n -> "col-xs-" <> tshow n
B3.ColSm n -> "col-sm-" <> tshow n
B3.ColMd n -> "col-md-" <> tshow n
B3.ColLg n -> "col-lg-" <> tshow n
bookingMForm :: Maybe Booking -> Html -> MForm Handler (FormResult Booking, Widget)
bookingMForm = B3.renderBootstrap3 horiz . bookingAForm
where
horiz = B3.BootstrapHorizontalForm horizOffset labelSize horizOffset inputSize
eventFromBooking :: Booking -> QF.QueryForm -> QF.TimeSlot -> SimpleEventUTC eventFromBooking :: Booking -> QF.QueryForm -> QF.TimeSlot -> SimpleEventUTC
eventFromBooking Booking {..} QF.QueryForm {..} slot = SimpleEvent {..} eventFromBooking Booking {..} QF.QueryForm {..} slot = SimpleEvent {..}
......
...@@ -25,6 +25,7 @@ module Handlers ...@@ -25,6 +25,7 @@ module Handlers
) where ) where
import qualified BookingForm as BF import qualified BookingForm as BF
import BookingForm (b3Class, inputSize, labelSize)
import Calendar import Calendar
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Data.FileEmbed (embedFile) import Data.FileEmbed (embedFile)
...@@ -50,6 +51,7 @@ getHomeR ...@@ -50,6 +51,7 @@ getHomeR
-- Produce form for query and display parameters: appointment length, -- Produce form for query and display parameters: appointment length,
-- 12/24-hour time, time zone, location. -- 12/24-hour time, time zone, location.
qOpt <- runMaybeT QF.fromSession qOpt <- runMaybeT QF.fromSession
bOpt <- runMaybeT BF.fromSessionMaybe
(idReset, idSpinner, idAvail, idAlert) <- newIdent4 (idReset, idSpinner, idAvail, idAlert) <- newIdent4
(queryWidget, enctype) <- generateFormPost $ QF.queryForm idReset qOpt (queryWidget, enctype) <- generateFormPost $ QF.queryForm idReset qOpt
defaultLayout $(widgetFile "homepage") defaultLayout $(widgetFile "homepage")
...@@ -87,11 +89,12 @@ postHomeR = do ...@@ -87,11 +89,12 @@ postHomeR = do
QF.toSessionWithSlot q slot QF.toSessionWithSlot q slot
redirect BookR redirect BookR
-- | Show for to collect client's personal data. -- | Show form to collect client's personal data.
getBookR :: Handler Html getBookR :: Handler Html
getBookR = do getBookR = do
(QF.QueryForm {..}, QF.TimeSlot {..}, whenWhere) <- showWhenWhere (QF.QueryForm {..}, QF.TimeSlot {..}, whenWhere) <- showWhenWhere
(bookWidget, enctype) <- generateFormPost BF.bookingMForm bOpt <- runMaybeT BF.fromSessionMaybe
(bookWidget, enctype) <- generateFormPost (BF.bookingMForm bOpt)
defaultLayout $(widgetFile "book") defaultLayout $(widgetFile "book")
showWhenWhere :: Handler (QF.QueryForm, QF.TimeSlot, Widget) showWhenWhere :: Handler (QF.QueryForm, QF.TimeSlot, Widget)
...@@ -107,7 +110,7 @@ showWhenWhere = do ...@@ -107,7 +110,7 @@ showWhenWhere = do
postBookR :: Handler Html postBookR :: Handler Html
postBookR = do postBookR = do
(q, slot) <- QF.fromSessionWithSlot (q, slot) <- QF.fromSessionWithSlot
b <- formSuccess =<< runFormPost BF.bookingMForm b <- formSuccess =<< runFormPost (BF.bookingMForm Nothing)
BF.toSession b BF.toSession b
let event = BF.eventFromBooking b q slot let event = BF.eventFromBooking b q slot
matches e = matches e =
...@@ -127,7 +130,6 @@ getFinalR :: Handler Html ...@@ -127,7 +130,6 @@ getFinalR :: Handler Html
getFinalR = do getFinalR = do
(QF.QueryForm {..}, QF.TimeSlot {..}, whenWhere) <- showWhenWhere (QF.QueryForm {..}, QF.TimeSlot {..}, whenWhere) <- showWhenWhere
BF.Booking{..} <- BF.fromSession BF.Booking{..} <- BF.fromSession
setMessage "You are booked!"
defaultLayout $(widgetFile "final") defaultLayout $(widgetFile "final")
getClearR :: Handler Html getClearR :: Handler Html
......
...@@ -36,6 +36,7 @@ module QueryForm ...@@ -36,6 +36,7 @@ module QueryForm
, noSessionError , noSessionError
, showDate , showDate
, showTime , showTime
, prettyTz
) where ) where
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
...@@ -209,10 +210,15 @@ locationChoiceField = Field {..} ...@@ -209,10 +210,15 @@ locationChoiceField = Field {..}
locs <- appLocations . appSettings <$> getYesod locs <- appLocations . appSettings <$> getYesod
$(widgetFile "query-locations") $(widgetFile "query-locations")
tzChars :: Char -> Text prettyTz' :: Text -> Text
tzChars '_' = " " prettyTz' = concatMap tzChars
tzChars '/' = " » " where
tzChars c = singleton c tzChars '_' = " "
tzChars '/' = " » "
tzChars c = singleton c
prettyTz :: TZLabelW -> Text
prettyTz = prettyTz' . toPathPiece
zonesByContinent :: Map Text [(Text, Text)] zonesByContinent :: Map Text [(Text, Text)]
zonesByContinent = zonesByContinent =
...@@ -222,7 +228,7 @@ zonesByContinent = ...@@ -222,7 +228,7 @@ zonesByContinent =
allZones = [minBound..maxBound] allZones = [minBound..maxBound]
splitTz :: TZLabelW -> (Text, (Text, Text)) splitTz :: TZLabelW -> (Text, (Text, Text))
splitTz tz = (cont, (txt, concatMap tzChars (drop 1 city))) splitTz tz = (cont, (txt, prettyTz' (drop 1 city)))
where (cont, city) = break (== '/') txt where (cont, city) = break (== '/') txt
txt = toPathPiece tz txt = toPathPiece tz
...@@ -239,7 +245,7 @@ tzSelectorField idReset = Field {..} ...@@ -239,7 +245,7 @@ tzSelectorField idReset = Field {..}
fieldParse _ _ = return $ Left $ SomeMessage $ MsgInvalidEntry "Timezone" fieldParse _ _ = return $ Left $ SomeMessage $ MsgInvalidEntry "Timezone"
fieldView _ name attrs val _ = do fieldView _ name attrs val _ = do
AppSettings{appDefaultTimeZone} <- appSettings <$> getYesod AppSettings{appDefaultTimeZone} <- appSettings <$> getYesod
(idTextTz, idSelectTz) <- newIdent2 (idShowDefaultTz, idTextTz, idSelectTz) <- newIdent3
let currentTz = toPathPiece $ either (const appDefaultTimeZone) id val let currentTz = toPathPiece $ either (const appDefaultTimeZone) id val
isDefaultTz = currentTz == toPathPiece appDefaultTimeZone isDefaultTz = currentTz == toPathPiece appDefaultTimeZone
cityAttrs = [(asText "class", "tzsel " <> qControl)] cityAttrs = [(asText "class", "tzsel " <> qControl)]
......
<?xml version="1.0" encoding="UTF-8"?>
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" width="17cm" height="12cm" viewBox="0 0 170 120" version="1.1">
<defs>
<clipPath id="clip1">
<path d="M 0 120 L 170 120 L 170 0 L 0 0 L 0 120 Z M 0 120 "/>
</clipPath>
</defs>
<g id="surface0">
<g clip-path="url(#clip1)" clip-rule="nonzero">
<path style=" stroke:none;fill-rule: nonzero; fill: rgb(40%,40%,40%); fill-opacity: 1;" d="M 0 120 L 40 60 L 0 0 L 30 0 L 70 60 L 30 120 L 0 120 Z M 0 120 "/>
<path style=" stroke:none;fill-rule: nonzero; fill: rgb(60%,60%,60%); fill-opacity: 1;" d="M 40 120 L 80 60 L 40 0 L 70 0 L 150 120 L 120 120 L 95 82.5 L 70 120 L 40 120 Z M 40 120 "/>
<path style=" stroke:none;fill-rule: nonzero; fill: rgb(40%,40%,40%); fill-opacity: 1;" d="M 136.666667 85 L 123.333333 65 L 170 65 L 170 85 L 136.666667 85 Z M 136.666667 85 "/>
<path style=" stroke:none;fill-rule: nonzero; fill: rgb(40%,40%,40%); fill-opacity: 1;" d="M 116.666667 55 L 103.333333 35 L 170 35 L 170 55 L 116.666667 55 Z M 116.666667 55 "/>
</g>
</g>
</svg>
\ No newline at end of file
<h1>Book an appointment <h1>Book your appointment
<form role=form method=post action=@{BookR} enctype=#{enctype}> <form .form-horizontal role=form method=post action=@{BookR} enctype=#{enctype}>
^{whenWhere} ^{whenWhere}
^{bookWidget} ^{bookWidget}
<button type=submit .btn .btn-primary>Book it
...@@ -8,10 +8,10 @@ ...@@ -8,10 +8,10 @@
#{name} #{name}
$maybe pic <- appProviderAvatar (appSettings master) $maybe pic <- appProviderAvatar (appSettings master)
<div .container> <div #avatar .container>
<div .row> <div .row>
<div .col-md-12 style="margin: -60px 0 1ex 0;"> <div .col-md-12>
<img .img-circle width=100 height=100 src=#{pic} style="float:right"> <img .img-circle width=100 height=100 src=#{pic}>
<div .container> <div .container>
$maybe msg <- mmsg $maybe msg <- mmsg
......
...@@ -2,6 +2,16 @@ body { ...@@ -2,6 +2,16 @@ body {
font-family: #{fontFamily}; font-family: #{fontFamily};
} }
#avatar .row {
margin-bottom: 40px;
}
#avatar img {
float: right;
position: absolute;
top: -65px;
right: 10px;
}
h1 { h1 {
font-size: 28px; font-size: 28px;
margin: 0 0 1ex 0; margin: 0 0 1ex 0;
......
<h1>Appointment confirmation
<p .alert.alert-success>
<b>Thanks #{bookName},
your appointment is on my calendar.
<p> <p>
Thanks #{bookName}, your appointment details are below. You should You should receive a meeting invitation at your email address.
also receive a meeting invitation at your email
address, #
<b>#{bookEmail}#
. Please click the “Yes” link in that message to confirm.
<p> <p>
Should you need to cancel, please click the “No” link and reply to the <b>
message. Please click the “Yes” link in that email to confirm.
^{whenWhere} <p>
Should you need to cancel, please click the “No” link in the
confirmation email, and then reply to the message.
<div .form-group> <div .form-horizontal>
<label>Subject
<p .form-control-static> ^{whenWhere}
#{bookSubject}
$maybe ct <- bookContact
<div .form-group> <div .form-group>
<label>Contact information <label .control-label .#{b3Class labelSize}>Email
<p .form-control-static> <div .#{b3Class inputSize}>
#{ct} <p .form-control-static>
#{bookEmail}
<div .form-group>
<label .control-label .#{b3Class labelSize}>Subject
<div .#{b3Class inputSize}>
<p .form-control-static>
#{bookSubject}
$maybe ct <- bookContact
<div .form-group>
<label .control-label .#{b3Class labelSize}>Contact
<div .#{b3Class inputSize}>
<p .form-control-static>
#{ct}
<p>
<a .btn.btn-warning href=@{ClearR}>
Public computer? Clear this session
<h1> <h1>
Choose an appointment Find time to meet
<a ##{idReset} href=@{ClearR} :isNothing qOpt:style="display:none"> <a ##{idReset} href=@{ClearR} :isNothing qOpt:style="display:none">
<sup .text-danger title="Reset to default options"> <sup .text-danger title="Reset to default options">
<span .glyphicon.glyphicon-remove style="font-size:70%"> <span .glyphicon.glyphicon-remove style="font-size:70%">
$maybe b <- bOpt
<p>
Welcome back, #{BF.bookName b}.
<a href=@{ClearR}>(Not you?)
<form method=post action=@{HomeR} enctype=#{enctype}> <form method=post action=@{HomeR} enctype=#{enctype}>
^{queryWidget} ^{queryWidget}
<div ##{idAvail} style="display:none"> <div ##{idAvail} style="display:none">
......
<input type=hidden name=#{name} value=#{currentTz}> <input type=hidden name=#{name} value=#{currentTz}>
$if isDefaultTz $if isDefaultTz
<p #showDefaultTz> <p ##{idShowDefaultTz}>
in time zone:  in time zone: 
<span #textTz> <span ##{idTextTz}>
<span .glyphicon.glyphicon-globe style="position:relative; top:2px;"> <span .glyphicon.glyphicon-globe style="position:relative; top:2px;">
#{concatMap tzChars currentTz} #{prettyTz' currentTz}
<div #selectTz :isDefaultTz:style="display:none"> <div ##{idSelectTz} :isDefaultTz:style="display:none">
<p> <p>
in time zone: in time zone:
......
$(function() { $(function() {
$("#textTz").click(function(){ $("##{rawJS idTextTz}").click(function(){
$("#showDefaultTz").hide(); $("##{rawJS idShowDefaultTz}").hide();
$("#selectTz").show(); $("##{rawJS idSelectTz}").show();
$("##{rawJS idReset}").show(); $("##{rawJS idReset}").show();
}); });
}) })
#textTz { ##{idTextTz} {
cursor: pointer; cursor: pointer;
color: #000; color: #000;
} }
......
<div .form-group> <div .form-group>
<label>When <label .control-label .#{b3Class labelSize}>When
<p .form-control-static> <div .#{b3Class inputSize}>
#{QF.showDate slotLocal} #{QF.showTime queryTimeFmt slotLocal} <p .form-control-static>
(#{toPathPiece queryTzLabel}) #{QF.showDate slotLocal} #{QF.showTime queryTimeFmt slotLocal}
$maybe oz <- inOtherZone (#{QF.prettyTz queryTzLabel})
<br> $maybe oz <- inOtherZone
#{QF.showDate oz} #{QF.showTime queryTimeFmt oz} <br>
(#{toPathPiece appDefaultTimeZone}) <span .text-muted>
#{QF.showDate oz} #{QF.showTime queryTimeFmt oz}
(#{QF.prettyTz appDefaultTimeZone})
<div .form-group> <div .form-group>
<label>Where <label .control-label .#{b3Class labelSize}>Where
<p .form-control-static> <div .#{b3Class inputSize}>
#{locDescr queryLocation} <p .form-control-static>
#{locDescr queryLocation}
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment