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
, bookingMForm
, eventFromBooking
, toSession
, fromSessionMaybe
, fromSession
, b3Class
, inputSize
, labelSize
) where
import Calendar
......@@ -39,8 +43,8 @@ toSession Booking {..} = do
setSession "subject" bookSubject
forM_ bookContact $ setSession "contact"
fromSession' :: MonadHandler m => MaybeT m Booking
fromSession' = do
fromSessionMaybe :: MonadHandler m => MaybeT m Booking
fromSessionMaybe = do
bookName <- MaybeT $ lookupSession "name"
bookEmail <- MaybeT $ lookupSession "email"
bookSubject <- MaybeT $ lookupSession "subject"
......@@ -48,20 +52,46 @@ fromSession' = do
return Booking {..}
fromSession :: Handler Booking
fromSession = runMaybeT fromSession' >>= maybe QF.noSessionError return
fromSession = runMaybeT fromSessionMaybe >>= maybe QF.noSessionError return
bfs :: Text -> FieldSettings site
bfs = B3.bfs . asText
bfs :: Text -> String -> FieldSettings site
bfs label help =
(B3.bfs label) {fsTooltip = Just (fromString help)}
bookingAForm :: AForm Handler Booking
bookingAForm =
Booking <$> areq textField (bfs "Name") Nothing <*>
areq emailField (bfs "Email") Nothing <*>
areq textField (bfs "Subject") Nothing <*>
aopt textField (bfs "Contact") Nothing
bookingAForm :: Maybe Booking -> AForm Handler Booking
bookingAForm bOpt =
Booking <$> areq textField name (bookName <$> bOpt) <*>
areq emailField email (bookEmail <$> bOpt) <*>
areq textField subject (bookSubject <$> bOpt) <*>
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)
bookingMForm = B3.renderBootstrap3 B3.BootstrapBasicForm bookingAForm
inputSize :: B3.BootstrapGridOptions
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 {..} slot = SimpleEvent {..}
......
......@@ -25,6 +25,7 @@ module Handlers
) where
import qualified BookingForm as BF
import BookingForm (b3Class, inputSize, labelSize)
import Calendar
import Control.Monad.Trans.Maybe
import Data.FileEmbed (embedFile)
......@@ -50,6 +51,7 @@ getHomeR
-- Produce form for query and display parameters: appointment length,
-- 12/24-hour time, time zone, location.
qOpt <- runMaybeT QF.fromSession
bOpt <- runMaybeT BF.fromSessionMaybe
(idReset, idSpinner, idAvail, idAlert) <- newIdent4
(queryWidget, enctype) <- generateFormPost $ QF.queryForm idReset qOpt
defaultLayout $(widgetFile "homepage")
......@@ -87,11 +89,12 @@ postHomeR = do
QF.toSessionWithSlot q slot
redirect BookR
-- | Show for to collect client's personal data.
-- | Show form to collect client's personal data.
getBookR :: Handler Html
getBookR = do
(QF.QueryForm {..}, QF.TimeSlot {..}, whenWhere) <- showWhenWhere
(bookWidget, enctype) <- generateFormPost BF.bookingMForm
bOpt <- runMaybeT BF.fromSessionMaybe
(bookWidget, enctype) <- generateFormPost (BF.bookingMForm bOpt)
defaultLayout $(widgetFile "book")
showWhenWhere :: Handler (QF.QueryForm, QF.TimeSlot, Widget)
......@@ -107,7 +110,7 @@ showWhenWhere = do
postBookR :: Handler Html
postBookR = do
(q, slot) <- QF.fromSessionWithSlot
b <- formSuccess =<< runFormPost BF.bookingMForm
b <- formSuccess =<< runFormPost (BF.bookingMForm Nothing)
BF.toSession b
let event = BF.eventFromBooking b q slot
matches e =
......@@ -127,7 +130,6 @@ getFinalR :: Handler Html
getFinalR = do
(QF.QueryForm {..}, QF.TimeSlot {..}, whenWhere) <- showWhenWhere
BF.Booking{..} <- BF.fromSession
setMessage "You are booked!"
defaultLayout $(widgetFile "final")
getClearR :: Handler Html
......
......@@ -36,6 +36,7 @@ module QueryForm
, noSessionError
, showDate
, showTime
, prettyTz
) where
import Control.Monad.Trans.Maybe
......@@ -209,10 +210,15 @@ locationChoiceField = Field {..}
locs <- appLocations . appSettings <$> getYesod
$(widgetFile "query-locations")
tzChars :: Char -> Text
tzChars '_' = " "
tzChars '/' = " » "
tzChars c = singleton c
prettyTz' :: Text -> Text
prettyTz' = concatMap tzChars
where
tzChars '_' = " "
tzChars '/' = " » "
tzChars c = singleton c
prettyTz :: TZLabelW -> Text
prettyTz = prettyTz' . toPathPiece
zonesByContinent :: Map Text [(Text, Text)]
zonesByContinent =
......@@ -222,7 +228,7 @@ zonesByContinent =
allZones = [minBound..maxBound]
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
txt = toPathPiece tz
......@@ -239,7 +245,7 @@ tzSelectorField idReset = Field {..}
fieldParse _ _ = return $ Left $ SomeMessage $ MsgInvalidEntry "Timezone"
fieldView _ name attrs val _ = do
AppSettings{appDefaultTimeZone} <- appSettings <$> getYesod
(idTextTz, idSelectTz) <- newIdent2
(idShowDefaultTz, idTextTz, idSelectTz) <- newIdent3
let currentTz = toPathPiece $ either (const appDefaultTimeZone) id val
isDefaultTz = currentTz == toPathPiece appDefaultTimeZone
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}
^{bookWidget}
<button type=submit .btn .btn-primary>Book it
......@@ -8,10 +8,10 @@
#{name}
$maybe pic <- appProviderAvatar (appSettings master)
<div .container>
<div #avatar .container>
<div .row>
<div .col-md-12 style="margin: -60px 0 1ex 0;">
<img .img-circle width=100 height=100 src=#{pic} style="float:right">
<div .col-md-12>
<img .img-circle width=100 height=100 src=#{pic}>
<div .container>
$maybe msg <- mmsg
......
......@@ -2,6 +2,16 @@ body {
font-family: #{fontFamily};
}
#avatar .row {
margin-bottom: 40px;
}
#avatar img {
float: right;
position: absolute;
top: -65px;
right: 10px;
}
h1 {
font-size: 28px;
margin: 0 0 1ex 0;
......
<h1>Appointment confirmation
<p .alert.alert-success>
<b>Thanks #{bookName},
your appointment is on my calendar.
<p>
You should receive a meeting invitation at your email address.
<p>
Thanks #{bookName}, your appointment details are below. You should
also receive a meeting invitation at your email
address, #
<b>#{bookEmail}#
. Please click the “Yes” link in that message to confirm.
<b>
Please click the “Yes” link in that email to confirm.
<p>
Should you need to cancel, please click the “No” link and reply to the
message.
Should you need to cancel, please click the “No” link in the
confirmation email, and then reply to the message.
<div .form-horizontal>
^{whenWhere}
^{whenWhere}
<div .form-group>
<label>Subject
<div .form-group>
<label .control-label .#{b3Class labelSize}>Email
<div .#{b3Class inputSize}>
<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
$maybe ct <- bookContact
<div .form-group>
<label>Contact information
<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>
Choose an appointment
Find time to meet
<a ##{idReset} href=@{ClearR} :isNothing qOpt:style="display:none">
<sup .text-danger title="Reset to default options">
<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}>
^{queryWidget}
<div ##{idAvail} style="display:none">
......
<input type=hidden name=#{name} value=#{currentTz}>
$if isDefaultTz
<p #showDefaultTz>
<p ##{idShowDefaultTz}>
in time zone: 
<span #textTz>
<span ##{idTextTz}>
<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>
in time zone:
......
$(function() {
$("#textTz").click(function(){
$("#showDefaultTz").hide();
$("#selectTz").show();
$("##{rawJS idTextTz}").click(function(){
$("##{rawJS idShowDefaultTz}").hide();
$("##{rawJS idSelectTz}").show();
$("##{rawJS idReset}").show();
});
})
#textTz {
##{idTextTz} {
cursor: pointer;
color: #000;
}
......
<div .form-group>
<label>When
<label .control-label .#{b3Class labelSize}>When
<div .#{b3Class inputSize}>
<p .form-control-static>
#{QF.showDate slotLocal} #{QF.showTime queryTimeFmt slotLocal}
(#{toPathPiece queryTzLabel})
(#{QF.prettyTz queryTzLabel})
$maybe oz <- inOtherZone
<br>
<span .text-muted>
#{QF.showDate oz} #{QF.showTime queryTimeFmt oz}
(#{toPathPiece appDefaultTimeZone})
(#{QF.prettyTz appDefaultTimeZone})
<div .form-group>
<label>Where
<label .control-label .#{b3Class labelSize}>Where
<div .#{b3Class inputSize}>
<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