summaryrefslogtreecommitdiff
path: root/Handler
diff options
context:
space:
mode:
Diffstat (limited to 'Handler')
-rw-r--r--Handler/User.hs21
1 files changed, 16 insertions, 5 deletions
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