condensing code for profile settings

Handler/Commons.hs

@@ -2,6 +2,7 @@ module Handler.Commons where
 
 import Import
 import Yesod
+import Helper
 import Data.String
 
 loginIsAdmin :: IsString t => Handler (Either (t, Route App)  ())
@@ -18,3 +19,22 @@ loginIsAdmin = do
           return $ Left ("You have no admin rights", HomeR)
     Nothing ->
       return $ Left ("You are not logged in", LoginR)
+
+profileCheck :: IsString t => UserId -> Handler (Either (t, Route App) User)
+profileCheck userId = do
+  tempUser <- runDB $ get userId
+  case tempUser of
+    Just user -> do
+      msu <- lookupSession "userId"
+      case msu of
+        Just tempLoginId -> do
+          loginId <- return $ getUserIdFromText tempLoginId
+          case loginId == userId of
+            True ->
+              return $ Right user
+            False ->
+              return $ Left ("You can only change your own profile settings", UserR $ userName user)
+        Nothing ->
+          return $ Left ("You nedd to be logged in to change settings", LoginR)
+    Nothing ->
+      return $ Left ("This user does not exist", HomeR)

Handler/ProfileDelete.hs

@@ -1,6 +1,7 @@
 module Handler.ProfileDelete where
 
 import Import
+import Handler.Commons
 import qualified Data.Text as T
 import Data.Maybe
 import qualified Data.List as L
@@ -9,41 +10,21 @@ import System.FilePath
 
 getProfileDeleteR :: UserId -> Handler Html
 getProfileDeleteR userId = do
-  tempUser <- runDB $ get userId
-  case tempUser of
-    Just user -> do
-      username <- return $ userName user
-      msu <- lookupSession "userId"
-      case msu of
-        Just tempLoginId -> do
-          loginId <- return $ getUserIdFromText tempLoginId
-          case loginId == userId of
-            True -> do
+  checkRes <- profileCheck userId
+  case checkRes of
+    Right user -> do
       defaultLayout $ do
         setTitle "Eidolon :: Delete user profile"
         $(widgetFile "profileDelete")
-            False -> do
-              setMessage "You can only delete your own profile"
-              redirect $ UserR username
-        Nothing -> do
-          setMessage "You must be logged in to delete profiles"
-          redirect $ LoginR
-    Nothing -> do
-      setMessage "This user does not exist"
-      redirect $ HomeR
+    Left (errorMsg, route) -> do
+      setMessage errorMsg
+      redirect $ route
 
 postProfileDeleteR :: UserId -> Handler Html
 postProfileDeleteR userId = do
-  tempUser <- runDB $ get userId
-  case tempUser of
-    Just user -> do
-      username <- return $ userName user
-      msu <- lookupSession "userId"
-      case msu of
-        Just tempLoginId -> do
-          loginId <- return $ getUserIdFromText tempLoginId
-          case loginId == userId of
-            True -> do
+  checkRes <- profileCheck userId
+  case checkRes of
+    Right user -> do
       confirm <- lookupPostParam "confirm"
       case confirm of
         Just "confirm" -> do
@@ -69,12 +50,6 @@ postProfileDeleteR userId = do
         _ -> do
           setMessage "You must confirm the deletion"
           redirect $ ProfileSettingsR userId
-            False -> do
-              setMessage "You can only delete your own profile"
-              redirect $ UserR username
-        Nothing -> do
-          setMessage "You must be logged in to delete profiles"
-          redirect $ LoginR
-    Nothing -> do
-      setMessage "This user does not exist"
-      redirect $ HomeR
+    Left (errorMsg, route) -> do
+      setMessage errorMsg
+      redirect $ route

Handler/ProfileSettings.hs

@@ -1,45 +1,26 @@
 module Handler.ProfileSettings where
 
 import Import
+import Handler.Commons
 
 getProfileSettingsR :: UserId -> Handler Html
 getProfileSettingsR userId = do
-  tempUser <- runDB $ get userId
-  case tempUser of
-    Just user -> do
-      username <- return $ userName user
-      msu <- lookupSession "userId"
-      case msu of
-        Just tempLoginId -> do
-          loginId <- return $ getUserIdFromText tempLoginId
-          case loginId == userId of
-            True -> do
+  checkRes <- profileCheck userId
+  case checkRes of
+    Right user -> do
       (profileSettingsWidget, enctype) <- generateFormPost $ profileSettingsForm user
       defaultLayout $ do
         setTitle "Eidolon :: Profile settings"
         $(widgetFile "profileSettings")
-            False -> do
-              setMessage "You can only change your own profile settings"
-              redirect $ UserR username
-        Nothing -> do
-          setMessage "You need to be logged in to change settings"
-          redirect $ LoginR
-    Nothing -> do
-      setMessage "This user does not exist"
-      redirect $ HomeR
+    Left (errorMsg, route) -> do
+      setMessage errorMsg
+      redirect $ route
 
 postProfileSettingsR :: UserId -> Handler Html
 postProfileSettingsR userId = do
-  tempUser <- runDB $ get userId
-  case tempUser of
-    Just user -> do
-      username <- return $ userName user
-      msu <- lookupSession "userId"
-      case msu of
-        Just tempLoginId -> do
-          loginId <- return $ getUserIdFromText tempLoginId
-          case loginId == userId of
-            True -> do
+  checkRes <- profileCheck userId
+  case checkRes of
+    Right user -> do
       ((result, profileSettingsWidget), enctype) <- runFormPost $ profileSettingsForm user
       case result of
         FormSuccess temp -> do
@@ -49,19 +30,13 @@ postProfileSettingsR userId = do
            , UserEmail =. (userEmail temp)
            ]
          setMessage "Profile settings changed successfully"
-                  redirect $ UserR username
+         redirect $ UserR $ userName user
         _ -> do
           setMessage "There was an error changing your settings"
           redirect $ ProfileSettingsR userId
-            False -> do
-              setMessage "You can only change your own profile settings"
-              redirect $ UserR username
-        Nothing -> do
-          setMessage "You need to be logged in to change settings"
-          redirect $ LoginR
-    Nothing -> do
-      setMessage "This user does not exist"
-      redirect $ HomeR
+    Left (errorMsg, route) -> do
+      setMessage errorMsg
+      redirect $ route
 
 
 profileSettingsForm :: User -> Form User