nek0/yammat
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

change timestamp format to day

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

17
Handler/Home.hs
View file

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

17
Handler/NewUser.hs
View file

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

2
config/models
View file

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