half-baked Personal Assistant feature

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