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

Remove header debugging in VersionR; run hfmt -w

parent 3fba4846
......@@ -55,8 +55,7 @@ fromSession :: Handler Booking
fromSession = runMaybeT fromSessionMaybe >>= maybe QF.noSessionError return
bfs :: Text -> String -> FieldSettings site
bfs label help =
(B3.bfs label) {fsTooltip = Just (fromString help)}
bfs label help = (B3.bfs label) {fsTooltip = Just (fromString help)}
bookingAForm :: Maybe Booking -> AForm Handler Booking
bookingAForm bOpt =
......@@ -68,7 +67,8 @@ bookingAForm bOpt =
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?"
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
......@@ -88,10 +88,12 @@ b3Class g =
B3.ColMd n -> "col-md-" <> tshow n
B3.ColLg n -> "col-lg-" <> tshow n
bookingMForm :: Maybe Booking -> Html -> MForm Handler (FormResult Booking, Widget)
bookingMForm ::
Maybe Booking -> Html -> MForm Handler (FormResult Booking, Widget)
bookingMForm = B3.renderBootstrap3 horiz . bookingAForm
where
horiz = B3.BootstrapHorizontalForm horizOffset labelSize horizOffset inputSize
horiz =
B3.BootstrapHorizontalForm horizOffset labelSize horizOffset inputSize
eventFromBooking :: Booking -> QF.QueryForm -> QF.TimeSlot -> SimpleEventUTC
eventFromBooking Booking {..} QF.QueryForm {..} slot = SimpleEvent {..}
......
......@@ -261,7 +261,6 @@ listUpcoming (GoogleCxt env) cid lookahead = do
-- sayEvent :: MonadIO m => Text -> SimpleEventUTC -> m ()
-- sayEvent prefix SimpleEvent {..} =
-- say $ prefix <> " " <> tshow seStart <> " " <> tshow seEnd <> " " <> seSummary
-- | Convert an event into a local time zone.
applyTz :: TZ -> SimpleEventUTC -> SimpleEventLocal
applyTz tz ev =
......
......@@ -24,16 +24,15 @@ module Handlers
, getVersionR
) where
import qualified BookingForm as BF
import BookingForm (b3Class, inputSize, labelSize)
import qualified BookingForm as BF
import Calendar
import Control.Monad.Trans.Maybe
import Data.FileEmbed (embedFile)
import qualified Data.SortedList as SL
import Data.Time.Clock (getCurrentTime, addUTCTime)
import qualified Network.Wai
import Development.GitRev
import Data.Time.Clock (addUTCTime, getCurrentTime)
import Data.Time.Zones (localTimeToUTCTZ, utcToLocalTimeTZ)
import Development.GitRev
import qualified FreshCache as FC
import Import
import qualified QueryForm as QF
......@@ -69,9 +68,7 @@ formSuccess ((formResult, _), _) =
getAvailR :: Handler Html
getAvailR = do
QF.QueryForm {..} <- formSuccess =<< runFormGet (QF.queryForm "" Nothing)
App { appSettings = AppSettings {..}
, appCalendarCache
} <- getYesod
App {appSettings = AppSettings {..}, appCalendarCache} <- getYesod
earliest <- addUTCTime appLeadTime <$> liftIO getCurrentTime
daysWithSlots <-
groupByDay .
......@@ -99,12 +96,14 @@ getBookR = do
showWhenWhere :: Handler (QF.QueryForm, QF.TimeSlot, Widget)
showWhenWhere = do
AppSettings{appDefaultTimeZone} <- appSettings <$> getYesod
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
if queryTzLabel == appDefaultTimeZone
then Nothing
else Just $
utcToLocalTimeTZ (tzByLabel appDefaultTimeZone) $
localTimeToUTCTZ (tzByLabel queryTzLabel) slotLocal
return (q, s, $(widgetFile "when-where"))
postBookR :: Handler Html
......@@ -129,7 +128,7 @@ postBookR = do
getFinalR :: Handler Html
getFinalR = do
(QF.QueryForm {..}, QF.TimeSlot {..}, whenWhere) <- showWhenWhere
BF.Booking{..} <- BF.fromSession
BF.Booking {..} <- BF.fromSession
defaultLayout $(widgetFile "final")
getClearR :: Handler Html
......@@ -148,7 +147,12 @@ getRobotsR =
return $ TypedContent typePlain $ toContent $(embedFile "config/robots.txt")
getVersionR :: Handler Text
getVersionR = do
req <- reqWaiRequest <$> getRequest
let hs = foldMap (\(h,v) -> tshow h <> ": " <> tshow v <> "\n") $ Network.Wai.requestHeaders req
return $ hs <> "\n" <> $(gitHash) <> if $(gitDirty) then "+" else ""
getVersionR
-- req <- reqWaiRequest <$> getRequest
-- let hs = foldMap (\(h,v) -> tshow h <> ": " <> tshow v <> "\n") $ Network.Wai.requestHeaders req
= do
return $
$(gitHash) <>
if $(gitDirty)
then "+"
else ""
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
......@@ -40,10 +40,10 @@ module QueryForm
) where
import Control.Monad.Trans.Maybe
import qualified Data.Map as Map
import qualified Data.Time.Format as TF
import Data.Time.LocalTime (LocalTime)
import Import
import qualified Data.Map as Map
import Text.Blaze (ToMarkup (..))
import Text.Julius (RawJS (..), ToJavascript (..))
......@@ -225,16 +225,15 @@ zonesByContinent =
Map.fromList $ map continent $ groupAllOn fst $ map splitTz allZones
where
allZones :: [TZLabelW]
allZones = [minBound..maxBound]
allZones = [minBound .. maxBound]
splitTz :: TZLabelW -> (Text, (Text, Text))
splitTz tz = (cont, (txt, prettyTz' (drop 1 city)))
where (cont, city) = break (== '/') txt
where
(cont, city) = break (== '/') txt
txt = toPathPiece tz
continent :: [(Text,a)] -> (Text,[a])
continent :: [(Text, a)] -> (Text, [a])
continent [] = error "zonesByContinent: Impossible"
continent ((x,y):xys) = (x, y : map snd xys)
continent ((x, y):xys) = (x, y : map snd xys)
-- | Present time zone choices.
tzSelectorField :: Text -> Field Handler TZLabelW
......@@ -244,7 +243,7 @@ tzSelectorField idReset = Field {..}
fieldParse (txt:_) _ = return $ Right $ fromPathPiece txt
fieldParse _ _ = return $ Left $ SomeMessage $ MsgInvalidEntry "Timezone"
fieldView _ name attrs val _ = do
AppSettings{appDefaultTimeZone} <- appSettings <$> getYesod
AppSettings {appDefaultTimeZone} <- appSettings <$> getYesod
(idShowDefaultTz, idTextTz, idSelectTz) <- newIdent3
let currentTz = toPathPiece $ either (const appDefaultTimeZone) id val
isDefaultTz = currentTz == toPathPiece appDefaultTimeZone
......@@ -256,7 +255,10 @@ qControl = "qcontrol"
-- | The complete query form for the front page.
queryForm ::
Text -> Maybe QueryForm -> Html -> MForm Handler (FormResult QueryForm, Widget)
Text
-> Maybe QueryForm
-> Html
-> MForm Handler (FormResult QueryForm, Widget)
queryForm idReset qOpt extra = do
AppSettings {..} <- appSettings <$> getYesod
let qs n = "" {fsName = Just (qiName n), fsAttrs = [("class", qControl)]}
......
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
......@@ -158,7 +158,7 @@ instance FromJSON AppSettings where
appFreeCalendarId <- o .: "free-calendar"
appBusyCalendarId <- o .: "busy-calendar"
appLookaheadWeeks <- o .: "look-ahead-weeks"
appLeadTime <- (*60) <$> (o .: "lead-time-minutes")
appLeadTime <- (* 60) <$> (o .: "lead-time-minutes")
appApptLengthsMinutes <- o .: "appointment-lengths-minutes"
appProviderName <- o .:? "provider-name"
appProviderAvatar <- o .:? "provider-avatar"
......
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