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>
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.
You should receive a meeting invitation at your email address.
<p>
Should you need to cancel, please click the “No” link and reply to the
message.
<b>
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>
<label>Subject
<p .form-control-static>
#{bookSubject}
<div .form-horizontal>
^{whenWhere}
$maybe ct <- bookContact
<div .form-group>
<label>Contact information
<p .form-control-static>
#{ct}
<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
<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>
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
<p .form-control-static>
#{QF.showDate slotLocal} #{QF.showTime queryTimeFmt slotLocal}
(#{toPathPiece queryTzLabel})
$maybe oz <- inOtherZone
<br>
#{QF.showDate oz} #{QF.showTime queryTimeFmt oz}
(#{toPathPiece appDefaultTimeZone})
<label .control-label .#{b3Class labelSize}>When
<div .#{b3Class inputSize}>
<p .form-control-static>
#{QF.showDate slotLocal} #{QF.showTime queryTimeFmt slotLocal}
(#{QF.prettyTz queryTzLabel})
$maybe oz <- inOtherZone
<br>
<span .text-muted>
#{QF.showDate oz} #{QF.showTime queryTimeFmt oz}
(#{QF.prettyTz appDefaultTimeZone})
<div .form-group>
<label>Where
<p .form-control-static>
#{locDescr queryLocation}
<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