diff options
Diffstat (limited to 'Handler/User.hs')
| -rw-r--r-- | Handler/User.hs | 16 |
1 files changed, 10 insertions, 6 deletions
diff --git a/Handler/User.hs b/Handler/User.hs index 499ba20..e89b365 100644 --- a/Handler/User.hs +++ b/Handler/User.hs @@ -6,6 +6,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Text.Read (decimal) import Data.Time.Clock (getCurrentTime, UTCTime, utctDay) +import Yesod.Auth (maybeAuth) import Yesod.Form.Jquery (jqueryDayField, def) getUserR :: UserId -> Handler RepHtml @@ -13,7 +14,7 @@ getUserR cid = do user <- runDB $ get404 cid ma <- maybeAuth let username = userIdent user - let isUser = Just user == fmap entityVal ma + let isThisUser = Just user == fmap entityVal ma (pageNumber, pages) <- pagePosition cid let doPrev = pageNumber > 1 let doNext = pageNumber < pages @@ -23,6 +24,7 @@ getUserR cid = do entries <- runDB $ getEntriesForPage cid pageNumber cats' <- runDB $ selectList [TimeCategoryDisabled ==. False] [] let cats = map (\x -> ((timeCategoryName . entityVal) x, entityKey x)) cats' + employments <- runDB $ selectList [EmploymentUser ==. cid] [Asc EmploymentStartDate] (formWidget, formEnctype) <- generateFormPost (timeEntryForm cid cats) defaultLayout $ do aDomId <- lift newIdent @@ -34,7 +36,7 @@ postUserR cid = do user <- runDB $ get404 cid ma <- maybeAuth let username = userIdent user - let isUser = Just user == fmap entityVal ma + let isThisUser = Just user == fmap entityVal ma (pageNumber, pages) <- pagePosition cid let doPrev = pageNumber > 1 let doNext = pageNumber < pages @@ -43,6 +45,7 @@ postUserR cid = do let pageNavWidget = $(widgetFile "pagenav") cats' <- runDB $ selectList [TimeCategoryDisabled ==. False] [] let cats = map (\x -> ((timeCategoryName . entityVal) x, entityKey x)) cats' + employments <- runDB $ selectList [EmploymentUser ==. cid] [Asc EmploymentStartDate] ((result, formWidget), formEnctype) <- runFormPost (timeEntryForm cid cats) _ <- case result of FormSuccess res -> (runDB $ insert res) >> return () @@ -60,6 +63,7 @@ timeEntryAForm ct cats uid = TimeEntry <*> areq (selectFieldList cats) "category" Nothing <*> areq (jqueryDayField def) "day" (Just (utctDay ct)) <*> areq doubleField "hours" Nothing + <*> areq textField "note" Nothing <*> pure ct timeEntryForm :: UserId -> [(Text,TimeCategoryId)] -> Html -> MForm App App (FormResult TimeEntry, Widget) @@ -67,14 +71,14 @@ timeEntryForm u c h = do ct <- liftIO getCurrentTime renderDivs (timeEntryAForm ct c u) h -getEntriesForPage :: UserId -> Int -> YesodDB App App [(Text, Text, Text)] +getEntriesForPage :: UserId -> Int -> YesodDB App App [(TimeCategoryId, TimeCategory, Text, Text, Text)] getEntriesForPage uid pageNumber = do entries <- selectList [TimeEntryUser ==. uid] [Desc TimeEntryTimestamp, LimitTo 25, OffsetBy ((pageNumber - 1) * 25)] - mapM (\(Entity _ e) -> cat (timeEntryCategory e) >>= \x -> return (x, hours e, day e)) entries + mapM (\(Entity _ e) -> cat (timeEntryCategory e) >>= \x -> return (timeEntryCategory e, x, hours e, day e, timeEntryNote e)) entries where - cat :: TimeCategoryId -> YesodDB App App Text + cat :: TimeCategoryId -> YesodDB App App TimeCategory cat y = do x <- getJust y - return $ timeCategoryName x + return x day :: TimeEntry -> Text day = T.pack . show . timeEntryDay hours :: TimeEntry -> Text |