Commit 496f8c44 authored by Christopher League's avatar Christopher League 🖥

Clean up, document Calendar

parent d65b2142
......@@ -6,9 +6,6 @@
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
/ HomeR GET POST
/ HomeR GET
/confirm ConfirmR POST
/api/available AvailR GET
/cals CalListR GET
/comments CommentR POST
/available AvailR GET
......@@ -23,8 +23,8 @@ calendar-credentials:
client_id: "_env:BOOKME_GOOGLE_ID:mock"
client_secret: "_env:BOOKME_GOOGLE_SECRET:"
refresh_token: "_env:BOOKME_GOOGLE_REFRESH:"
free-calendar: _env:BOOKME_FREE_CAL:uhqg996jdq8gc8r8g1bee8clc8@group.calendar.google.com
busy-calendar: _env:BOOKME_BUSY_CAL:cleague@gmail.com
free-calendar: _env:BOOKME_FREE_CAL:free
busy-calendar: _env:BOOKME_BUSY_CAL:busy
look-ahead-weeks: 4
# By default, `yesod devel` runs in development, and built executables use
......
......@@ -21,17 +21,9 @@ module Application
) where
import qualified Calendar as Cal
import Control.Lens ((.~), (<&>))
import Control.Monad.Logger (liftLoc)
import Control.Monad.Logger (defaultLoc)
import qualified Data.Aeson as Js
import Data.ByteString.Builder (toLazyByteString)
import Import
import Language.Haskell.TH.Syntax (qLocation)
import qualified Network.Google as Google
import Network.Google.AppsCalendar (calendarScope)
import Network.Google.Auth (OAuthClient (..))
import qualified Network.Google.Auth.ApplicationDefault as Google
import Network.HTTP.Client.TLS (getGlobalManager)
import Network.Wai (Middleware)
import Network.Wai.Handler.Warp (Settings,
......@@ -47,13 +39,10 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger),
destination,
mkRequestLogger,
outputFormat)
import System.Environment (getEnv)
import System.Log.FastLogger (defaultBufSize,
newStdoutLoggerSet,
toLogStr)
import Handler.Comment
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
import Handler.Common
......
This diff is collapsed.
......@@ -19,8 +19,6 @@ import Control.Monad.Logger (LogSource)
import qualified Data.CaseInsensitive as CI
import qualified Data.Text.Encoding as TE
import Import.NoFoundation as Pre
import qualified Network.Google as Google
import qualified Network.Google.Auth as Google
import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym)
import Yesod.Core.Types (Logger)
......@@ -128,7 +126,7 @@ instance Yesod App
asText "'Play', 'Helvetica Neue', Helvetica, Arial, sans-serif"
addScriptL (StaticR js_jquery_3_3_1_min_js)
"https://code.jquery.com/jquery-3.3.1.min.js"
[("integrity", "sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=")
[("integrity", "sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=")
,("crossorigin", "anonymous")
]
addScriptL (StaticR js_js_cookie_2_2_0_min_js)
......
module Handler.Comment where
import Import
postCommentR :: Handler Value
postCommentR =
error "The simple scaffolding does not support authentication or a database for storing comments"
......@@ -10,17 +10,9 @@
module Handler.Home where
import qualified Calendar as Cal
import Control.Lens ((^.))
import Data.Time.Clock (addUTCTime)
import Data.Time.Zones (utcToLocalTimeTZ)
import Data.Time.Zones.All (toTZName)
import qualified Data.Time.Format as TF
import Import
import qualified Network.Google as Google
import Network.Google.AppsCalendar (calendarListList, clItems,
cleSummary)
import Text.Julius (RawJS (..))
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..),
renderBootstrap3)
apptLengthOptions :: Handler (OptionList ApptLength)
apptLengthOptions = do
......@@ -49,14 +41,14 @@ locationField = Field{..}
return $ case find ((== txt) . locId) locs of
Nothing -> Left $ SomeMessage $ MsgInvalidEntry txt
Just loc -> Right $ Just loc
fieldView id name attrs val isReq = do
fieldView i _ attrs val _ = do
locs <- appLocations . appSettings <$> getYesod
[whamlet|
<div .form-group>
$forall loc <- locs
<div .radio>
<label>
<input id="#{id}-#{locId loc}" name=#{id} type=radio
<input ##{i}-#{locId loc}" name=#{i} type=radio
value=#{locId loc} :val == Right loc:checked
*{attrs}>
#{locDescr loc}
......@@ -77,6 +69,7 @@ instance PathPiece TimeFmt where
instance Default TimeFmt where
def = Time12h
timeFmtOptions :: Handler (OptionList TimeFmt)
timeFmtOptions = return $ OptionList
{ olReadExternal = fromPathPiece
, olOptions =
......@@ -147,21 +140,32 @@ getHomeR = do
getAvailR :: Handler Html
getAvailR = do
((qr, _), _) <- runFormGet queryForm
let
FormSuccess q = qr -- TODO
ds = [1..4] :: [Int]
ts =
if queryTimeFmt q == Time12h
then ["11:00 AM", "12:00 PM", "1:00 PM", "2:30 PM"]
else ["11:00", "12:00", "13:00", "14:30"] :: [Text]
slotV d t = tshow d <> "/" <> t
withUrlRenderer
[hamlet|
$forall d <- ds
<h4>Day #{tshow d}
$forall t <- ts
<button type=submit name=slot value="#{slotV d t}" .btn.btn-default.btn-small>#{t}
|]
case qr of
FormMissing -> invalidArgs ["missing"]
FormFailure errs -> invalidArgs errs
FormSuccess q -> do
App{..} <- getYesod
let AppSettings{..} = appSettings
tz = tzByLabel $ queryTzLabel q
evs1 <- Cal.listAvailMinusBusy appCalendarCxt appFreeCalendarId appBusyCalendarId appLookahead
let evs2 = Cal.partitionSlots (apptLengthMinutes (queryApptLength q)) evs1
let evs' = Cal.groupByDay $ map (Cal.applyTz tz) evs2
fmt = if queryTimeFmt q == Time12h
then "%l:%M %p"
else "%H:%M"
showDate = TF.formatTime TF.defaultTimeLocale "%A %e %B" . Cal.seStart
showTime e =
TF.formatTime TF.defaultTimeLocale fmt (Cal.seStart e) <>
": " <> unpack (Cal.seSummary e)
withUrlRenderer
[hamlet|
$forall day <- evs'
$maybe firstSlot <- headMay day
<h4>#{showDate firstSlot}
<p .slot-choices>
$forall slot <- day
<button type=submit name=slot value="TBD" .btn.btn-default.btn-small>#{showTime slot}
|]
postConfirmR :: Handler Html
postConfirmR = do
......@@ -172,77 +176,3 @@ postConfirmR = do
<p>
#{tshow qr}
|]
-- Define our data that will be used for creating the form.
data FileForm = FileForm
{ fileInfo :: FileInfo
, fileDescription :: Text
}
-- This is a handler function for the GET request method on the HomeR
-- resource pattern. All of your resource patterns are defined in
-- config/routes
--
-- The majority of the code you will write in Yesod lives in these handler
-- functions. You can spread them across multiple files if you are so
-- inclined, or create a single monolithic file.
oldgetHomeR :: Handler Html
oldgetHomeR = do
(formWidget, formEnctype) <- generateFormPost sampleForm
let submission = Nothing :: Maybe FileForm
handlerName = "getHomeR" :: Text
defaultLayout $ do
let (commentFormId, commentTextareaId, commentListId) = commentIds
aDomId <- newIdent
setTitle "Welcome To Yesod!"
$(widgetFile "homepage")
postHomeR :: Handler Html
postHomeR = do
((result, formWidget), formEnctype) <- runFormPost sampleForm
let handlerName = "postHomeR" :: Text
submission =
case result of
FormSuccess res -> Just res
_ -> Nothing
defaultLayout $ do
let (commentFormId, commentTextareaId, commentListId) = commentIds
aDomId <- newIdent
setTitle "Welcome To Yesod!"
$(widgetFile "homepage")
sampleForm :: Form FileForm
sampleForm =
renderBootstrap3 BootstrapBasicForm $
FileForm <$> fileAFormReq "Choose a file" <*>
areq textField textSettings Nothing
-- Add attributes like the placeholder and CSS classes.
where
textSettings =
FieldSettings
{ fsLabel = "What's on the file?"
, fsTooltip = Nothing
, fsId = Nothing
, fsName = Nothing
, fsAttrs =
[("class", "form-control"), ("placeholder", "File description")]
}
commentIds :: (Text, Text, Text)
commentIds = ("js-commentForm", "js-createCommentTextarea", "js-commentList")
getCalListR :: Handler Html
getCalListR = do
(AppSettings{..}, cxt) <- (appSettings &&& appCalendarCxt) <$> getYesod
endUTC <- liftIO $ addUTCTime appLookahead <$> getCurrentTime
let endLocal = utcToLocalTimeTZ (tzByLabel appDefaultTimeZone) endUTC
xs <- Cal.listCalendars cxt
defaultLayout
[whamlet|
<h2>Hello calendar
<pre>appLocalAssets: #{appLocalAssets}
<pre>#{show endLocal}
<ol>
$forall x <- xs
<li>#{x}
|]
......@@ -36,7 +36,7 @@ import Yesod.Default.Util (WidgetFileSettings,
-- | Represent the valid appointment lengths, in minutes.
newtype ApptLength =
ApptLengthMinutes Int
ApptLengthMinutes { apptLengthMinutes :: Int }
deriving (Eq, Ord, Show)
instance FromJSON ApptLength where
......
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -18,9 +18,3 @@
<div .row>
<div .col-md-12>
^{widget}
<!-- Footer -->
<footer .footer>
<div .container>
<p .text-muted>
#{appCopyright $ appSettings master}
......@@ -8,6 +8,10 @@
animation: glyphicon-spin-r 1s infinite linear;
}
.slot-choices button {
margin: 0 8px 10px 0;
}
@-webkit-keyframes glyphicon-spin-r {
0% {
-webkit-transform: rotate(0deg);
......
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