change timestamp format to day

This commit is contained in:
nek0 2016-03-17 23:59:52 +01:00
parent a4956993de
commit 6720907137
3 changed files with 15 additions and 21 deletions

View file

@ -16,8 +16,8 @@
module Handler.Home where
import Import
import qualified Text.Read as R
import Data.Maybe
import Data.Time.Calendar (addDays)
-- This is a handler function for the GET request method on the HomeR
-- resource pattern. All of your resource patterns are defined in
@ -29,17 +29,15 @@ import Data.Maybe
getHomeR :: Handler Html
getHomeR = do
beverages <- runDB $ selectList [BeverageAmount !=. 0] [Desc BeverageIdent]
time <- liftIO getCurrentTime
let secs = R.read (formatTime defaultTimeLocale "%s" time) - 2592000
users <- runDB $ selectList [UserTimestamp >=. secs] [Asc UserIdent]
today <- liftIO $ return . utctDay =<< getCurrentTime
users <- runDB $ selectList [UserTimestamp >=. addDays (-30) today] [Asc UserIdent]
defaultLayout $
$(widgetFile "home")
getReactivateR :: Handler Html
getReactivateR = do
time <- liftIO getCurrentTime
let secs = R.read (formatTime defaultTimeLocale "%s" time) - 2592000
users <- runDB $ selectList [UserTimestamp <. secs] [Asc UserIdent]
today <- liftIO $ return . utctDay =<< getCurrentTime
users <- runDB $ selectList [UserTimestamp <. addDays (-30) today] [Asc UserIdent]
defaultLayout $
$(widgetFile "reactivate")
@ -48,9 +46,8 @@ getUserReactivateR uId = do
mUser <- runDB $ get uId
case mUser of
Just _ -> do
time <- liftIO getCurrentTime
let secs = R.read $ formatTime defaultTimeLocale "%s" time
runDB $ update uId [UserTimestamp =. secs]
today <- liftIO $ return . utctDay =<< getCurrentTime
runDB $ update uId [UserTimestamp =. today]
setMessageI MsgUserReactivated
redirect HomeR
Nothing -> do

View file

@ -17,26 +17,23 @@ module Handler.NewUser where
import Import as I
import Handler.Common
import Text.Read
import Text.Shakespeare.Text
getNewUserR :: Handler Html
getNewUserR = do
time <- liftIO getCurrentTime
let secs = read $ formatTime defaultTimeLocale "%s" time
today <- liftIO $ return . utctDay =<< getCurrentTime
(newUserWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ newUserForm secs
$ newUserForm today
defaultLayout $
$(widgetFile "newUser")
postNewUserR :: Handler Html
postNewUserR = do
time <- liftIO getCurrentTime
let secs = read $ formatTime defaultTimeLocale "%s" time
today <- liftIO $ return . utctDay =<< getCurrentTime
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ newUserForm secs
$ newUserForm today
case res of
FormSuccess user -> do
namesakes <- runDB $ selectList [UserIdent ==. userIdent user] []
@ -52,11 +49,11 @@ postNewUserR = do
setMessageI MsgUserNotCreated
redirect NewUserR
newUserForm :: Int -> AForm Handler User
newUserForm secs = User
newUserForm :: Day -> AForm Handler User
newUserForm today = User
<$> areq textField (bfs MsgName) Nothing
<*> pure 0
<*> pure secs
<*> pure today
<*> aopt emailField (bfs MsgEmailNotify) Nothing
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)

View file

@ -1,7 +1,7 @@
User
ident Text
balance Int
timestamp Int
timestamp Day
email Text Maybe
avatar AvatarId Maybe
UniqueUser ident