diff options
Diffstat (limited to 'Handler')
| -rw-r--r-- | Handler/Category.hs | 1 | ||||
| -rw-r--r-- | Handler/Home.hs | 28 | ||||
| -rw-r--r-- | Handler/User.hs | 16 |
3 files changed, 11 insertions, 34 deletions
diff --git a/Handler/Category.hs b/Handler/Category.hs index 62928a2..6a2c6df 100644 --- a/Handler/Category.hs +++ b/Handler/Category.hs @@ -2,7 +2,6 @@ module Handler.Category where import Import -import Data.Maybe (fromMaybe) import qualified Data.Text as T getCategoryR :: TimeCategoryId -> Handler RepHtml diff --git a/Handler/Home.hs b/Handler/Home.hs index 3444a5b..34078d5 100644 --- a/Handler/Home.hs +++ b/Handler/Home.hs @@ -3,37 +3,11 @@ module Handler.Home where import Import --- 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 RepHtml getHomeR = do - (formWidget, formEnctype) <- generateFormPost sampleForm - let submission = Nothing :: Maybe (FileInfo, Text) - handlerName = "getHomeR" :: Text + people <- runDB $ selectList [] [] defaultLayout $ do aDomId <- lift newIdent setTitle "Welcome To Yesod!" $(widgetFile "homepage") -postHomeR :: Handler RepHtml -postHomeR = do - ((result, formWidget), formEnctype) <- runFormPost sampleForm - let handlerName = "postHomeR" :: Text - submission = case result of - FormSuccess res -> Just res - _ -> Nothing - - defaultLayout $ do - aDomId <- lift newIdent - setTitle "Welcome To Yesod!" - $(widgetFile "homepage") - -sampleForm :: Form (FileInfo, Text) -sampleForm = renderDivs $ (,) - <$> fileAFormReq "Choose a file" - <*> areq textField "What's on the file?" Nothing 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 |