Refactored TestHelpers.hs to remove duplicate code (#1617)

Japleen-Kaur2409 · web-flow · commit 8afab66a67bc · 2025-10-27T14:42:30.000-04:00
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -37,6 +37,7 @@
 - Added documentation for running a subset of the backend tests
 - Deleted `app/Response/Image` file and refactored `app/Util/Helpers` to include `returnImageData`
 - Added test cases for the retrieveProgram function in `Controllers/Program`
+- Removed duplicate code from `mockRequest` and `runServerPartWith` in `backend-test/TestHelpers.hs`
 - Initialized a SchemaVersion table for the purposes of running robust database migrations
 
 ## [0.7.1] - 2025-06-16
diff --git a/backend-test/Controllers/CourseControllerTests.hs b/backend-test/Controllers/CourseControllerTests.hs
@@ -21,8 +21,7 @@ import Database.Tables (Courses (..))
 import Happstack.Server (rsBody)
 import Test.Tasty (TestTree)
 import Test.Tasty.HUnit (assertEqual, testCase)
-import TestHelpers (clearDatabase, runServerPart, runServerPartWithCourseInfoQuery,
-                    runServerPartWithQuery, withDatabase)
+import TestHelpers (mockGetRequest, clearDatabase, runServerPart, runServerPartWith, withDatabase)
 
 -- | List of test cases as (input course name, course data, expected JSON output)
 retrieveCourseTestCases :: [(String, T.Text, Map.Map T.Text T.Text, String)]
@@ -86,7 +85,7 @@ runRetrieveCourseTest label courseName courseData expected =
             unless (T.null currCourseName) $
                 insert_ courseToInsert
 
-        response <- runServerPartWithQuery Controllers.Course.retrieveCourse (T.unpack courseName)
+        response <- runServerPartWith Controllers.Course.retrieveCourse $ mockGetRequest "/course" [("name", T.unpack courseName)] ""
         let actual = BL.unpack $ rsBody response
         assertEqual ("Unexpected response body for " ++ label) expected actual
 
@@ -193,7 +192,7 @@ runCourseInfoTest label state dept expected =
         runDb $ do
             clearDatabase
             mapM_ insert_ state
-        response <- runServerPartWithCourseInfoQuery Controllers.Course.courseInfo (T.unpack dept)
+        response <- runServerPartWith Controllers.Course.courseInfo $ mockGetRequest "/course-info" [("dept", T.unpack dept)] ""
         let actual = BL.unpack $ rsBody response
         assertEqual ("Unexpected response body for " ++ label) expected actual
 
diff --git a/backend-test/Controllers/GenerateControllerTests.hs b/backend-test/Controllers/GenerateControllerTests.hs
@@ -22,7 +22,7 @@ import Database.Tables (Courses (..))
 import Happstack.Server (rsBody)
 import Test.Tasty (TestTree)
 import Test.Tasty.HUnit (assertEqual, testCase)
-import TestHelpers (clearDatabase, runServerPartWithGraphGenerate, withDatabase)
+import TestHelpers (mockPutRequest, clearDatabase, runServerPartWith, withDatabase)
 
 -- | Helper function to insert courses into the database
 insertCoursesWithPrerequisites :: [(T.Text, Maybe T.Text)] -> SqlPersistM ()
@@ -54,7 +54,7 @@ runfindAndSavePrereqsResponseTest course graphStructure payload expectedNodes ex
         runDb $ do
             clearDatabase
             insertCoursesWithPrerequisites graphStructure
-        response <- runServerPartWithGraphGenerate Controllers.Generate.findAndSavePrereqsResponse payload
+        response <- runServerPartWith Controllers.Generate.findAndSavePrereqsResponse $ mockPutRequest "/graph-generate" [] payload
         -- Take the response and extract the number of nodes (courses) within the generated graph, then assert that it is equal to the expected value.
         let body = rsBody response
             Just (Object object) = decode body
diff --git a/backend-test/Controllers/ProgramControllerTests.hs b/backend-test/Controllers/ProgramControllerTests.hs
@@ -21,7 +21,7 @@ import Database.Tables (Post (..))
 import Happstack.Server (rsBody)
 import Test.Tasty (TestTree)
 import Test.Tasty.HUnit (assertEqual, testCase)
-import TestHelpers (clearDatabase, runServerPart, runServerPartWithProgramQuery, withDatabase)
+import TestHelpers (mockGetRequest, clearDatabase, runServerPart, runServerPartWith, withDatabase)
 
 -- | A Post response without timestamps (for comparison purposes)
 data PostResponseNoTime = PostResponseNoTime
@@ -72,7 +72,7 @@ runRetrieveProgramTest label posts queryParam expected =
         runDb $ do
             clearDatabase
             insertPrograms posts
-        response <- runServerPartWithProgramQuery Controllers.Program.retrieveProgram (T.unpack queryParam)
+        response <- runServerPartWith Controllers.Program.retrieveProgram $ mockGetRequest "/code" [("code" ,T.unpack queryParam)] ""
         let actual = BL.unpack $ rsBody response
         let parsedActual = parsePostResponse actual
         assertEqual ("Unexpected JSON response body for" ++ label) expected parsedActual
diff --git a/backend-test/TestHelpers.hs b/backend-test/TestHelpers.hs
@@ -7,22 +7,21 @@ Module that contains helper functions used in testing controller module function
 
 module TestHelpers
     (acquireDatabase,
-    mockRequest,
+    mockGetRequest,
+    mockPutRequest,
+    runServerPartWith,
     runServerPart,
     clearDatabase,
     releaseDatabase,
-    runServerPartWithQuery,
-    runServerPartWithCourseInfoQuery,
-    runServerPartWithProgramQuery,
-    runServerPartWithGraphGenerate,
     withDatabase)
     where
 
 import Config (databasePath)
 import Control.Concurrent.MVar (newEmptyMVar, newMVar, putMVar)
-import qualified Data.ByteString.Lazy as BSL
+import Control.Monad (when)
 import qualified Data.ByteString.Lazy.Char8 as BSL8
 import qualified Data.Map as Map
+import Data.List.Split (splitOn)
 import Data.Text (unpack)
 import Database.Database (setupDatabase)
 import Database.Persist.Sqlite (Filter, SqlPersistM, deleteWhere)
@@ -34,125 +33,49 @@ import System.Directory (removeFile)
 import System.Environment (setEnv, unsetEnv)
 import Test.Tasty (TestTree, testGroup, withResource)
 
--- | A minimal mock request for running a ServerPart
-mockRequest :: IO Request
-mockRequest = do
-    inputsBody <- newMVar []
-    requestBody <- newEmptyMVar
-    return Request
-        { rqSecure          = False
-        , rqMethod          = GET
-        , rqPaths           = []
-        , rqUri             = "/"
-        , rqQuery           = ""
-        , rqInputsQuery     = []
-        , rqInputsBody      = inputsBody
-        , rqCookies         = []
-        , rqVersion         = HttpVersion 1 1
-        , rqHeaders         = Map.empty
-        , rqBody            = requestBody
-        , rqPeer            = ("127.0.0.1", 0)
-        }
+-- | Generalized function to create a mock request
+createMockRequest :: Method -> String -> [(String, String)] -> BSL8.ByteString -> IO Request
+createMockRequest reqMethod reqUri queryInputs body = do
+    reqInputsBody <- newMVar []
+    reqBody <- newEmptyMVar
 
--- | Helper function to run ServerPart Response
-runServerPart :: ServerPart Response -> IO Response
-runServerPart sp = do
-    request <- mockRequest
-    simpleHTTP'' sp request
-
--- | A mock request for running ServerPartWithQuery, specifically for retrieveCourse
-mockRequestWithQuery :: String -> IO Request
-mockRequestWithQuery courseName = do
-    inputsBody <- newMVar []
-    requestBody <- newEmptyMVar
+    -- If a payload is provided, write it into the request body
+    when (body /= "") $
+        putMVar reqBody (Body body)
     return Request
         { rqSecure          = False
-        , rqMethod          = GET
-        , rqPaths           = ["course"]
-        , rqUri             = "/course"
+        , rqMethod          = reqMethod
+        , rqPaths           = splitPath reqUri
+        , rqUri             = reqUri
         , rqQuery           = ""
-        , rqInputsQuery     = [("name", Input {
-            inputValue = Right (BSL8.pack courseName),
-            inputFilename = Nothing,
-            inputContentType = defaultContentType
-          })]
-        , rqInputsBody      = inputsBody
+        , rqInputsQuery     = map (fmap convertInput) queryInputs
+        , rqInputsBody      = reqInputsBody
         , rqCookies         = []
         , rqVersion         = HttpVersion 1 1
         , rqHeaders         = Map.empty
-        , rqBody            = requestBody
+        , rqBody            = reqBody
         , rqPeer            = ("127.0.0.1", 0)
         }
-
--- | A mock request for running ServerPartWithCourseInfoQuery, specifically for courseInfo
-mockRequestWithCourseInfoQuery :: String -> IO Request
-mockRequestWithCourseInfoQuery dept = do
-    inputsBody <- newMVar []
-    requestBody <- newEmptyMVar
-    return Request
-        { rqSecure          = False
-        , rqMethod          = GET
-        , rqPaths           = ["course-info"]
-        , rqUri             = "/course-info"
-        , rqQuery           = ""
-        , rqInputsQuery     = [("dept", Input {
-            inputValue = Right (BSL8.pack dept),
-            inputFilename = Nothing,
-            inputContentType = defaultContentType
-          })]
-        , rqInputsBody      = inputsBody
-        , rqCookies         = []
-        , rqVersion         = HttpVersion 1 1
-        , rqHeaders         = Map.empty
-        , rqBody            = requestBody
-        , rqPeer            = ("127.0.0.1", 0)
+  where
+    -- | Helper to convert a String to a query input parameter
+    convertInput :: String -> Input
+    convertInput paramValue = Input
+        { inputValue = Right (BSL8.pack paramValue)
+        , inputFilename = Nothing
+        , inputContentType = defaultContentType
         }
 
--- | A mock request for running ServerPartWithProgramQuery, specifically for retrieveProgram
-mockRequestWithProgramQuery :: String -> IO Request
-mockRequestWithProgramQuery programCode = do
-    inputsBody <- newMVar []
-    requestBody <- newEmptyMVar
-    return Request
-        { rqSecure          = False
-        , rqMethod          = GET
-        , rqPaths           = ["program"]
-        , rqUri             = "/program"
-        , rqQuery           = ""
-        , rqInputsQuery     = [("code", Input {
-            inputValue = Right (BSL8.pack programCode),
-            inputFilename = Nothing,
-            inputContentType = defaultContentType
-          })]
-        , rqInputsBody      = inputsBody
-        , rqCookies         = []
-        , rqVersion         = HttpVersion 1 1
-        , rqHeaders         = Map.empty
-        , rqBody            = requestBody
-        , rqPeer            = ("127.0.0.1", 0)
-        }
+    -- | Split a URI into path segments
+    splitPath :: String -> [String]
+    splitPath uri = splitOn "/" uri
 
--- | A mock request for the graph generate route, specifically for findAndSavePrereqsResponse
-mockRequestWithGraphGenerate :: BSL.ByteString -> IO Request
-mockRequestWithGraphGenerate payload = do
-    inputsBody <- newMVar []
-    requestBody <- newEmptyMVar
-    putMVar requestBody (Body payload)
+-- | Curried version of createMockRequest for GET requests
+mockGetRequest :: String -> [(String, String)] -> BSL8.ByteString -> IO Request
+mockGetRequest = createMockRequest GET
 
-    return Request
-        { rqSecure          = False
-        , rqMethod          = PUT
-        , rqPaths           = ["graph-generate"]
-        , rqUri             = "/graph-generate"
-        , rqQuery           = ""
-        , rqInputsQuery     = []
-        , rqInputsBody      = inputsBody
-        , rqCookies         = []
-        , rqVersion         = HttpVersion 1 1
-        , rqHeaders         = Map.empty
-        , rqBody            = requestBody
-        , rqPeer            = ("127.0.0.1", 0)
-        }
+-- | Curried version of createMockRequest for PUT requests
+mockPutRequest :: String -> [(String, String)] -> BSL8.ByteString -> IO Request
+mockPutRequest = createMockRequest PUT
 
 -- | Default content type for the MockRequestWithQuery, specifically for retrieveCourse
 defaultContentType :: ContentType
@@ -162,29 +85,13 @@ defaultContentType = ContentType
     , ctParameters = []
     }
 
--- | Helper function to run ServerPartWithQuery Response
-runServerPartWithQuery :: ServerPart Response -> String -> IO Response
-runServerPartWithQuery sp courseName = do
-    request <- mockRequestWithQuery courseName
-    simpleHTTP'' sp request
-
--- | Helper function to run ServerPartWithQuery Response for courseInfo
-runServerPartWithCourseInfoQuery :: ServerPart Response -> String -> IO Response
-runServerPartWithCourseInfoQuery sp dept = do
-    request <- mockRequestWithCourseInfoQuery dept
-    simpleHTTP'' sp request
-
--- | Helper function to run ServerPartWithQuery Response for retrieveProgram
-runServerPartWithProgramQuery :: ServerPart Response -> String -> IO Response
-runServerPartWithProgramQuery sp programCode = do
-    request <- mockRequestWithProgramQuery programCode
-    simpleHTTP'' sp request
-    
--- | Helper function to run ServerPartWithGraphGenerate for findAndSavePrereqsResponse
-runServerPartWithGraphGenerate :: ServerPart Response -> BSL.ByteString -> IO Response
-runServerPartWithGraphGenerate sp payload = do
-    request <- mockRequestWithGraphGenerate payload
-    simpleHTTP'' sp request
+-- | Run a 'ServerPart' with a custom request.
+runServerPartWith :: ServerPart Response -> IO Request -> IO Response
+runServerPartWith sp reqIO = simpleHTTP'' sp =<< reqIO
+
+-- Run a 'ServerPart' with GET request for testing wihtout query parameters.
+runServerPart :: ServerPart Response -> IO Response
+runServerPart sp = runServerPartWith sp (mockGetRequest "/" [] "")
 
 -- | Clear all the entries in the database
 clearDatabase :: SqlPersistM ()
diff --git a/courseography.cabal b/courseography.cabal
@@ -135,6 +135,7 @@ test-suite Tests
     parsec,
     persistent-sqlite,
     QuickCheck,
+    split,
     tagsoup,
     tasty >=1.5.3,
     tasty-discover,
