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
2339d123
Commit
2339d123
authored
May 31, 2018
by
Christopher League
Browse files
Some simplification, export list on Settings
parent
ec40b552
Changes
5
Hide whitespace changes
Inline
Side-by-side
config/settings.yml
View file @
2339d123
...
...
@@ -12,7 +12,6 @@ ip-from-header: "_env:IP_FROM_HEADER:false"
time-zone
:
_env:BOOKME_TIME_ZONE:America/New_York
appointment-lengths-minutes
:
[
15
,
20
,
25
]
default-appointment-length
:
15
locations
:
-
-
"
#office"
-
At LIU Brooklyn (usually H700)
...
...
@@ -27,10 +26,7 @@ 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
# production settings (see below). To override this, use the following:
#
# development: false
development
:
"
_env:BOOKME_DEVEL:false"
# Optional values with the following production defaults.
# In development, they default to the inverse.
...
...
src/Application.hs
View file @
2339d123
...
...
@@ -25,6 +25,7 @@ import Control.Monad.Logger (logInfoN, liftLoc)
import
qualified
FreshCache
as
FC
import
Import
import
Language.Haskell.TH.Syntax
(
qLocation
)
import
Data.Time.Clock
(
NominalDiffTime
)
import
Network.HTTP.Client.TLS
(
getGlobalManager
)
import
Network.Wai
(
Middleware
)
import
Network.Wai.Handler.Warp
(
Settings
,
...
...
@@ -54,13 +55,15 @@ import Handler.Home
-- comments there for more details.
mkYesodDispatch
"App"
resourcesApp
fromWeeks
::
Int
->
NominalDiffTime
fromWeeks
w
=
24
*
7
*
60
*
60
*
fromIntegral
w
-- | This function allocates resources (such as a database connection pool),
-- performs initialization and returns a foundation datatype value. This is also
-- the place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
makeFoundation
::
AppSettings
->
IO
App
makeFoundation
appSettings
@
AppSettings
{
..
}
=
do
verifySettings
appSettings
appHttpManager
<-
getGlobalManager
appLogger
<-
newStdoutLoggerSet
defaultBufSize
>>=
makeYesodLogger
appStatic
<-
...
...
@@ -68,16 +71,17 @@ makeFoundation appSettings@AppSettings{..} = do
let
partialApp
=
App
{
..
}
where
appCalendarCxt
=
error
"partialApp loop: Accessing appCalendarCxt"
appCalendar
Cache
=
error
"partialApp loop: Accessing appCalendar
Cache
"
appCalendarCxt
=
error
"partialApp loop: Accessing appCalendarCxt"
app
Get
Calendar
=
error
"partialApp loop: Accessing app
Get
Calendar"
logFunc
loc
src
lv
=
whenM
(
shouldLogIO
partialApp
""
lv
)
.
messageLoggerSource
partialApp
appLogger
loc
src
lv
appCalendarCxt
<-
Cal
.
initialize
logFunc
appHttpManager
appCredentials
appCalendarC
ache
<-
unsafeHandler
partialApp
$
FC
.
newCache
$
do
c
ache
<-
unsafeHandler
partialApp
$
FC
.
newCache
$
do
logInfoN
"Refreshing calendar cache"
Cal
.
listAvailMinusBusy
appCalendarCxt
appFreeCalendarId
appBusyCalendarId
appLookahead
appFreeCalendarId
appBusyCalendarId
$
fromWeeks
appLookaheadWeeks
let
appGetCalendar
=
FC
.
readCache
cache
.
fromMaybe
appCacheExpiry
return
App
{
..
}
-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
...
...
src/Foundation.hs
View file @
2339d123
...
...
@@ -9,16 +9,15 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module
Foundation
where
import
qualified
Calendar
as
Cal
import
qualified
FreshCache
as
FC
import
qualified
Calendar
as
Cal
import
qualified
Control.Monad.Catch
as
MC
import
Control.Monad.Logger
(
LogSource
)
import
qualified
Data.CaseInsensitive
as
CI
import
qualified
Data.Text.Encoding
as
TE
import
Data.Time.Clock
(
NominalDiffTime
)
import
Import.NoFoundation
as
Pre
import
Text.Hamlet
(
hamletFile
)
import
Text.Jasmine
(
minifym
)
...
...
@@ -31,12 +30,15 @@ import Yesod.Default.Util (addStaticContentExternal)
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data
App
=
App
{
appSettings
::
AppSettings
,
appStatic
::
Static
-- ^ Settings for static file serving.
{
appSettings
::
AppSettings
,
appStatic
::
Static
-- ^ Settings for static file serving.
,
appHttpManager
::
Manager
,
appLogger
::
Logger
,
appLogger
::
Logger
,
appCalendarCxt
::
Cal
.
Context
,
appCalendarCache
::
FC
.
Cache
(
HandlerFor
App
)
[
Cal
.
SimpleEventUTC
]
,
appGetCalendar
::
Maybe
NominalDiffTime
->
HandlerFor
App
[
Cal
.
SimpleEventUTC
]
-- ^ Fetch latest available times from the calendars. Return cached
-- version if it's less than given age, which defaults to
-- 'appCacheExpiry'.
}
data
MenuItem
=
MenuItem
...
...
@@ -72,14 +74,14 @@ instance MC.MonadCatch (HandlerFor App) where
addStylesheetL
::
Route
App
->
Text
->
[(
Text
,
Text
)]
->
Widget
addStylesheetL
route
cdn
attrs
=
appLocalAssets
.
appSettings
<$>
getYesod
>>=
\
case
True
->
addStylesheet
route
False
->
addStylesheetRemoteAttrs
cdn
attrs
True
->
addStylesheet
route
False
->
addStylesheetRemoteAttrs
cdn
attrs
addScriptL
::
Route
App
->
Text
->
[(
Text
,
Text
)]
->
Widget
addScriptL
route
cdn
attrs
=
appLocalAssets
.
appSettings
<$>
getYesod
>>=
\
case
True
->
addScript
route
False
->
addScriptRemoteAttrs
cdn
attrs
True
->
addScript
route
False
->
addScriptRemoteAttrs
cdn
attrs
-- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here.
...
...
@@ -126,19 +128,24 @@ instance Yesod App
widgetToPageContent
$
do
let
fontFamily
=
asText
"'Play', 'Helvetica Neue', Helvetica, Arial, sans-serif"
addScriptL
(
StaticR
js_jquery_3_3_1_min_js
)
addScriptL
(
StaticR
js_jquery_3_3_1_min_js
)
"https://code.jquery.com/jquery-3.3.1.min.js"
[(
"integrity"
,
"sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8="
)
,(
"crossorigin"
,
"anonymous"
)
[
(
"integrity"
,
"sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8="
)
,
(
"crossorigin"
,
"anonymous"
)
]
addScriptL
(
StaticR
js_js_cookie_2_2_0_min_js
)
addScriptL
(
StaticR
js_js_cookie_2_2_0_min_js
)
"https://cdn.jsdelivr.net/npm/js-cookie@2.2.0/src/js.cookie.min.js"
[]
addStylesheetRemote
"https://fonts.googleapis.com/css?family=Play:400,700"
addStylesheetL
(
StaticR
css_bootstrap_3_3_7_min_css
)
addStylesheetRemote
"https://fonts.googleapis.com/css?family=Play:400,700"
addStylesheetL
(
StaticR
css_bootstrap_3_3_7_min_css
)
"https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css"
[(
"integrity"
,
"sha384-BVYiiSIFeK1dGmJRAkycuHAHRg32OmUcww7on3RYdg4Va+PmSTsz/K68vbdEjh4u"
)
,(
"crossorigin"
,
"anonymous"
)
[
(
"integrity"
,
"sha384-BVYiiSIFeK1dGmJRAkycuHAHRg32OmUcww7on3RYdg4Va+PmSTsz/K68vbdEjh4u"
)
,
(
"crossorigin"
,
"anonymous"
)
]
-- $ StaticR css_bootstrap_css
$
(
widgetFile
"default-layout"
)
...
...
src/Handler/Home.hs
View file @
2339d123
...
...
@@ -11,23 +11,21 @@ module Handler.Home where
import
qualified
Calendar
as
Cal
import
qualified
Data.Time.Format
as
TF
import
qualified
FreshCache
as
FC
import
Import
import
Text.Julius
(
RawJS
(
..
))
apptLengthOptions
::
Handler
(
OptionList
ApptLength
)
apptLengthOptions
::
Handler
(
OptionList
Int
)
apptLengthOptions
=
do
lengths
<-
appApptLengths
.
appSettings
<$>
getYesod
lengths
<-
appApptLengths
Minutes
.
appSettings
<$>
getYesod
let
toOption
a
@
(
ApptLengthMinutes
m
)
=
toOption
m
=
Option
{
optionDisplay
=
tshow
m
<>
" minute"
,
optionInternalValue
=
a
,
optionInternalValue
=
m
,
optionExternalValue
=
tshow
m
}
okLength
m
=
if
len
`
elem
`
lengths
then
Just
len
else
Nothing
where
len
=
ApptLengthMinutes
m
if
m
`
elem
`
lengths
then
Just
m
else
Nothing
return
$
OptionList
{
olOptions
=
map
toOption
lengths
,
olReadExternal
=
fromPathPiece
>=>
okLength
...
...
@@ -80,7 +78,7 @@ timeFmtOptions = return $ OptionList
}
data
QueryForm
=
QueryForm
{
queryApptLength
::
ApptLength
{
queryApptLength
::
Int
,
queryTimeFmt
::
TimeFmt
,
queryTzLabel
::
TZLabelW
,
queryLocation
::
Location
...
...
@@ -92,7 +90,7 @@ queryForm extra = do
AppSettings
{
..
}
<-
appSettings
<$>
getYesod
qc
<-
newIdent
let
qs
n
=
""
{
fsName
=
Just
n
,
fsId
=
Just
n
,
fsAttrs
=
[(
"class"
,
qc
)]}
(
lenRes
,
lenView
)
<-
mreq
(
selectField
apptLengthOptions
)
(
qs
"len"
)
(
Just
appDefault
ApptLength
)
(
lenRes
,
lenView
)
<-
mreq
(
selectField
apptLengthOptions
)
(
qs
"len"
)
(
headMay
app
ApptLength
sMinutes
)
(
fmtRes
,
fmtView
)
<-
mreq
(
selectField
timeFmtOptions
)
(
qs
"fmt"
)
(
Just
def
)
(
locRes
,
locView
)
<-
mreq
locationField
(
qs
"loc"
)
(
headMay
appLocations
)
(
slotRes
,
_
)
<-
mopt
textField
(
qs
"slot"
)
Nothing
...
...
@@ -131,15 +129,11 @@ queryForm extra = do
|]
return
(
q
,
widget
)
readCache
::
Handler
[
Cal
.
SimpleEventUTC
]
readCache
=
(
appCalendarCache
&&&
appCacheExpiry
.
appSettings
)
<$>
getYesod
>>=
uncurry
FC
.
readCache
getHomeR
::
Handler
Html
getHomeR
=
do
-- Start (but don't wait for) refresh of calendar
void
$
async
$
readCache
App
{
..
}
<-
getYesod
void
$
async
$
appGetCalendar
Nothing
(
widget
,
enctype
)
<-
generateFormPost
queryForm
(
idSpinner
,
idAvail
,
idAlert
)
<-
(,,)
<$>
newIdent
<*>
newIdent
<*>
newIdent
defaultLayout
...
...
@@ -152,11 +146,10 @@ getAvailR = do
FormMissing
->
invalidArgs
[
"missing"
]
FormFailure
errs
->
invalidArgs
errs
FormSuccess
q
->
do
AppSettings
{
..
}
<-
a
ppSettings
<$>
getYesod
App
{
app
Settings
=
A
ppSettings
{
..
},
..
}
<-
getYesod
let
tz
=
tzByLabel
$
queryTzLabel
q
let
weeks
=
floor
(
appLookahead
/
secondsPerWeek
)
::
Int
evs1
<-
readCache
let
evs2
=
Cal
.
partitionSlots
(
apptLengthMinutes
(
queryApptLength
q
))
evs1
evs1
<-
appGetCalendar
Nothing
let
evs2
=
Cal
.
partitionSlots
(
queryApptLength
q
)
evs1
let
evs'
=
Cal
.
groupByDay
$
map
(
Cal
.
applyTz
tz
)
evs2
fmt
=
if
queryTimeFmt
q
==
Time12h
then
"%l:%M %p"
...
...
@@ -168,7 +161,7 @@ getAvailR = do
withUrlRenderer
[
hamlet
|
$if null evs'
No appointments available in the next #{
w
eeks} weeks.
No appointments available in the next #{
appLookaheadW
eeks} weeks.
$forall day <- evs'
$maybe firstSlot <- headMay day
<h4>#{showDate firstSlot}
...
...
src/Settings.hs
View file @
2339d123
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc.
-- In addition, you can configure a number of different aspects of Yesod
-- by overriding methods in the Yesod typeclass. That instance is
-- declared in the Foundation.hs file.
module
Settings
where
import
qualified
Calendar
as
Cal
{-|
Module: Settings
Description: Central server settings
Settings are centralized, as much as possible, into this file. This
includes database connection settings, static file locations, etc.
-}
module
Settings
(
AppSettings
(
..
)
,
TZLabelW
,
tzByLabel
,
Location
(
..
)
,
varGoogleRefreshToken
,
oauthClientFromEnv
,
compileTimeAppSettings
,
configSettingsYmlValue
,
widgetFile
,
combineStylesheets
,
combineScripts
)
where
import
qualified
Calendar
as
Cal
import
ClassyPrelude.Yesod
import
qualified
Control.Exception
as
Exception
import
Data.Aeson
(
Result
(
..
),
fromJSON
,
withObject
,
...
...
@@ -20,13 +34,13 @@ import Data.Aeson (Result (..), fromJSON, withObject,
import
qualified
Data.Aeson.Types
as
Js
import
Data.FileEmbed
(
embedFile
)
import
Data.Time.Clock
(
NominalDiffTime
)
import
qualified
Data.Time.Zones.All
as
TZ
import
Data.Time.Zones
(
TZ
)
import
Data.Time.Zones.All
(
TZLabel
,
fromTZName
,
toTZName
)
import
qualified
Data.Time.Zones.All
as
TZ
import
Data.Yaml
(
decodeEither'
)
import
Language.Haskell.TH.Syntax
(
Exp
,
Name
,
Q
)
import
Network.Google.Auth
(
OAuth
Client
(
..
),
Client
Id
(
..
),
Secret
(
..
))
import
Network.Google.Auth
(
Client
Id
(
..
),
OAuth
Client
(
..
),
Secret
(
..
))
import
Network.Wai.Handler.Warp
(
HostPreference
)
import
System.Environment
(
getEnv
)
import
Yesod.Default.Config2
(
applyEnvValue
,
configSettingsYml
)
...
...
@@ -34,76 +48,63 @@ import Yesod.Default.Util (WidgetFileSettings,
widgetFileNoReload
,
widgetFileReload
)
secondsPerWeek
::
NominalDiffTime
secondsPerWeek
=
7
*
24
*
60
*
60
-- | Represent the valid appointment lengths, in minutes.
newtype
ApptLength
=
ApptLengthMinutes
{
apptLengthMinutes
::
Int
}
deriving
(
Eq
,
Ord
,
Show
)
instance
FromJSON
ApptLength
where
parseJSON
s
=
ApptLengthMinutes
<$>
parseJSON
s
data
Location
=
Location
{
locId
::
Text
{
locId
::
Text
,
locSearch
::
Text
,
locDescr
::
Text
,
locDescr
::
Text
}
deriving
(
Show
,
Eq
)
makeLocs
::
[(
Text
,
Text
)]
->
[
Location
]
makeLocs
=
zipWith
mk
[
'A'
..
]
where
mk
c
(
s
,
d
)
=
Location
(
snoc
"loc"
c
)
s
d
makeLocs
::
[(
Text
,
Text
)]
->
[
Location
]
makeLocs
=
zipWith
mk
[
'A'
..
]
where
mk
c
(
s
,
d
)
=
Location
(
snoc
"loc"
c
)
s
d
-- | Runtime settings to configure this application. These settings can be
-- loaded from various sources: defaults, environment variables, config files,
-- theoretically even a database.
data
AppSettings
=
AppSettings
{
appStaticDir
::
String
{
appStaticDir
::
String
-- ^ Directory from which to serve static files.
,
appRoot
::
Maybe
Text
,
appRoot
::
Maybe
Text
-- ^ Base for all generated URLs. If @Nothing@, determined
-- from the request headers.
,
appHost
::
HostPreference
,
appHost
::
HostPreference
-- ^ Host/interface the server should bind to.
,
appPort
::
Int
,
appPort
::
Int
-- ^ Port to listen on
,
appIpFromHeader
::
Bool
,
appIpFromHeader
::
Bool
-- ^ Get the IP address from the header when logging. Useful when sitting
-- behind a reverse proxy.
,
appDetailedRequestLogging
::
Bool
,
appDetailedRequestLogging
::
Bool
-- ^ Use detailed request logging system
,
appShouldLogAll
::
Bool
,
appShouldLogAll
::
Bool
-- ^ Should all log messages be displayed?
,
appReloadTemplates
::
Bool
,
appReloadTemplates
::
Bool
-- ^ Use the reload version of templates
,
appMutableStatic
::
Bool
,
appMutableStatic
::
Bool
-- ^ Assume that files in the static dir may change after compilation
,
appSkipCombining
::
Bool
,
appSkipCombining
::
Bool
-- ^ Perform no stylesheet/script combining
,
appLocalAssets
::
Bool
,
appLocalAssets
::
Bool
-- ^ Use local assets, rather than CDN
-- Example app-specific configuration values.
,
appCopyright
::
Text
,
appCopyright
::
Text
-- ^ Copyright text to appear in the footer of the page
,
appAnalytics
::
Maybe
Text
,
appAnalytics
::
Maybe
Text
-- ^ Google Analytics code
,
appCredentials
::
Cal
.
Credentials
,
appDefaultTimeZone
::
TZLabelW
,
appLocations
::
[
Location
]
,
appFreeCalendarId
::
Text
,
appBusyCalendarId
::
Text
,
appLookahead
::
NominalDiffTime
,
appApptLengths
::
[
ApptLength
]
,
appDefaultApptLength
::
ApptLength
,
appCacheExpiry
::
NominalDiffTime
}
newtype
TZLabelW
=
TZLabelW
{
unwrapTZLabel
::
TZLabel
}
deriving
(
Eq
,
Show
,
Read
)
,
appCredentials
::
Cal
.
Credentials
,
appDefaultTimeZone
::
TZLabelW
,
appLocations
::
[
Location
]
,
appFreeCalendarId
::
Text
,
appBusyCalendarId
::
Text
,
appLookaheadWeeks
::
Int
,
appApptLengthsMinutes
::
[
Int
]
,
appCacheExpiry
::
NominalDiffTime
}
newtype
TZLabelW
=
TZLabelW
{
unwrapTZLabel
::
TZLabel
}
deriving
(
Eq
,
Show
,
Read
)
tzByLabel
::
TZLabelW
->
TZ
tzByLabel
=
TZ
.
tzByLabel
.
unwrapTZLabel
...
...
@@ -119,47 +120,35 @@ instance PathPiece TZLabelW where
fromPathPiece
=
fmap
TZLabelW
.
fromTZName
.
encodeUtf8
instance
FromJSON
AppSettings
where
parseJSON
=
withObject
"AppSettings"
$
\
o
->
do
let
defaultDev
=
#
ifdef
DEVELOPMENT
True
#
else
False
#
endif
appStaticDir
<-
o
.:
"static-dir"
appRoot
<-
o
.:?
"approot"
appHost
<-
fromString
<$>
o
.:
"host"
appPort
<-
o
.:
"port"
appIpFromHeader
<-
o
.:
"ip-from-header"
dev
<-
o
.:?
"development"
.!=
defaultDev
appDetailedRequestLogging
<-
o
.:?
"detailed-logging"
.!=
dev
appShouldLogAll
<-
o
.:?
"should-log-all"
.!=
dev
appReloadTemplates
<-
o
.:?
"reload-templates"
.!=
dev
appMutableStatic
<-
o
.:?
"mutable-static"
.!=
dev
appSkipCombining
<-
o
.:?
"skip-combining"
.!=
dev
appLocalAssets
<-
o
.:?
"local-assets"
.!=
dev
appCopyright
<-
o
.:
"copyright"
appAnalytics
<-
o
.:?
"analytics"
appDefaultTimeZone
<-
o
.:
"time-zone"
appLocations
<-
makeLocs
<$>
o
.:
"locations"
appFreeCalendarId
<-
o
.:
"free-calendar"
appBusyCalendarId
<-
o
.:
"busy-calendar"
appLookahead
<-
(
*
secondsPerWeek
)
<$>
o
.:
"look-ahead-weeks"
appApptLengths
<-
o
.:
"appointment-lengths-minutes"
appDefaultApptLength
<-
o
.:
"default-appointment-length"
appCredentials
<-
o
.:
"calendar-credentials"
appCacheExpiry
<-
o
.:?
"calendar-refresh-seconds"
.!=
(
if
dev
then
15
else
300
)
return
AppSettings
{
..
}
-- | Run a consistency check for settings.
verifySettings
::
MonadIO
m
=>
AppSettings
->
m
()
verifySettings
AppSettings
{
..
}
=
unless
(
appDefaultApptLength
`
elem
`
appApptLengths
)
$
throwString
"invalid default-appointment-length"
parseJSON
=
withObject
"AppSettings"
$
\
o
->
do
appStaticDir
<-
o
.:
"static-dir"
appRoot
<-
o
.:?
"approot"
appHost
<-
fromString
<$>
o
.:
"host"
appPort
<-
o
.:
"port"
appIpFromHeader
<-
o
.:
"ip-from-header"
dev
<-
o
.:?
"development"
.!=
False
appDetailedRequestLogging
<-
o
.:?
"detailed-logging"
.!=
dev
appShouldLogAll
<-
o
.:?
"should-log-all"
.!=
dev
appReloadTemplates
<-
o
.:?
"reload-templates"
.!=
dev
appMutableStatic
<-
o
.:?
"mutable-static"
.!=
dev
appSkipCombining
<-
o
.:?
"skip-combining"
.!=
dev
appLocalAssets
<-
o
.:?
"local-assets"
.!=
dev
appCopyright
<-
o
.:
"copyright"
appAnalytics
<-
o
.:?
"analytics"
appDefaultTimeZone
<-
o
.:
"time-zone"
appLocations
<-
makeLocs
<$>
o
.:
"locations"
appFreeCalendarId
<-
o
.:
"free-calendar"
appBusyCalendarId
<-
o
.:
"busy-calendar"
appLookaheadWeeks
<-
o
.:
"look-ahead-weeks"
appApptLengthsMinutes
<-
o
.:
"appointment-lengths-minutes"
appCredentials
<-
o
.:
"calendar-credentials"
appCacheExpiry
<-
o
.:?
"calendar-refresh-seconds"
.!=
(
if
dev
then
15
else
300
)
return
AppSettings
{
..
}
-- | Settings for 'widgetFile', such as which template languages to support and
-- default Hamlet settings.
...
...
@@ -176,12 +165,12 @@ combineSettings = def
-- The rest of this file contains settings which rarely need changing by a
-- user.
widgetFile
::
String
->
Q
Exp
widgetFile
=
(
if
appReloadTemplates
compileTimeAppSettings
then
widgetFileReload
else
widgetFileNoReload
)
widgetFileSettings
widgetFile
=
(
if
appReloadTemplates
compileTimeAppSettings
then
widgetFileReload
else
widgetFileNoReload
)
widgetFileSettings
-- | Raw bytes at compile time of @config/settings.yml@
configSettingsYmlBS
::
ByteString
...
...
@@ -189,31 +178,28 @@ configSettingsYmlBS = $(embedFile configSettingsYml)
-- | @config/settings.yml@, parsed to a @Value@.
configSettingsYmlValue
::
Value
configSettingsYmlValue
=
either
Exception
.
throw
id
$
decodeEither'
configSettingsYmlBS
configSettingsYmlValue
=
either
Exception
.
throw
id
$
decodeEither'
configSettingsYmlBS
-- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@.
compileTimeAppSettings
::
AppSettings
compileTimeAppSettings
=
case
fromJSON
$
applyEnvValue
False
mempty
configSettingsYmlValue
of
Error
e
->
error
e
Success
settings
->
settings
case
fromJSON
$
applyEnvValue
False
mempty
configSettingsYmlValue
of
Error
e
->
error
e
Success
settings
->
settings
-- The following two functions can be used to combine multiple CSS or JS files
-- at compile time to decrease the number of http requests.
-- Sample usage (inside a Widget):
--
-- > $(combineStylesheets 'StaticR [style1_css, style2_css])
combineStylesheets
::
Name
->
[
Route
Static
]
->
Q
Exp
combineStylesheets
=
combineStylesheets'
(
appSkipCombining
compileTimeAppSettings
)
combineSettings
combineStylesheets
=
combineStylesheets'
(
appSkipCombining
compileTimeAppSettings
)
combineSettings
combineScripts
::
Name
->
[
Route
Static
]
->
Q
Exp
combineScripts
=
combineScripts'
(
appSkipCombining
compileTimeAppSettings
)
combineSettings
combineScripts
=
combineScripts'
(
appSkipCombining
compileTimeAppSettings
)
combineSettings
varGoogleClientId
::
IsString
s
=>
s
varGoogleClientId
=
"BOOKME_GOOGLE_ID"
...
...
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