Test handler to list calendars

config/routes

@@ -7,5 +7,6 @@
 /robots.txt RobotsR GET
 
 / HomeR GET POST
+/cals CalListR GET
 
 /comments CommentR POST

package.yaml

@@ -17,6 +17,7 @@ dependencies:
 - containers
 - data-default
 - directory              >=1.1   && <1.4
+- exceptions
 - fast-logger            >=2.2   && <2.5
 - file-embed
 - foreign-store

src/Foundation.hs

+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -9,9 +10,10 @@
 
 module Foundation where
 
-import Import.NoFoundation
+import Import.NoFoundation as Pre
 import Control.Monad.Logger        (LogSource)
 import Text.Hamlet                 (hamletFile)
+import qualified Control.Monad.Catch as MC
 import Text.Jasmine                (minifym)
 import Yesod.Core.Types            (Logger)
 import Yesod.Default.Util          (addStaticContentExternal)
@@ -59,6 +61,9 @@ mkYesodData "App" $(parseRoutesFile "config/routes")
 -- | A convenient synonym for creating forms.
 type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
 
+instance MC.MonadCatch (HandlerFor App) where
+  catch = Pre.catch
+
 -- Please see the documentation for the Yesod typeclass. There are a number
 -- of settings which can be configured by overriding methods here.
 instance Yesod App where

src/Handler/Home.hs

+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 module Handler.Home where
 
 import Import
+import Network.Google (LogLevel(Debug), newLogger, newEnvWith, envScopes, runGoogle, send)
+import Network.Google.AppsCalendar (calendarScope, calendarListList, clItems, cleSummary)
+import Control.Lens ((<&>), (.~), (^.))
 import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
 import Text.Julius (RawJS (..))
 
@@ -65,3 +70,18 @@ sampleForm = renderBootstrap3 BootstrapBasicForm $ FileForm
 
 commentIds :: (Text, Text, Text)
 commentIds = ("js-commentForm", "js-createCommentTextarea", "js-commentList")
+
+getCalListR :: Handler Html
+getCalListR = do
+  App{..} <- getYesod
+  lg <- newLogger Debug stdout
+  env <- newEnvWith appGoogleCreds lg appHttpManager <&> envScopes .~ calendarScope
+  xs <- runGoogle env $ send calendarListList
+  defaultLayout
+    [whamlet|
+            <h2>Hello calendar
+            <ol>
+              $forall itemOpt <- xs ^. clItems
+                $maybe item <- itemOpt ^. cleSummary
+                  <li>#{item}
+            |]