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

Settings for time zone, location, etc

parent eba3190b
......@@ -10,6 +10,17 @@ ip-from-header: "_env:IP_FROM_HEADER:false"
# Uncomment to set an explicit approot
#approot: "_env:APPROOT:http://localhost:3000"
time-zone: _env:BOOKME_TIME_ZONE:America/New_York
locations:
- - "#office"
- At LIU Brooklyn (usually H700)
- - ""
- Online via Google Hangout or phone
free-calendar: _env:BOOKME_FREE_CAL:uhqg996jdq8gc8r8g1bee8clc8@group.calendar.google.com
busy-calendar: _env:BOOKME_BUSY_CAL:cleague@gmail.com
look-ahead-weeks: 4
# By default, `yesod devel` runs in development, and built executables use
# production settings (see below). To override this, use the following:
#
......
......@@ -35,6 +35,7 @@ dependencies:
- template-haskell
- text >=0.11 && <2.0
- time
- tz
- unordered-containers
- vector
- wai
......
This diff is collapsed.
This diff is collapsed.
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# 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 (..))
import Control.Lens ((^.))
import Data.Time.Clock (addUTCTime)
import Data.Time.Zones (utcToLocalTimeTZ)
import Data.Time.Zones.All (tzByLabel)
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)
-- Define our data that will be used for creating the form.
data FileForm = FileForm
{ fileInfo :: FileInfo
, fileDescription :: Text
}
{ 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
......@@ -29,57 +35,59 @@ data FileForm = FileForm
-- inclined, or create a single monolithic file.
getHomeR :: Handler Html
getHomeR = 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")
(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")
((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
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")
]
}
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
App{..} <- getYesod
lg <- newLogger Debug stdout
env <- newEnvWith appGoogleCreds lg appHttpManager <&> envScopes .~ calendarScope
xs <- runGoogle env $ send calendarListList
AppSettings {..} <- appSettings <$> getYesod
endUTC <- liftIO $ addUTCTime appLookahead <$> getCurrentTime
let endLocal = utcToLocalTimeTZ (tzByLabel appDefaultTimeZone) endUTC
xs <- runGoogle $ Google.send calendarListList
defaultLayout
[whamlet|
<h2>Hello calendar
<pre>#{show endLocal}
<ol>
$forall itemOpt <- xs ^. clItems
$maybe item <- itemOpt ^. cleSummary
......
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
......@@ -11,19 +12,24 @@
-- declared in the Foundation.hs file.
module Settings where
import ClassyPrelude.Yesod
import qualified Control.Exception as Exception
import Data.Aeson (Result (..), fromJSON, withObject, (.!=),
(.:?))
import Data.FileEmbed (embedFile)
import Data.Yaml (decodeEither')
import Language.Haskell.TH.Syntax (Exp, Name, Q)
import Network.Google.Auth (OAuthClient(..), ClientId(..), Secret(..))
import System.Environment (getEnv)
import Network.Wai.Handler.Warp (HostPreference)
import Yesod.Default.Config2 (applyEnvValue, configSettingsYml)
import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload,
widgetFileReload)
import ClassyPrelude.Yesod
import qualified Control.Exception as Exception
import Data.Aeson (Result (..), fromJSON, withObject,
(.!=), (.:?))
import qualified Data.Aeson.Types as Js
import Data.FileEmbed (embedFile)
import Data.Time.Clock (NominalDiffTime)
import Data.Time.Zones.All (TZLabel, fromTZName)
import Data.Yaml (decodeEither')
import Language.Haskell.TH.Syntax (Exp, Name, Q)
import Network.Google.Auth (OAuthClient(..), ClientId(..),
Secret(..))
import Network.Wai.Handler.Warp (HostPreference)
import System.Environment (getEnv)
import Yesod.Default.Config2 (applyEnvValue, configSettingsYml)
import Yesod.Default.Util (WidgetFileSettings,
widgetFileNoReload,
widgetFileReload)
-- | Runtime settings to configure this application. These settings can be
-- loaded from various sources: defaults, environment variables, config files,
......@@ -58,8 +64,21 @@ data AppSettings = AppSettings
-- ^ Copyright text to appear in the footer of the page
, appAnalytics :: Maybe Text
-- ^ Google Analytics code
, appDefaultTimeZone :: TZLabel
, appLocations :: [(Text,Text)]
, appFreeCalendarId :: Text
, appBusyCalendarId :: Text
, appLookahead :: NominalDiffTime
}
newtype TZLabelW = TZLabelW { unwrapTZLabel :: TZLabel }
instance FromJSON TZLabelW where
parseJSON v =
fromTZName . encodeUtf8 <$> parseJSON v >>= \case
Just tz -> return $ TZLabelW tz
Nothing -> Js.typeMismatch "TZLabel" v
instance FromJSON AppSettings where
parseJSON = withObject "AppSettings" $ \o -> do
let defaultDev =
......@@ -84,6 +103,11 @@ instance FromJSON AppSettings where
appCopyright <- o .: "copyright"
appAnalytics <- o .:? "analytics"
appDefaultTimeZone <- unwrapTZLabel <$> o .: "time-zone"
appLocations <- o .: "locations"
appFreeCalendarId <- o .: "free-calendar"
appBusyCalendarId <- o .: "busy-calendar"
appLookahead <- (7*24*60*60*) <$> o .: "look-ahead-weeks"
return AppSettings {..}
......
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