Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Christopher League
bookme
Commits
496f8c44
Commit
496f8c44
authored
May 30, 2018
by
Christopher League
Browse files
Clean up, document Calendar
parent
d65b2142
Changes
11
Expand all
Hide whitespace changes
Inline
Side-by-side
config/routes
View file @
496f8c44
...
...
@@ -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
View file @
496f8c44
...
...
@@ -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
View file @
496f8c44
...
...
@@ -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/Calendar.hs
View file @
496f8c44
...
...
@@ -2,58 +2,92 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-|
Module: Calendar
Description: Query and manipulate calendars and events.
This module contains facilities for querying and manipulating
calendars and their events. It supports both Google calendars and a
mock calendar for used for testing and debugging.
-}
module
Calendar
(
Credentials
,
Scope
(
Scope
,
Credentials
,
Context
,
CalendarId
,
SimpleEvent
(
..
)
,
initialize
,
listCalendars
,
applyTz
,
groupByDay
,
listAvailMinusBusy
,
partitionSlots
)
where
import
ClassyPrelude.Yesod
import
Control.Lens
((
.~
),
(
<&>
),
(
^.
))
import
Control.Monad.Logger
(
Loc
,
LogSource
,
LogStr
,
defaultLoc
)
import
Control.Monad.Logger
(
Loc
,
LogSource
,
LogStr
,
defaultLoc
)
import
qualified
Data.Aeson
as
Js
import
Data.ByteString.Builder
(
toLazyByteString
)
import
Data.Function
((
&
))
import
Data.Time.Clock
(
DiffTime
,
NominalDiffTime
,
addUTCTime
)
import
Data.Time.LocalTime
(
LocalTime
(
..
))
import
Data.Time.Zones
(
TZ
,
utcToLocalTimeTZ
)
import
qualified
Network.Google
as
Google
import
Network.Google.AppsCalendar
import
System.Log.FastLogger
(
toLogStr
)
import
qualified
Data.Aeson
as
Js
import
qualified
Network.Google
as
Google
import
qualified
Network.Google.Auth
as
Google
import
qualified
Network.Google.Auth
as
Google
import
qualified
Network.Google.Auth.ApplicationDefault
as
Google
import
System.Log.FastLogger
(
toLogStr
)
-- | Google authorization scope representing calendar operations.
type
Scope
=
'
[
"https://www.googleapis.com/auth/calendar"
]
mockClientId
::
Text
mockClientId
=
"mock"
-- | Credentials needed for accessing the calendar.
data
Credentials
=
MockCreds
|
GoogleCreds
(
Google
.
Credentials
Scope
)
-- | Doesn't reveal the credentials, but simply allows to distinguish
-- whether they are for Google or mocked.
instance
Show
Credentials
where
show
MockCreds
=
"<mock>"
show
MockCreds
=
"<mock>"
show
(
GoogleCreds
_
)
=
"<google>"
-- | If the field @client_id@ is just the string @"mock"@, then we use
-- a mock calender. Otherwise, we attempt to use @client_id@,
-- @client_secret@, and @refresh_token@ as Google credentials.
instance
FromJSON
Credentials
where
parseJSON
=
Js
.
withObject
"Credentials"
$
\
o
->
o
.:
"client_id"
>>=
\
c
->
if
c
==
mockClientId
then
return
MockCreds
else
either
fail
(
return
.
GoogleCreds
)
$
Google
.
fromJSONCredentials
$
Js
.
encode
o
parseJSON
=
Js
.
withObject
"Credentials"
$
\
o
->
o
.:
"client_id"
>>=
\
c
->
if
c
==
asText
"mock"
then
return
MockCreds
else
either
fail
(
return
.
GoogleCreds
)
$
Google
.
fromJSONCredentials
$
Js
.
encode
o
-- | This represents a ready-to-use environment for calendar
-- operations.
data
Context
=
MockCxt
=
MockCxt
Day
|
GoogleCxt
(
Google
.
Env
Scope
)
type
LogFunc
=
Loc
->
LogSource
->
LogLevel
->
LogStr
->
IO
()
initialize
::
LogFunc
->
Manager
->
Credentials
->
IO
Context
-- | Use the static credentials to create a dynamic context for
-- calendar operations. The Google environment requires a logging
-- function and an HTTP manager. If using a mock calendar, a warning is
-- printed using the logging function.
initialize
::
(
Loc
->
LogSource
->
LogLevel
->
LogStr
->
IO
()
)
->
Manager
->
Credentials
->
IO
Context
initialize
appLog
_
MockCreds
=
do
appLog
defaultLoc
""
LevelWarn
"Using mock calendar"
return
MockCxt
MockCxt
.
succ
.
utctDay
<$>
getCurrentTime
initialize
appLog
manager
(
GoogleCreds
creds
)
=
GoogleCxt
<$>
(
Google
.
newEnvWith
creds
gooLog
manager
<&>
Google
.
envScopes
.~
calendarScope
)
...
...
@@ -61,14 +95,176 @@ initialize appLog manager (GoogleCreds creds) =
gooLog
level
builder
=
appLog
defaultLoc
""
lv
(
toLogStr
(
toLazyByteString
builder
))
where
lv
=
case
level
of
Google
.
Info
->
LevelInfo
Google
.
Error
->
LevelError
Google
.
Debug
->
LevelDebug
Google
.
Trace
->
LevelOther
"trace"
listCalendars
::
MonadResource
m
=>
Context
->
m
[
Text
]
listCalendars
MockCxt
=
return
[]
listCalendars
(
GoogleCxt
env
)
=
do
xs
<-
Google
.
runGoogle
env
$
Google
.
send
calendarListList
return
$
mapMaybe
(
^.
cleSummary
)
(
xs
^.
clItems
)
lv
=
case
level
of
Google
.
Info
->
LevelInfo
Google
.
Error
->
LevelError
Google
.
Debug
->
LevelDebug
Google
.
Trace
->
LevelOther
"trace"
-- | A record containing just the essential event data, abstracted over
-- the type of the time-stamp.
data
SimpleEvent
t
=
SimpleEvent
{
seSummary
::
Text
,
seStart
::
t
,
seEnd
::
t
}
deriving
(
Show
)
type
SimpleEventUTC
=
SimpleEvent
UTCTime
type
SimpleEventLocal
=
SimpleEvent
LocalTime
-- | Extract essential event data from a Google @Event@ object.
simplifyEvent
::
Event
->
Maybe
SimpleEventUTC
simplifyEvent
e
=
do
let
seSummary
=
fromMaybe
""
$
e
^.
eSummary
seStart
<-
e
^.
eStart
>>=
(
^.
edtDateTime
)
seEnd
<-
e
^.
eEnd
>>=
(
^.
edtDateTime
)
return
SimpleEvent
{
..
}
-- | A synonym representing the ID of a calendar. For mock calendars,
-- the ID @"busy"@ simulates busy events, otherwise they are available
-- time slots.
type
CalendarId
=
Text
-- | Advance forward the specified number of days.
fwd
::
Int
->
Day
->
Day
fwd
n
|
n
<=
0
=
id
|
otherwise
=
fwd
(
n
-
1
)
.
succ
-- | Convert an HMM-formatted integer to the number of seconds. By HMM,
-- we mean like writing the time without the colon, so @215@ represents
-- 02:15 AM (== 8100 seconds) rather than 215 minutes == 3 hours and 35
-- minutes. This is only used for constructing the mock calendar.
toSec
::
Int
->
DiffTime
toSec
hmm
=
fromInteger
$
h
*
3600
+
m
*
60
where
(
h
,
m
)
=
divMod
(
toInteger
hmm
)
100
-- | Construct a sample event for the mock calendar.
sampleEvent
::
Day
->
(
Text
,
Day
->
Day
,
Int
,
Int
)
->
SimpleEventUTC
sampleEvent
d
(
summary
,
f
,
hmm1
,
hmm2
)
=
SimpleEvent
{
seSummary
=
summary
,
seStart
=
UTCTime
(
f
d
)
(
toSec
hmm1
)
,
seEnd
=
UTCTime
(
f
d
)
(
toSec
hmm2
)
}
-- | Fetch events from a single calendar.
listUpcoming
::
MonadResource
m
=>
Context
->
CalendarId
->
NominalDiffTime
-- ^How far to look ahead
->
m
[
SimpleEventUTC
]
listUpcoming
(
MockCxt
d
)
cid
_
=
return
$
map
(
sampleEvent
d
)
$
if
cid
==
"busy"
then
busy
else
free
where
busy
=
[
(
"busy1a"
,
fwd
0
,
1210
,
1300
)
,
(
"busy1b"
,
fwd
0
,
1330
,
1430
)
,
(
"busy1c"
,
fwd
0
,
1500
,
1550
)
,
(
"busy1d"
,
fwd
0
,
1730
,
1830
)
,
(
"busy2a"
,
fwd
1
,
1130
,
1215
)
,
(
"busy2b"
,
fwd
1
,
1330
,
1400
)
,
(
"busy2c"
,
fwd
1
,
1430
,
1500
)
,
(
"busy2d"
,
fwd
1
,
1610
,
1650
)
,
(
"busy3a"
,
fwd
2
,
1100
,
1400
)
,
(
"busy3b"
,
fwd
2
,
1900
,
2100
)
]
free
=
[
(
"free1a"
,
fwd
0
,
1100
,
1155
)
,
(
"free1b"
,
fwd
0
,
1300
,
1450
)
,
(
"free1c"
,
fwd
0
,
1530
,
1800
)
,
(
"free2a"
,
fwd
1
,
1200
,
1600
)
,
(
"free2b"
,
fwd
1
,
1700
,
1800
)
,
(
"free3a"
,
fwd
2
,
1000
,
1200
)
,
(
"free3b"
,
fwd
2
,
1500
,
1930
)
]
listUpcoming
(
GoogleCxt
env
)
cid
lookahead
=
do
now
<-
liftIO
getCurrentTime
let
end
=
addUTCTime
lookahead
now
xs
<-
Google
.
runGoogle
env
$
Google
.
send
$
eventsList
cid
&
elTimeMin
.~
Just
now
&
elTimeMax
.~
Just
end
return
$
mapMaybe
simplifyEvent
$
xs
^.
eveItems
-- | Convert an event into a local time zone.
applyTz
::
TZ
->
SimpleEventUTC
->
SimpleEventLocal
applyTz
tz
ev
=
SimpleEvent
{
seSummary
=
seSummary
ev
,
seStart
=
utcToLocalTimeTZ
tz
(
seStart
ev
)
,
seEnd
=
utcToLocalTimeTZ
tz
(
seEnd
ev
)
}
groupByDay
::
[
SimpleEventLocal
]
->
[[
SimpleEventLocal
]]
groupByDay
=
groupAllOn
(
localDay
.
seStart
)
-- | Construct a stream of events that represent available times with
-- chunks of busy times removed. Requires that the event streams are
-- already ordered.
availMinusBusy
::
Ord
t
=>
[
SimpleEvent
t
]
-- ^Available times
->
[
SimpleEvent
t
]
-- ^Busy times
->
[
SimpleEvent
t
]
-- ^Remaining available times
availMinusBusy
[]
_
=
[]
availMinusBusy
aa
[]
=
aa
availMinusBusy
(
a
:
aa
)
(
b
:
bb
)
-- A ends before B starts, so keep A and consider next A
|
seEnd
a
<=
seStart
b
=
a
:
availMinusBusy
aa
(
b
:
bb
)
-- B ends before A starts, so consider next B.
|
seEnd
b
<=
seStart
a
=
availMinusBusy
(
a
:
aa
)
bb
-- A is contained within B, so omit A and consider next A
|
seStart
b
<=
seStart
a
&&
seEnd
a
<=
seEnd
b
=
availMinusBusy
aa
(
b
:
bb
)
-- B is contained wholly within A, so split A and consider next B
|
seStart
a
<
seStart
b
&&
seEnd
b
<
seEnd
a
=
let
a1
=
a
{
seEnd
=
seStart
b
}
a2
=
a
{
seStart
=
seEnd
b
}
in
a1
:
availMinusBusy
(
a2
:
aa
)
bb
-- B overlaps beginning of A, so adjust A and consider next B
|
seStart
b
<=
seStart
a
&&
seEnd
b
<=
seEnd
a
=
let
a'
=
a
{
seStart
=
seEnd
b
}
in
availMinusBusy
(
a'
:
aa
)
bb
-- B overlaps end of A, so keep truncated A and consider next A
|
otherwise
{-seStart a <= seStart b && seEnd a <= seEnd b-}
=
let
a'
=
a
{
seEnd
=
seStart
b
}
in
a'
:
availMinusBusy
aa
(
b
:
bb
)
-- | Simultaneously fetch two calendars and return the difference
-- between them.
listAvailMinusBusy
::
(
MonadResource
m
,
MonadUnliftIO
m
)
=>
Context
->
CalendarId
-- ^Calendar with available times
->
CalendarId
-- ^Calendar with busy times
->
NominalDiffTime
-- ^How far to look ahead
->
m
[
SimpleEventUTC
]
listAvailMinusBusy
cxt
cidAvail
cidBusy
lookahead
=
do
availT
<-
async
$
listUpcoming
cxt
cidAvail
lookahead
busyT
<-
async
$
listUpcoming
cxt
cidBusy
(
lookahead
+
86400
)
availMinusBusy
<$>
waitAsync
availT
<*>
waitAsync
busyT
-- | Take a stream of available times and split them into slots exactly
-- N minutes long.
partitionSlots
::
Int
-- ^How many minutes per slot?
->
[
SimpleEventUTC
]
->
[
SimpleEventUTC
]
partitionSlots
_
[]
=
[]
partitionSlots
minutes
evs
=
loop
evs
where
dt
=
fromIntegral
$
minutes
*
60
loop
[]
=
[]
loop
(
e
:
es
)
=
let
et
=
addUTCTime
dt
(
seStart
e
)
in
if
et
<=
seEnd
e
then
e
{
seEnd
=
et
}
:
loop
(
e
{
seStart
=
et
}
:
es
)
else
loop
es
src/Foundation.hs
View file @
496f8c44
...
...
@@ -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
deleted
100644 → 0
View file @
d65b2142
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
View file @
496f8c44
...
...
@@ -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
i
d
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="
#{i
d
}-#{locId loc}" name=#{i
d
} 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
View file @
496f8c44
...
...
@@ -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
...
...
static/css/bootstrap-3.3.7.min.css
View file @
496f8c44
This diff is collapsed.
Click to expand it.
templates/default-layout.hamlet
View file @
496f8c44
...
...
@@ -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
View file @
496f8c44
...
...
@@ -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
);
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment