Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
B
bookme
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Christopher League
bookme
Commits
d55a1be9
Commit
d55a1be9
authored
Aug 19, 2019
by
Christopher League
🖥
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
ormolu formatting
parent
1b3f7ba0
Pipeline
#831
passed with stage
in 2 minutes and 12 seconds
Changes
12
Pipelines
1
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
793 additions
and
671 deletions
+793
-671
src/Application.hs
src/Application.hs
+91
-77
src/BookingForm.hs
src/BookingForm.hs
+55
-49
src/Calendar.hs
src/Calendar.hs
+168
-136
src/Foundation.hs
src/Foundation.hs
+104
-87
src/FreshCache.hs
src/FreshCache.hs
+26
-23
src/Handlers.hs
src/Handlers.hs
+54
-51
src/Import.hs
src/Import.hs
+4
-3
src/Import/NoFoundation.hs
src/Import/NoFoundation.hs
+16
-13
src/QueryForm.hs
src/QueryForm.hs
+100
-88
src/Settings.hs
src/Settings.hs
+135
-113
src/Settings/Auth.hs
src/Settings/Auth.hs
+37
-28
src/Settings/StaticFiles.hs
src/Settings/StaticFiles.hs
+3
-3
No files found.
src/Application.hs
View file @
d55a1be9
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude
#-}
{-# LANGUAGE OverloadedStrings
#-}
{-# LANGUAGE RecordWildCards
#-}
{-# LANGUAGE TemplateHaskell
#-}
{-# LANGUAGE TypeFamilies
#-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module
Application
(
getApplicationDev
,
appMain
,
develMain
,
makeFoundation
,
makeLogWare
(
getApplicationDev
,
appMain
,
develMain
,
makeFoundation
,
makeLogWare
,
-- * for DevelMain
,
getApplicationRepl
,
shutdownApp
getApplicationRepl
,
shutdownApp
,
-- * for GHCI
,
handler
)
where
handler
)
where
import
qualified
Calendar
as
Cal
import
Control.Monad.Logger
(
liftLoc
,
logInfoN
)
import
qualified
FreshCache
as
FC
import
Handlers
import
Import
import
Language.Haskell.TH.Syntax
(
qLocation
)
import
Network.HTTP.Client.TLS
(
getGlobalManager
)
import
Network.Wai
(
Middleware
)
import
Network.Wai.Handler.Warp
(
Settings
,
defaultSettings
,
defaultShouldDisplayException
,
getPort
,
runSettings
,
setHost
,
setOnException
,
setPort
)
import
Network.Wai.Middleware.RequestLogger
(
Destination
(
Logger
),
IPAddrSource
(
..
),
OutputFormat
(
..
),
destination
,
mkRequestLogger
,
outputFormat
)
import
System.Log.FastLogger
(
defaultBufSize
,
newStdoutLoggerSet
,
toLogStr
)
import
qualified
Calendar
as
Cal
import
Control.Monad.Logger
(
liftLoc
,
logInfoN
)
import
qualified
FreshCache
as
FC
import
Handlers
import
Import
import
Language.Haskell.TH.Syntax
(
qLocation
)
import
Network.HTTP.Client.TLS
(
getGlobalManager
)
import
Network.Wai
(
Middleware
)
import
Network.Wai.Handler.Warp
(
Settings
,
defaultSettings
,
defaultShouldDisplayException
,
getPort
,
runSettings
,
setHost
,
setOnException
,
setPort
)
import
Network.Wai.Middleware.RequestLogger
(
Destination
(
Logger
),
IPAddrSource
(
..
),
OutputFormat
(
..
),
destination
,
mkRequestLogger
,
outputFormat
)
import
System.Log.FastLogger
(
defaultBufSize
,
newStdoutLoggerSet
,
toLogStr
)
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
...
...
@@ -57,24 +66,26 @@ makeFoundation appSettings@AppSettings {..} = do
appHttpManager
<-
getGlobalManager
appLogger
<-
newStdoutLoggerSet
defaultBufSize
>>=
makeYesodLogger
appStatic
<-
(
if
appMutableStatic
then
staticDevel
else
static
)
(
if
appMutableStatic
then
staticDevel
else
static
)
appStaticDir
let
partialApp
=
App
{
..
}
where
appCalendarCxt
=
error
"partialApp loop: Accessing appCalendarCxt"
appCalendarCache
=
error
"partialApp loop: Accessing appCalendarCache"
logFunc
loc
src
lv
=
whenM
(
shouldLogIO
partialApp
""
lv
)
.
messageLoggerSource
partialApp
appLogger
loc
src
lv
whenM
(
shouldLogIO
partialApp
""
lv
)
.
messageLoggerSource
partialApp
appLogger
loc
src
lv
appCalendarCxt
<-
Cal
.
initialize
logFunc
appHttpManager
appCredentials
appCalendarCache
<-
unsafeHandler
partialApp
$
FC
.
newCache
appCacheExpiry
$
do
logInfoN
"Refreshing calendar cache"
Cal
.
listAvailMinusBusy
appCalendarCxt
appFreeCalendarId
appBusyCalendarId
$
fromWeeks
appLookaheadWeeks
unsafeHandler
partialApp
$
FC
.
newCache
appCacheExpiry
$
do
logInfoN
"Refreshing calendar cache"
Cal
.
listAvailMinusBusy
appCalendarCxt
appFreeCalendarId
appBusyCalendarId
$
fromWeeks
appLookaheadWeeks
return
App
{
..
}
-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
...
...
@@ -82,7 +93,7 @@ makeFoundation appSettings@AppSettings {..} = do
makeApplication
::
App
->
IO
Application
makeApplication
foundation
=
do
logWare
<-
makeLogWare
foundation
-- Create the WAI application and apply middlewares
-- Create the WAI application and apply middlewares
appPlain
<-
toWaiAppPlain
foundation
return
$
logWare
$
defaultMiddlewaresNoLogging
appPlain
...
...
@@ -93,29 +104,32 @@ makeLogWare foundation =
{
outputFormat
=
if
appDetailedRequestLogging
$
appSettings
foundation
then
Detailed
True
else
Apache
(
if
appIpFromHeader
$
appSettings
foundation
then
FromFallback
else
FromSocket
)
,
destination
=
Logger
$
loggerSet
$
appLogger
foundation
}
else
Apache
(
if
appIpFromHeader
$
appSettings
foundation
then
FromFallback
else
FromSocket
),
destination
=
Logger
$
loggerSet
$
appLogger
foundation
}
-- | Warp settings for the given foundation value.
warpSettings
::
App
->
Settings
warpSettings
foundation
=
setPort
(
appPort
$
appSettings
foundation
)
$
setHost
(
appHost
$
appSettings
foundation
)
$
setOnException
(
\
_req
e
->
when
(
defaultShouldDisplayException
e
)
$
messageLoggerSource
foundation
(
appLogger
foundation
)
$
(
qLocation
>>=
liftLoc
)
"yesod"
LevelError
(
toLogStr
$
"Exception from Warp: "
++
show
e
))
defaultSettings
setPort
(
appPort
$
appSettings
foundation
)
$
setHost
(
appHost
$
appSettings
foundation
)
$
setOnException
(
\
_req
e
->
when
(
defaultShouldDisplayException
e
)
$
messageLoggerSource
foundation
(
appLogger
foundation
)
$
(
qLocation
>>=
liftLoc
)
"yesod"
LevelError
(
toLogStr
$
"Exception from Warp: "
++
show
e
)
)
defaultSettings
-- | For yesod devel, return the Warp settings and WAI Application.
getApplicationDev
::
IO
(
Settings
,
Application
)
...
...
@@ -135,21 +149,21 @@ develMain = develMainHelper getApplicationDev
-- | The @main@ function for an executable running this site.
appMain
::
IO
()
appMain
-- Get the settings from all relevant sources
=
do
settings
<-
loadYamlSettingsArgs
appMain
=
-- Get the settings from all relevant sources
do
settings
<-
loadYamlSettingsArgs
-- fall back to compile-time values, set to [] to require values at runtime
[
configSettingsYmlValue
]
[
configSettingsYmlValue
]
-- allow environment variables to override
useEnv
useEnv
-- Generate the foundation from the settings
foundation
<-
makeFoundation
settings
foundation
<-
makeFoundation
settings
-- Generate a WAI Application from the foundation
app
<-
makeApplication
foundation
app
<-
makeApplication
foundation
-- Run the application with Warp
runSettings
(
warpSettings
foundation
)
app
runSettings
(
warpSettings
foundation
)
app
--------------------------------------------------------------
-- Functions for DevelMain.hs (a way to run the app from GHCi)
...
...
src/BookingForm.hs
View file @
d55a1be9
{-# LANGUAGE LambdaCase
#-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes
#-}
{-# LANGUAGE RecordWildCards
#-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-|
Module: BookingForm
...
...
@@ -11,35 +11,38 @@ Description: TODO
TODO
-}
module
BookingForm
(
Booking
(
..
)
,
bookingMForm
,
eventFromBooking
,
toSession
,
fromSessionMaybe
,
fromSession
,
b3Class
,
inputSize
,
labelSize
)
where
import
Calendar
import
Control.Monad.Trans.Maybe
import
Data.Aeson
((
.!=
),
(
.:?
))
import
qualified
Data.Aeson
as
Js
import
Data.Function
((
&
))
import
Data.Time.Clock
(
addUTCTime
)
import
Data.Time.Zones
import
Import
import
qualified
Network.HTTP.Simple
as
H
import
qualified
QueryForm
as
QF
import
qualified
Yesod.Form.Bootstrap3
as
B3
data
Booking
=
Booking
{
bookName
::
Text
,
bookEmail
::
Text
,
bookSubject
::
Text
,
bookContact
::
Maybe
Text
}
deriving
(
Show
)
(
Booking
(
..
),
bookingMForm
,
eventFromBooking
,
toSession
,
fromSessionMaybe
,
fromSession
,
b3Class
,
inputSize
,
labelSize
)
where
import
Calendar
import
Control.Monad.Trans.Maybe
import
Data.Aeson
((
.!=
),
(
.:?
))
import
qualified
Data.Aeson
as
Js
import
Data.Function
((
&
))
import
Data.Time.Clock
(
addUTCTime
)
import
Data.Time.Zones
import
Import
import
qualified
Network.HTTP.Simple
as
H
import
qualified
QueryForm
as
QF
import
qualified
Yesod.Form.Bootstrap3
as
B3
data
Booking
=
Booking
{
bookName
::
Text
,
bookEmail
::
Text
,
bookSubject
::
Text
,
bookContact
::
Maybe
Text
}
deriving
(
Show
)
toSession
::
MonadHandler
m
=>
Booking
->
m
()
toSession
Booking
{
..
}
=
do
...
...
@@ -77,12 +80,12 @@ submit = do
bookingAForm
::
Maybe
Booking
->
AForm
Handler
Booking
bookingAForm
bOpt
=
Booking
<$>
areq
textField
name
(
bookName
<$>
bOpt
)
<*>
areq
emailField
email
(
bookEmail
<$>
bOpt
)
<*>
areq
textField
subject
(
bookSubject
<$>
bOpt
)
<*>
aopt
textField
contact
(
bookContact
<$>
bOpt
)
<*
formToAForm
recaptcha
<*
formToAForm
submit
Booking
<$>
areq
textField
name
(
bookName
<$>
bOpt
)
<*>
areq
emailField
email
(
bookEmail
<$>
bOpt
)
<*>
areq
textField
subject
(
bookSubject
<$>
bOpt
)
<*>
aopt
textField
contact
(
bookContact
<$>
bOpt
)
<*
formToAForm
recaptcha
<*
formToAForm
submit
where
name
=
bfs
"*Name"
"Who are you?"
email
=
bfs
"*Email"
"You must use a valid email address"
...
...
@@ -90,12 +93,15 @@ bookingAForm bOpt =
bfs
"*Subject"
"What course are you in? What do you want to talk about?"
contact
=
bfs
"Contact"
"For online meetings, how do I reach you?"
data
RecaptchaResponse
=
RecaptchaResponse
{
rrSuccess
::
Bool
,
rrErrors
::
[
Text
]
}
deriving
(
Show
)
data
RecaptchaResponse
=
RecaptchaResponse
{
rrSuccess
::
Bool
,
rrErrors
::
[
Text
]
}
deriving
(
Show
)
instance
Js
.
FromJSON
RecaptchaResponse
where
parseJSON
=
Js
.
withObject
"RecaptchaResponse"
$
\
o
->
do
rrSuccess
<-
o
.:
"success"
...
...
@@ -115,11 +121,11 @@ recaptcha =
H
.
parseRequest
"POST https://www.google.com/recaptcha/api/siteverify"
let
req
=
req'
&
H
.
setRequestManager
mgr
&
H
.
setRequestBodyURLEncoded
[
(
"secret"
,
encodeUtf8
secret
)
,
(
"response"
,
encodeUtf8
response
)
]
req'
&
H
.
setRequestManager
mgr
&
H
.
setRequestBodyURLEncoded
[
(
"secret"
,
encodeUtf8
secret
),
(
"response"
,
encodeUtf8
response
)
]
resp
<-
H
.
getResponseBody
<$>
H
.
httpJSON
req
if
rrSuccess
resp
then
return
(
FormSuccess
()
,
[]
)
...
...
@@ -164,8 +170,8 @@ b3Class g =
B3
.
ColMd
n
->
"col-md-"
<>
tshow
n
B3
.
ColLg
n
->
"col-lg-"
<>
tshow
n
bookingMForm
::
Maybe
Booking
->
Html
->
MForm
Handler
(
FormResult
Booking
,
Widget
)
bookingMForm
::
Maybe
Booking
->
Html
->
MForm
Handler
(
FormResult
Booking
,
Widget
)
bookingMForm
=
B3
.
renderBootstrap3
horiz
.
bookingAForm
where
horiz
=
...
...
src/Calendar.hs
View file @
d55a1be9
This diff is collapsed.
Click to expand it.
src/Foundation.hs
View file @
d55a1be9
This diff is collapsed.
Click to expand it.
src/FreshCache.hs
View file @
d55a1be9
{-# LANGUAGE NoImplicitPrelude
#-}
{-# LANGUAGE OverloadedStrings
#-}
{-# LANGUAGE RecordWildCards
#-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
...
...
@@ -13,32 +13,35 @@ existing one is used. If it is requested after the time is expired, we
automatically refresh it. Should be thread-safe.
-}
module
FreshCache
(
Cache
,
newCache
,
readCache
,
invalidateCache
,
cacheDemo
)
where
(
Cache
,
newCache
,
readCache
,
invalidateCache
,
cacheDemo
)
where
import
ClassyPrelude.Yesod
import
Control.Concurrent
(
threadDelay
)
import
Data.Time.Clock
(
NominalDiffTime
,
diffUTCTime
)
import
ClassyPrelude.Yesod
import
Control.Concurrent
(
threadDelay
)
import
Data.Time.Clock
(
NominalDiffTime
,
diffUTCTime
)
data
CacheData
a
=
CacheData
{
value
::
a
,
retrievedAt
::
UTCTime
}
data
CacheData
a
=
CacheData
{
value
::
a
,
retrievedAt
::
UTCTime
}
data
CacheMeta
m
a
=
CacheMeta
{
content
::
Maybe
(
CacheData
a
)
,
maxAge
::
NominalDiffTime
,
refresh
::
m
a
}
data
CacheMeta
m
a
=
CacheMeta
{
content
::
Maybe
(
CacheData
a
),
maxAge
::
NominalDiffTime
,
refresh
::
m
a
}
-- | The cache structure. Saves the value 'a' which can be refreshed or
-- accessed within the monad 'm'.
newtype
Cache
m
a
=
Cache
(
MVar
(
CacheMeta
m
a
))
newtype
Cache
m
a
=
Cache
(
MVar
(
CacheMeta
m
a
))
-- | Create a new cache by running the action and saving it with a
-- timestamp.
...
...
src/Handlers.hs
View file @
d55a1be9
{-# LANGUAGE NamedFieldPuns
#-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes
#-}
{-# LANGUAGE RecordWildCards
#-}
{-# LANGUAGE TemplateHaskell
#-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
Module: Handlers
...
...
@@ -12,53 +12,54 @@ Description: TODO
TODO
-}
module
Handlers
(
getFaviconR
,
getRobotsR
,
getHomeR
,
getAvailR
,
postHomeR
,
getBookR
,
postBookR
,
getFinalR
,
getClearR
,
getVersionR
)
where
(
getFaviconR
,
getRobotsR
,
getHomeR
,
getAvailR
,
postHomeR
,
getBookR
,
postBookR
,
getFinalR
,
getClearR
,
getVersionR
)
where
import
BookingForm
(
b3Class
,
inputSize
,
labelSize
)
import
qualified
BookingForm
as
BF
import
Calendar
import
Control.Monad.Trans.Maybe
import
Data.FileEmbed
(
embedFile
)
import
qualified
Data.SortedList
as
SL
import
Data.Time.Clock
(
addUTCTime
,
getCurrentTime
)
import
Data.Time.Zones
(
localTimeToUTCTZ
,
utcToLocalTimeTZ
)
import
qualified
FreshCache
as
FC
import
Import
import
qualified
QueryForm
as
QF
import
Text.Hamlet
(
shamletFile
)
import
Text.Julius
(
RawJS
(
..
))
import
BookingForm
(
b3Class
,
inputSize
,
labelSize
)
import
qualified
BookingForm
as
BF
import
Calendar
import
Control.Monad.Trans.Maybe
import
Data.FileEmbed
(
embedFile
)
import
qualified
Data.SortedList
as
SL
import
Data.Time.Clock
(
addUTCTime
,
getCurrentTime
)
import
Data.Time.Zones
(
localTimeToUTCTZ
,
utcToLocalTimeTZ
)
import
qualified
FreshCache
as
FC
import
Import
import
qualified
QueryForm
as
QF
import
Text.Hamlet
(
shamletFile
)
import
Text.Julius
(
RawJS
(
..
))
-- | Home page, which shows query settings. Also has an AJAX facility
-- to get the available slots and show them as buttons.
getHomeR
::
Handler
Html
getHomeR
getHomeR
=
-- Start refresh of calendar, but don't wait for result.
=
do
App
{
appCalendarCache
}
<-
getYesod
void
$
async
$
FC
.
readCache
appCalendarCache
-- Produce form for query and display parameters: appointment length,
-- 12/24-hour time, time zone, location.
qOpt
<-
runMaybeT
QF
.
fromSession
bOpt
<-
runMaybeT
BF
.
fromSessionMaybe
(
idReset
,
idSpinner
,
idAvail
,
idAlert
)
<-
newIdent4
(
queryWidget
,
enctype
)
<-
generateFormPost
$
QF
.
queryForm
idReset
qOpt
defaultLayout
$
(
widgetFile
"homepage"
)
do
App
{
appCalendarCache
}
<-
getYesod
void
$
async
$
FC
.
readCache
appCalendarCache
-- Produce form for query and display parameters: appointment length,
-- 12/24-hour time, time zone, location.
qOpt
<-
runMaybeT
QF
.
fromSession
bOpt
<-
runMaybeT
BF
.
fromSessionMaybe
(
idReset
,
idSpinner
,
idAvail
,
idAlert
)
<-
newIdent4
(
queryWidget
,
enctype
)
<-
generateFormPost
$
QF
.
queryForm
idReset
qOpt
defaultLayout
$
(
widgetFile
"homepage"
)
-- | Ensure a successful form submission, or else throw a 400.
formSuccess
::
MonadHandler
m
=>
((
FormResult
a
,
b
),
c
)
->
m
a
formSuccess
((
formResult
,
_
),
_
)
=
case
formResult
of
FormMissing
->
invalidArgs
[
"Missing form data!"
]
FormMissing
->
invalidArgs
[
"Missing form data!"
]
FormFailure
errors
->
invalidArgs
errors
FormSuccess
result
->
return
result
...
...
@@ -70,12 +71,12 @@ getAvailR = do
App
{
appSettings
=
AppSettings
{
..
},
appCalendarCache
}
<-
getYesod
earliest
<-
addUTCTime
appLeadTime
<$>
liftIO
getCurrentTime
daysWithSlots
<-
groupByDay
.
SL
.
map
(
applyTz
(
tzByLabel
queryTzLabel
))
.
SL
.
dropWhile
((
<
earliest
)
.
seStart
)
.
partitionSlots
(
headMay
appApptLengthsMinutes
)
queryApptLength
.
SL
.
filter
(
summaryMatches
(
locSearch
queryLocation
))
<$>
FC
.
readCache
appCalendarCache
groupByDay
.
SL
.
map
(
applyTz
(
tzByLabel
queryTzLabel
))
.
SL
.
dropWhile
((
<
earliest
)
.
seStart
)
.
partitionSlots
(
headMay
appApptLengthsMinutes
)
queryApptLength
.
SL
.
filter
(
summaryMatches
(
locSearch
queryLocation
))
<$>
FC
.
readCache
appCalendarCache
return
$
(
shamletFile
"templates/avail.hamlet"
)
postHomeR
::
Handler
Html
...
...
@@ -100,9 +101,10 @@ showWhenWhere = do
let
inOtherZone
=
if
queryTzLabel
==
appDefaultTimeZone
then
Nothing
else
Just
$
utcToLocalTimeTZ
(
tzByLabel
appDefaultTimeZone
)
$
localTimeToUTCTZ
(
tzByLabel
queryTzLabel
)
slotLocal
else
Just
$
utcToLocalTimeTZ
(
tzByLabel
appDefaultTimeZone
)
$
localTimeToUTCTZ
(
tzByLabel
queryTzLabel
)
slotLocal
return
(
q
,
s
,
$
(
widgetFile
"when-where"
))
postBookR
::
Handler
Html
...
...
@@ -138,8 +140,9 @@ getClearR = clearSession >> redirect HomeR
getFaviconR
::
Handler
TypedContent
getFaviconR
=
do
cacheSeconds
$
60
*
60
*
24
*
30
-- cache for a month
return
$
TypedContent
"image/x-icon"
$
toContent
$
(
embedFile
"config/favicon.ico"
)
return
$
TypedContent
"image/x-icon"
$
toContent
$
(
embedFile
"config/favicon.ico"
)
getRobotsR
::
Handler
TypedContent
getRobotsR
=
...
...
src/Import.hs
View file @
d55a1be9
module
Import
(
module
Import
)
where
)
where
import
Foundation
as
Import
import
Import.NoFoundation
as
Import
import
Foundation
as
Import
import
Import.NoFoundation
as
Import
newIdent2
::
MonadHandler
m
=>
m
(
Text
,
Text
)
newIdent2
=
(,)
<$>
newIdent
<*>
newIdent
...
...
src/Import/NoFoundation.hs
View file @
d55a1be9
{-# LANGUAGE OverloadedStrings #-}
module
Import.NoFoundation
(
module
Import
,
pluralN
,
fromWeeks
,
fromMinutes
)
where
(
module
Import
,
pluralN
,
fromWeeks
,
fromMinutes
)
where
import
Calendar
as
Import
(
CalendarContext
,
SimpleEventUTC
)
import
ClassyPrelude.Yesod
as
Import
import
Data.Time.Clock
(
NominalDiffTime
)
import
Settings
as
Import
import
Settings.StaticFiles
as
Import
import
Yesod.Core.Types
as
Import
(
loggerSet
)
import
Yesod.Default.Config2
as
Import
import
Calendar
as
Import
(
CalendarContext
,
SimpleEventUTC
)
import
ClassyPrelude.Yesod
as
Import
import
Data.Time.Clock
(
NominalDiffTime
)
import
Settings
as
Import
import
Settings.StaticFiles
as
Import
import
Yesod.Core.Types
as
Import
(
loggerSet
)
import
Yesod.Default.Config2
as
Import
pluralN
::
Int
->
Text
->
Text
->
Text
pluralN
1
x
_
=
"1 "
<>
x
...
...
src/QueryForm.hs
View file @
d55a1be9
{-# LANGUAGE FlexibleContexts
#-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase
#-}
{-# LANGUAGE NamedFieldPuns
#-}
{-# LANGUAGE NoImplicitPrelude
#-}
{-# LANGUAGE OverloadedStrings
#-}
{-# LANGUAGE QuasiQuotes
#-}
{-# LANGUAGE RecordWildCards
#-}
{-# LANGUAGE TemplateHaskell
#-}
{-# LANGUAGE TypeFamilies
#-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}