{-# LANGUAGE TupleSections, OverloadedStrings #-} module Handler.User where import Import import Data.Maybe (fromMaybe, isJust) 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) import Control.Error.Util (hoistMaybe) import Control.Monad (join) import Control.Monad.Trans.Maybe (runMaybeT) getUserR :: UserId -> Handler Html getUserR cid = do user <- runDB $ get404 cid zzzma <- runMaybeT $ do a <- hoistMaybe =<< lift maybeAuth masst <- lift . runDB $ selectFirst [AssistantAssistant ==. entityKey a, AssistantAssisted ==. cid] [] return (entityKey a, isJust masst) let username = userIdent user let isThisUser = Just cid == fmap fst zzzma let isAssistant = Just True == fmap snd zzzma (pageNumber, pages) <- pagePosition cid let doPrev = pageNumber > 1 let doNext = pageNumber < pages let prevPageNumber = pageNumber - 1 let nextPageNumber = pageNumber + 1 let pageNavWidget = $(widgetFile "pagenav") 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 <- newIdent (setTitle . toHtml) ("Time entries for " `T.append` username) $(widgetFile "userpage") postUserR :: UserId -> Handler Html postUserR cid = do user <- runDB $ get404 cid zzzma <- runMaybeT $ do a <- hoistMaybe =<< lift maybeAuth masst <- lift . runDB $ selectFirst [AssistantAssistant ==. entityKey a, AssistantAssisted ==. cid] [] return (entityKey a, isJust masst) let username = userIdent user let isThisUser = Just cid == fmap fst zzzma let isAssistant = Just True == fmap snd zzzma (pageNumber, pages) <- pagePosition cid let doPrev = pageNumber > 1 let doNext = pageNumber < pages let prevPageNumber = pageNumber - 1 let nextPageNumber = pageNumber + 1 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 () _ -> return () entries <- runDB $ getEntriesForPage cid pageNumber defaultLayout $ do aDomId <- newIdent (setTitle . toHtml) ("Entry submitted for " `T.append` username) $(widgetFile "userpage") timeEntryAForm :: UTCTime -> [(Text,TimeCategoryId)] -> UserId -> AForm Handler TimeEntry timeEntryAForm ct cats uid = TimeEntry <$> pure uid <*> 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 Handler (FormResult TimeEntry, Widget) timeEntryForm u c h = do ct <- liftIO getCurrentTime renderDivs (timeEntryAForm ct c u) h -- getEntriesForPage :: UserId -> Int -> YesodDB m [(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 (timeEntryCategory e, x, hours e, day e, timeEntryNote e)) entries where -- cat :: TimeCategoryId -> YesodDB Handler TimeCategory cat y = do x <- getJust y return x day :: TimeEntry -> Text day = T.pack . show . timeEntryDay hours :: TimeEntry -> Text hours = T.pack . show . timeEntryHours pagePosition :: UserId -> Handler (Int, Int) pagePosition uid = do pageNumber <- fmap (either (const 1) id . fmap fst . fromMaybe (Right (1,"")) . fmap decimal) (lookupGetParam "page") cnt <- runDB $ count [TimeEntryUser ==. uid] return (pageNumber, ((cnt - 1) `div` 25) + 1) parttime :: Employment -> Bool parttime e = employmentCommitment e /= 1.0