2015-08-09 21:16:33 +02:00
|
|
|
-- yammat - Yet Another MateMAT
|
|
|
|
-- Copyright (C) 2015 Amedeo Molnár
|
|
|
|
--
|
|
|
|
-- This program is free software: you can redistribute it and/or modify
|
|
|
|
-- it under the terms of the GNU Affero General Public License as published
|
|
|
|
-- by the Free Software Foundation, either version 3 of the License, or
|
|
|
|
-- (at your option) any later version.
|
|
|
|
--
|
|
|
|
-- This program is distributed in the hope that it will be useful,
|
|
|
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
-- GNU Affero General Public License for more details.
|
|
|
|
--
|
|
|
|
-- You should have received a copy of the GNU Affero General Public License
|
|
|
|
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
|
2015-04-04 06:46:33 +02:00
|
|
|
module Handler.Home where
|
|
|
|
|
|
|
|
import Import
|
2015-04-16 02:51:08 +02:00
|
|
|
import Data.Maybe
|
2016-03-17 23:59:52 +01:00
|
|
|
import Data.Time.Calendar (addDays)
|
2015-04-04 06:46:33 +02:00
|
|
|
|
|
|
|
-- 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.
|
|
|
|
getHomeR :: Handler Html
|
|
|
|
getHomeR = do
|
2018-10-02 21:05:31 +02:00
|
|
|
deleteSession "pinentry"
|
2017-06-03 03:00:04 +02:00
|
|
|
settings <- getsYesod appSettings
|
2015-04-04 06:46:33 +02:00
|
|
|
beverages <- runDB $ selectList [BeverageAmount !=. 0] [Desc BeverageIdent]
|
2017-01-21 18:02:29 +01:00
|
|
|
today <- liftIO $ utctDay <$> getCurrentTime
|
2016-03-17 23:59:52 +01:00
|
|
|
users <- runDB $ selectList [UserTimestamp >=. addDays (-30) today] [Asc UserIdent]
|
2017-05-16 00:25:33 +02:00
|
|
|
ousers <- runDB $ selectList [UserTimestamp <. addDays (-30) today] [Asc UserIdent]
|
2017-02-12 11:58:54 +01:00
|
|
|
defaultLayout $ do
|
|
|
|
addScript $ StaticR js_barcode_js
|
2018-09-04 18:06:12 +02:00
|
|
|
setTitleI MsgMainPage
|
2015-04-04 06:46:33 +02:00
|
|
|
$(widgetFile "home")
|
|
|
|
|
|
|
|
getReactivateR :: Handler Html
|
|
|
|
getReactivateR = do
|
2016-03-17 23:59:52 +01:00
|
|
|
today <- liftIO $ return . utctDay =<< getCurrentTime
|
|
|
|
users <- runDB $ selectList [UserTimestamp <. addDays (-30) today] [Asc UserIdent]
|
2017-02-12 11:58:54 +01:00
|
|
|
defaultLayout $ do
|
|
|
|
addScript $ StaticR js_barcode_js
|
2018-09-04 18:12:46 +02:00
|
|
|
setTitleI MsgReactivateOldUser
|
2015-04-04 06:46:33 +02:00
|
|
|
$(widgetFile "reactivate")
|
|
|
|
|
|
|
|
getUserReactivateR :: UserId -> Handler Html
|
|
|
|
getUserReactivateR uId = do
|
|
|
|
mUser <- runDB $ get uId
|
|
|
|
case mUser of
|
2015-12-06 21:14:58 +01:00
|
|
|
Just _ -> do
|
2016-03-17 23:59:52 +01:00
|
|
|
today <- liftIO $ return . utctDay =<< getCurrentTime
|
|
|
|
runDB $ update uId [UserTimestamp =. today]
|
2015-04-10 00:40:58 +02:00
|
|
|
setMessageI MsgUserReactivated
|
2015-09-15 00:49:13 +02:00
|
|
|
redirect HomeR
|
2015-04-04 06:46:33 +02:00
|
|
|
Nothing -> do
|
2015-04-10 00:40:58 +02:00
|
|
|
setMessageI MsgUserUnknown
|
2015-09-15 00:49:13 +02:00
|
|
|
redirect HomeR
|