Show both time zones on booking and confirmation

src/Handlers.hs

@@ -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

@@ -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

 <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

@@ -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

+<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}