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 =
......@@ -66,9 +65,10 @@ bookingAForm 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?"
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
......@@ -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 BookingForm (b3Class, inputSize, labelSize)
import qualified BookingForm as BF
import BookingForm (b3Class, inputSize, labelSize)
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 Data.Time.Clock (addUTCTime, getCurrentTime)
import Data.Time.Zones (localTimeToUTCTZ, utcToLocalTimeTZ)
import Development.GitRev
import Data.Time.Zones (localTimeToUTCTZ, utcToLocalTimeTZ)
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 (..))
......@@ -215,7 +215,7 @@ prettyTz' = concatMap tzChars
where
tzChars '_' = " "
tzChars '/' = " » "
tzChars c = singleton c
tzChars c = singleton c
prettyTz :: TZLabelW -> Text
prettyTz = prettyTz' . toPathPiece
......@@ -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
txt = toPathPiece tz
continent :: [(Text,a)] -> (Text,[a])
continent [] = error "zonesByContinent: Impossible"
continent ((x,y):xys) = (x, y : map snd xys)
where
(cont, city) = break (== '/') txt
txt = toPathPiece tz
continent :: [(Text, a)] -> (Text, [a])
continent [] = error "zonesByContinent: Impossible"
continent ((x, y):xys) = (x, y : map snd xys)
-- | Present time zone choices.
tzSelectorField :: Text -> Field Handler TZLabelW
......@@ -242,9 +241,9 @@ tzSelectorField idReset = Field {..}
where
fieldEnctype = UrlEncoded
fieldParse (txt:_) _ = return $ Right $ fromPathPiece txt
fieldParse _ _ = return $ Left $ SomeMessage $ MsgInvalidEntry "Timezone"
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 LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
Module: Settings
......@@ -111,9 +111,9 @@ data AppSettings = AppSettings
-- ^ Valid lengths of appointments, in minutes
, appCacheExpiry :: NominalDiffTime
-- ^ Cached calendar data older than this will be refreshed
, appProviderName :: Maybe Text
, appProviderName :: Maybe Text
-- ^ Name of person/service providing appointments
, appProviderAvatar :: Maybe Text
, appProviderAvatar :: Maybe Text
-- ^ URL to image of person/service providing appointments
}
......@@ -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