Commit a6fbf98e authored by Christopher League's avatar Christopher League 🖥

Show both time zones on booking and confirmation

parent bdb06417
...@@ -28,6 +28,7 @@ import Calendar ...@@ -28,6 +28,7 @@ import Calendar
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Data.FileEmbed (embedFile) import Data.FileEmbed (embedFile)
import qualified Data.SortedList as SL import qualified Data.SortedList as SL
import Data.Time.Zones (localTimeToUTCTZ, utcToLocalTimeTZ)
import qualified FreshCache as FC import qualified FreshCache as FC
import Import import Import
import qualified QueryForm as QF import qualified QueryForm as QF
...@@ -83,9 +84,19 @@ postHomeR = do ...@@ -83,9 +84,19 @@ postHomeR = do
-- | Show for to collect client's personal data. -- | Show for to collect client's personal data.
getBookR :: Handler Html getBookR :: Handler Html
getBookR = do getBookR = do
(QF.QueryForm {..}, QF.TimeSlot {..}) <- QF.fromSessionWithSlot (QF.QueryForm {..}, QF.TimeSlot {..}, whenWhere) <- showWhenWhere
(bookWidget, enctype) <- generateFormPost BF.bookingMForm (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 :: Handler Html
postBookR = do postBookR = do
...@@ -108,14 +119,10 @@ postBookR = do ...@@ -108,14 +119,10 @@ postBookR = do
getFinalR :: Handler Html getFinalR :: Handler Html
getFinalR = do getFinalR = do
(q, QF.TimeSlot {..}) <- QF.fromSessionWithSlot (QF.QueryForm {..}, QF.TimeSlot {..}, whenWhere) <- showWhenWhere
b <- BF.fromSession BF.Booking{..} <- BF.fromSession
defaultLayout setMessage "You are booked!"
[whamlet| defaultLayout $(widgetFile "final")
<p>#{tshow q}
<p>#{tshow slotLocal}
<p>#{tshow b}
|]
getClearR :: Handler Html getClearR :: Handler Html
getClearR = clearSession >> redirect HomeR getClearR = clearSession >> redirect HomeR
......
...@@ -235,21 +235,22 @@ tzSelectorField = Field {..} ...@@ -235,21 +235,22 @@ tzSelectorField = Field {..}
fieldEnctype = UrlEncoded fieldEnctype = UrlEncoded
fieldParse (txt:_) _ = return $ Right $ fromPathPiece txt fieldParse (txt:_) _ = return $ Right $ fromPathPiece txt
fieldParse _ _ = return $ Left $ SomeMessage $ MsgInvalidEntry "Timezone" fieldParse _ _ = return $ Left $ SomeMessage $ MsgInvalidEntry "Timezone"
fieldView i name attrs val req = do fieldView _ name attrs val _ = do
AppSettings{appDefaultTimeZone} <- appSettings <$> getYesod AppSettings{appDefaultTimeZone} <- appSettings <$> getYesod
let currentTz = toPathPiece $ either (const appDefaultTimeZone) id val let currentTz = toPathPiece $ either (const appDefaultTimeZone) id val
cityAttrs = [(asText "class", "tzsel " <> qControl)] cityAttrs = [(asText "class", "tzsel " <> qControl)]
[whamlet| [whamlet|
<input type=hidden name=#{name} value=#{currentTz}> <input type=hidden name=#{name} value=#{currentTz}>
<select name=#{name}-con *{attrs}> <select name=#{name}-con *{attrs}>
$forall c <- Map.keys zonesByContinent $forall c <- Map.keys zonesByContinent
<option value=#{c} :isPrefixOf c currentTz:selected>#{c} <option value=#{c} :isPrefixOf c currentTz:selected>#{c}
$forall c <- Map.keys zonesByContinent $forall c <- Map.keys zonesByContinent
<select name=#{name}-#{c} :not(isPrefixOf c currentTz):style="display:none" *{cityAttrs}> <select name=#{name}-#{c} :not(isPrefixOf c currentTz):style="display:none"
$maybe zs <- lookup c zonesByContinent *{cityAttrs}>
$forall (z,txt) <- zs $maybe zs <- lookup c zonesByContinent
<option value=#{toPathPiece z} :z == currentTz:selected>#{txt} $forall (z,txt) <- zs
|] <option value=#{toPathPiece z} :z == currentTz:selected>#{txt}
|]
qControl :: Text qControl :: Text
qControl = "qcontrol" qControl = "qcontrol"
......
<h1>Book an appointment <h1>Book an appointment
<form role=form method=post action=@{BookR} enctype=#{enctype}> <form role=form method=post action=@{BookR} enctype=#{enctype}>
<div .form-group> ^{whenWhere}
<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}
^{bookWidget} ^{bookWidget}
<button type=submit .btn .btn-primary>Book it <button type=submit .btn .btn-primary>Book it
...@@ -9,6 +9,8 @@ ...@@ -9,6 +9,8 @@
Should you need to cancel, please click the “No” link and reply to the Should you need to cancel, please click the “No” link and reply to the
message. message.
^{whenWhere}
<div .form-group> <div .form-group>
<label>Subject <label>Subject
<p .form-control-static> <p .form-control-static>
......
<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}
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