Clean up, document Calendar

config/routes

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

config/settings.yml

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

src/Application.hs

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

src/Foundation.hs

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

src/Handler/Comment.hs

-module Handler.Comment where
-
-import Import
-
-postCommentR :: Handler Value
-postCommentR =
-    error "The simple scaffolding does not support authentication or a database for storing comments"

src/Handler/Home.hs

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

src/Settings.hs

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

templates/default-layout.hamlet

@@ -18,9 +18,3 @@
     <div .row>
         <div .col-md-12>
             ^{widget}
-
-<!-- Footer -->
-<footer .footer>
-    <div .container>
-        <p .text-muted>
-            #{appCopyright $ appSettings master}

templates/step1.lucius

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