From 180768dff27e4f31d1f66429b33feec75630b798 Mon Sep 17 00:00:00 2001 From: Clint Adams Date: Tue, 1 Apr 2014 17:01:44 -0400 Subject: half-baked Personal Assistant feature --- Handler/User.hs | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) (limited to 'Handler') diff --git a/Handler/User.hs b/Handler/User.hs index 57886b6..8032da9 100644 --- a/Handler/User.hs +++ b/Handler/User.hs @@ -2,19 +2,26 @@ module Handler.User where import Import -import Data.Maybe (fromMaybe) +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 - ma <- maybeAuth + 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 user == fmap entityVal ma + 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 @@ -34,9 +41,13 @@ getUserR cid = do postUserR :: UserId -> Handler Html postUserR cid = do user <- runDB $ get404 cid - ma <- maybeAuth + 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 user == fmap entityVal ma + 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 -- cgit v1.2.3