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,72 +10,46 @@ 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
-              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
+  checkRes <- profileCheck userId
+  case checkRes of
+    Right user -> do
+      defaultLayout $ do
+        setTitle "Eidolon :: Delete user profile"
+        $(widgetFile "profileDelete")
+    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
-              confirm <- lookupPostParam "confirm"
-              case confirm of
-                Just "confirm" -> do
-                  albumList <- return $ userAlbums user
-                  mapM (\albumId -> do
-                    album <- runDB $ getJust albumId
-                    mediaList <- return $ albumContent album
-                    mapM (\med -> do
-                      commEnts <- runDB $ selectList [CommentOrigin ==. med] []
-                      mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
-                      medium <- runDB $ getJust med
-                      liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
-                      liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
-                      runDB $ delete med
-                      ) mediaList
-                    runDB $ delete albumId
-                    ) albumList
-                  runDB $ delete userId
-                  liftIO $ removeDirectoryRecursive $ "static" </> "data" </> (T.unpack $ extractKey userId)
-                  deleteSession "userId"
-                  setMessage "User deleted successfully"
-                  redirect $ HomeR
-                _ -> 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
+  checkRes <- profileCheck userId
+  case checkRes of
+    Right user -> do
+      confirm <- lookupPostParam "confirm"
+      case confirm of
+        Just "confirm" -> do
+          albumList <- return $ userAlbums user
+          mapM (\albumId -> do
+            album <- runDB $ getJust albumId
+            mediaList <- return $ albumContent album
+            mapM (\med -> do
+              commEnts <- runDB $ selectList [CommentOrigin ==. med] []
+              mapM (\ent -> runDB $ delete $ entityKey ent) commEnts
+              medium <- runDB $ getJust med
+              liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
+              liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
+              runDB $ delete med
+              ) mediaList
+            runDB $ delete albumId
+            ) albumList
+          runDB $ delete userId
+          liftIO $ removeDirectoryRecursive $ "static" </> "data" </> (T.unpack $ extractKey userId)
+          deleteSession "userId"
+          setMessage "User deleted successfully"
+          redirect $ HomeR
+        _ -> do
+          setMessage "You must confirm the deletion"
+          redirect $ ProfileSettingsR userId
+    Left (errorMsg, route) -> do
+      setMessage errorMsg
+      redirect $ route

Handler/ProfileSettings.hs

@@ -1,67 +1,42 @@
 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
-              (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
+  checkRes <- profileCheck userId
+  case checkRes of
+    Right user -> do
+      (profileSettingsWidget, enctype) <- generateFormPost $ profileSettingsForm user
+      defaultLayout $ do
+        setTitle "Eidolon :: Profile settings"
+        $(widgetFile "profileSettings")
+    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
-              ((result, profileSettingsWidget), enctype) <- runFormPost $ profileSettingsForm user
-              case result of
-                FormSuccess temp -> do
-                  runDB $ update userId [
-                      UserName =. (userName temp)
-                    , UserSlug =. (userSlug temp)
-                    , UserEmail =. (userEmail temp)
-                    ]
-                  setMessage "Profile settings changed successfully"
-                  redirect $ UserR username
-                _ -> 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
+  checkRes <- profileCheck userId
+  case checkRes of
+    Right user -> do
+      ((result, profileSettingsWidget), enctype) <- runFormPost $ profileSettingsForm user
+      case result of
+        FormSuccess temp -> do
+         runDB $ update userId [
+             UserName =. (userName temp)
+           , UserSlug =. (userSlug temp)
+           , UserEmail =. (userEmail temp)
+           ]
+         setMessage "Profile settings changed successfully"
+         redirect $ UserR $ userName user
+        _ -> do
+          setMessage "There was an error changing your settings"
+          redirect $ ProfileSettingsR userId
+    Left (errorMsg, route) -> do
+      setMessage errorMsg
+      redirect $ route
 
 
 profileSettingsForm :: User -> Form User