Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Christopher League
bookme
Commits
a6fbf98e
Commit
a6fbf98e
authored
Jun 02, 2018
by
Christopher League
Browse files
Show both time zones on booking and confirmation
parent
bdb06417
Changes
5
Hide whitespace changes
Inline
Side-by-side
src/Handlers.hs
View file @
a6fbf98e
...
...
@@ -28,6 +28,7 @@ import Calendar
import
Control.Monad.Trans.Maybe
import
Data.FileEmbed
(
embedFile
)
import
qualified
Data.SortedList
as
SL
import
Data.Time.Zones
(
localTimeToUTCTZ
,
utcToLocalTimeTZ
)
import
qualified
FreshCache
as
FC
import
Import
import
qualified
QueryForm
as
QF
...
...
@@ -83,9 +84,19 @@ postHomeR = do
-- | Show for to collect client's personal data.
getBookR
::
Handler
Html
getBookR
=
do
(
QF
.
QueryForm
{
..
},
QF
.
TimeSlot
{
..
}
)
<-
QF
.
fromSessionWithSlot
(
QF
.
QueryForm
{
..
},
QF
.
TimeSlot
{
..
}
,
whenWhere
)
<-
showWhenWhere
(
bookWidget
,
enctype
)
<-
generateFormPost
BF
.
bookingMForm
defaultLayout
$
(
widgetFile
"confirm"
)
defaultLayout
$
(
widgetFile
"book"
)
showWhenWhere
::
Handler
(
QF
.
QueryForm
,
QF
.
TimeSlot
,
Widget
)
showWhenWhere
=
do
AppSettings
{
appDefaultTimeZone
}
<-
appSettings
<$>
getYesod
(
q
@
QF
.
QueryForm
{
..
},
s
@
QF
.
TimeSlot
{
..
})
<-
QF
.
fromSessionWithSlot
let
inOtherZone
=
if
queryTzLabel
==
appDefaultTimeZone
then
Nothing
else
Just
$
utcToLocalTimeTZ
(
tzByLabel
appDefaultTimeZone
)
$
localTimeToUTCTZ
(
tzByLabel
queryTzLabel
)
slotLocal
return
(
q
,
s
,
$
(
widgetFile
"when-where"
))
postBookR
::
Handler
Html
postBookR
=
do
...
...
@@ -108,14 +119,10 @@ postBookR = do
getFinalR
::
Handler
Html
getFinalR
=
do
(
q
,
QF
.
TimeSlot
{
..
})
<-
QF
.
fromSessionWithSlot
b
<-
BF
.
fromSession
defaultLayout
[
whamlet
|
<p>#{tshow q}
<p>#{tshow slotLocal}
<p>#{tshow b}
|]
(
QF
.
QueryForm
{
..
},
QF
.
TimeSlot
{
..
},
whenWhere
)
<-
showWhenWhere
BF
.
Booking
{
..
}
<-
BF
.
fromSession
setMessage
"You are booked!"
defaultLayout
$
(
widgetFile
"final"
)
getClearR
::
Handler
Html
getClearR
=
clearSession
>>
redirect
HomeR
...
...
src/QueryForm.hs
View file @
a6fbf98e
...
...
@@ -235,21 +235,22 @@ tzSelectorField = Field {..}
fieldEnctype
=
UrlEncoded
fieldParse
(
txt
:
_
)
_
=
return
$
Right
$
fromPathPiece
txt
fieldParse
_
_
=
return
$
Left
$
SomeMessage
$
MsgInvalidEntry
"Timezone"
fieldView
i
name
attrs
val
req
=
do
fieldView
_
name
attrs
val
_
=
do
AppSettings
{
appDefaultTimeZone
}
<-
appSettings
<$>
getYesod
let
currentTz
=
toPathPiece
$
either
(
const
appDefaultTimeZone
)
id
val
cityAttrs
=
[(
asText
"class"
,
"tzsel "
<>
qControl
)]
[
whamlet
|
<input type=hidden name=#{name} value=#{currentTz}>
<select name=#{name}-con *{attrs}>
$forall c <- Map.keys zonesByContinent
<option value=#{c} :isPrefixOf c currentTz:selected>#{c}
$forall c <- Map.keys zonesByContinent
<select name=#{name}-#{c} :not(isPrefixOf c currentTz):style="display:none" *{cityAttrs}>
$maybe zs <- lookup c zonesByContinent
$forall (z,txt) <- zs
<option value=#{toPathPiece z} :z == currentTz:selected>#{txt}
|]
<input type=hidden name=#{name} value=#{currentTz}>
<select name=#{name}-con *{attrs}>
$forall c <- Map.keys zonesByContinent
<option value=#{c} :isPrefixOf c currentTz:selected>#{c}
$forall c <- Map.keys zonesByContinent
<select name=#{name}-#{c} :not(isPrefixOf c currentTz):style="display:none"
*{cityAttrs}>
$maybe zs <- lookup c zonesByContinent
$forall (z,txt) <- zs
<option value=#{toPathPiece z} :z == currentTz:selected>#{txt}
|]
qControl
::
Text
qControl
=
"qcontrol"
...
...
templates/
confirm
.hamlet
→
templates/
book
.hamlet
View file @
a6fbf98e
<h1>Book an appointment
<form role=form method=post action=@{BookR} enctype=#{enctype}>
<div .form-group>
<label>When
<p .form-control-static>
#{QF.showDate slotLocal} #{QF.showTime queryTimeFmt slotLocal}
(#{toPathPiece queryTzLabel})
<div .form-group>
<label>Where
<p .form-control-static>
#{locDescr queryLocation}
^{whenWhere}
^{bookWidget}
<button type=submit .btn .btn-primary>Book it
templates/final.hamlet
View file @
a6fbf98e
...
...
@@ -9,6 +9,8 @@
Should you need to cancel, please click the “No” link and reply to the
message.
^{whenWhere}
<div .form-group>
<label>Subject
<p .form-control-static>
...
...
templates/when-where.hamlet
0 → 100644
View file @
a6fbf98e
<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})
<div .form-group>
<label>Where
<p .form-control-static>
#{locDescr queryLocation}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment