6ca2fc21-e28e-4b1f-931e-25ce91baa664

Committed 16 Sep 2025 02:22AM UTC coverage: 54.687%. Remained the same

Build # 6ca2fc21-e28e-4b1f-931e-25ce91baa664

Build Type

push

circleci

Committed by

web-flow

Commit Message

Refactored Database files to MVC architecture (#1604)

* created Program file in models folder
* created Meeting file in models folder
* removed CourseQueries.hs and CourseInsertion.hs
* renamed post -> program across the codebase, excluding database tables and route names

Run Details

485 of 952 branches covered (50.95%)

Branch coverage included in aggregate %.

31 of 87 new or added lines in 6 files covered. (35.63%)

2 existing lines in 1 file now uncovered.

2187 of 3934 relevant lines covered (55.59%)

160.4 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

62.12

/app/Models/Course.hs

module Models.Course
    (buildCourse,
    returnCourse,
    prereqsForCourse,
    getDeptCourses,
    insertCourse) where

import Config (runDb)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T (Text, append, filter, snoc, toUpper)
import Database.Persist.Class (selectKeysList)
import Database.Persist.Sqlite (Entity, PersistValue (PersistText), SqlPersistM, entityVal, get,
                                insert_, rawSql, selectFirst, selectList, (<-.), (==.))
import Database.Tables hiding (breadth, distribution)
import Models.Meeting (buildMeetTimes, meetingQuery)

-- | Queries the database for all information about @course@,
-- constructs and returns a Course value.
returnCourse :: T.Text -> IO (Maybe Course)
returnCourse lowerStr = runDb $ do
    let courseStr = T.toUpper lowerStr
    -- TODO: require the client to pass the full course code
    let fullCodes = [courseStr, T.append courseStr "H1", T.append courseStr "Y1"]
    sqlCourse :: (Maybe (Entity Courses)) <- selectFirst [CoursesCode <-. fullCodes] []
    case sqlCourse of
      Nothing -> return Nothing
      Just course -> do
        meetings <- meetingQuery fullCodes
        Just <$> buildCourse meetings
                                (entityVal course)

-- | Queries the database for the breadth description
getDescriptionB :: Maybe (Key Breadth) -> SqlPersistM (Maybe T.Text)
getDescriptionB Nothing = return Nothing
getDescriptionB (Just key) = do
    maybeBreadth <- get key
    return $ fmap breadthDescription maybeBreadth

-- | Queries the database for the distribution description
getDescriptionD :: Maybe (Key Distribution) -> SqlPersistM (Maybe T.Text)
getDescriptionD Nothing = return Nothing
getDescriptionD (Just key) = do
    maybeDistribution <- get key
    return $ fmap distributionDescription maybeDistribution

-- | Builds a Course structure from a tuple from the Courses table.
-- Some fields still need to be added in.
buildCourse :: [MeetTime'] -> Courses -> SqlPersistM Course
buildCourse allMeetings course = do
    cBreadth <- getDescriptionB (coursesBreadth course)
    cDistribution <- getDescriptionD (coursesDistribution course)
    return $ Course cBreadth
           -- TODO: Remove the filter and allow double-quotes
           (fmap (T.filter (/='\"')) (coursesDescription course))
           (fmap (T.filter (/='\"')) (coursesTitle course))
           (coursesPrereqString course)
           (Just allMeetings)
           (coursesCode course)
           (coursesExclusions course)
           cDistribution
           (coursesCoreqs course)
           (coursesVideoUrls course)

-- | Retrieves the prerequisites for a course (code) as a string.
-- Also retrieves the actual course code in the database in case
-- the one the user inputs doesn't match it exactly
prereqsForCourse :: T.Text -> IO (Either String (T.Text, T.Text))
prereqsForCourse courseCode = runDb $ do
    let upperCaseCourseCode = T.toUpper courseCode
    course <- selectFirst [CoursesCode <-. [upperCaseCourseCode, upperCaseCourseCode `T.append` "H1", upperCaseCourseCode `T.append` "Y1"]] []
    case course of
        Nothing -> return (Left "Course not found")
        Just courseEntity ->
            return (Right
                     (coursesCode $ entityVal courseEntity,
                      fromMaybe "" $ coursesPrereqString $ entityVal courseEntity)
                    ) :: SqlPersistM (Either String (T.Text, T.Text))

getDeptCourses :: MonadIO m => T.Text -> m [Course]
getDeptCourses dept = liftIO $ runDb $ do
        courses :: [Entity Courses] <- rawSql "SELECT ?? FROM courses WHERE code LIKE ?" [PersistText $ T.snoc dept '%']
        let deptCourses = map entityVal courses
        meetings :: [Entity Meeting] <- selectList [MeetingCode <-. map coursesCode deptCourses] []
        mapM (processCourse meetings) deptCourses
    where
        processCourse allMeetings course = do
            let courseMeetings = filter (\m -> meetingCode (entityVal m) == coursesCode course) allMeetings
            allTimes <- mapM buildMeetTimes courseMeetings
            buildCourse allTimes course

--contains' :: PersistEntity m => T.Text -> SqlPersistM m
--contains field query = Filter field (Left $ T.concat ["%", query, "%"]) (BackendSpecificFilter "LIKE")

-- Get Key of correspondig record in Distribution column
getDistributionKey :: T.Text -> SqlPersistM (Maybe (Key Distribution))
getDistributionKey description_ = do
    keyListDistribution :: [Key Distribution] <- selectKeysList [ DistributionDescription ==. description_ ] []
    -- option: keyListDistribution :: [DistributionId] <- selectKeysList [ DistributionDescription `contains'` description] []
    return $ case keyListDistribution of
        [] -> Nothing
        (x:_) -> Just x

getBreadthKey :: T.Text -> SqlPersistM (Maybe (Key Breadth))
getBreadthKey description_ = do
    keyListBreadth :: [Key Breadth] <- selectKeysList [ BreadthDescription ==. description_ ] []
    -- option: selectKeysList [ BreadthDescription `contains'` description] []
    return $ case keyListBreadth of
        [] -> Nothing
        (x:_) -> Just x

-- | Inserts course into the Courses table.
insertCourse :: (Courses, T.Text, T.Text) -> SqlPersistM ()
insertCourse (course, breadth, distribution) = do
    maybeCourse <- selectFirst [CoursesCode ==. coursesCode course] []
    breadthKey <- getBreadthKey breadth
    distributionKey <- getDistributionKey distribution
    case maybeCourse of
        Nothing -> insert_ $ course {coursesBreadth = breadthKey,
                                     coursesDistribution = distributionKey}
        Just _ -> return ()

1	module Models.Course
2	(buildCourse,
3	returnCourse,
4	prereqsForCourse,
5	getDeptCourses,
6	insertCourse) where
7
8	import Config (runDb)
9	import Control.Monad.IO.Class (MonadIO, liftIO)
10	import Data.Maybe (fromMaybe)
11	import qualified Data.Text as T (Text, append, filter, snoc, toUpper)
12	import Database.Persist.Class (selectKeysList)
13	import Database.Persist.Sqlite (Entity, PersistValue (PersistText), SqlPersistM, entityVal, get,
14	insert_, rawSql, selectFirst, selectList, (<-.), (==.))
15	import Database.Tables hiding (breadth, distribution)
16	import Models.Meeting (buildMeetTimes, meetingQuery)
17
18	-- \| Queries the database for all information about @course@,
19	-- constructs and returns a Course value.
20	returnCourse :: T.Text -> IO (Maybe Course)
21	returnCourse lowerStr = runDb $ do	3✔
22	let courseStr = T.toUpper lowerStr	3✔
23	-- TODO: require the client to pass the full course code
24	let fullCodes = [courseStr, T.append courseStr "H1", T.append courseStr "Y1"]	3✔
25	sqlCourse :: (Maybe (Entity Courses)) <- selectFirst [CoursesCode <-. fullCodes] []	3✔
26	case sqlCourse of	3✔
27	Nothing -> return Nothing	2✔
28	Just course -> do	1✔
29	meetings <- meetingQuery fullCodes	1✔
30	Just <$> buildCourse meetings	1✔
31	(entityVal course)	1✔
32
33	-- \| Queries the database for the breadth description
34	getDescriptionB :: Maybe (Key Breadth) -> SqlPersistM (Maybe T.Text)
35	getDescriptionB Nothing = return Nothing	7✔
UNCOV 36	getDescriptionB (Just key) = do	×
37	maybeBreadth <- get key	×
38	return $ fmap breadthDescription maybeBreadth	×
39
40	-- \| Queries the database for the distribution description
41	getDescriptionD :: Maybe (Key Distribution) -> SqlPersistM (Maybe T.Text)
42	getDescriptionD Nothing = return Nothing	7✔
UNCOV 43	getDescriptionD (Just key) = do	×
44	maybeDistribution <- get key	×
45	return $ fmap distributionDescription maybeDistribution	×
46
47	-- \| Builds a Course structure from a tuple from the Courses table.
48	-- Some fields still need to be added in.
49	buildCourse :: [MeetTime'] -> Courses -> SqlPersistM Course
50	buildCourse allMeetings course = do	7✔
51	cBreadth <- getDescriptionB (coursesBreadth course)	7✔
52	cDistribution <- getDescriptionD (coursesDistribution course)	7✔
53	return $ Course cBreadth	7✔
54	-- TODO: Remove the filter and allow double-quotes
55	(fmap (T.filter (/='\"')) (coursesDescription course))	7✔
56	(fmap (T.filter (/='\"')) (coursesTitle course))	7✔
57	(coursesPrereqString course)	7✔
58	(Just allMeetings)	7✔
59	(coursesCode course)	7✔
60	(coursesExclusions course)	7✔
61	cDistribution	1✔
62	(coursesCoreqs course)	7✔
63	(coursesVideoUrls course)	7✔
64
65	-- \| Retrieves the prerequisites for a course (code) as a string.
66	-- Also retrieves the actual course code in the database in case
67	-- the one the user inputs doesn't match it exactly
68	prereqsForCourse :: T.Text -> IO (Either String (T.Text, T.Text))
69	prereqsForCourse courseCode = runDb $ do	3✔
70	let upperCaseCourseCode = T.toUpper courseCode	3✔
71	course <- selectFirst [CoursesCode <-. [upperCaseCourseCode, upperCaseCourseCode `T.append` "H1", upperCaseCourseCode `T.append` "Y1"]] []	3✔
72	case course of	3✔
NEW 73	Nothing -> return (Left "Course not found")	×
74	Just courseEntity ->
75	return (Right	3✔
76	(coursesCode $ entityVal courseEntity,	3✔
77	fromMaybe "" $ coursesPrereqString $ entityVal courseEntity)	3✔
78	) :: SqlPersistM (Either String (T.Text, T.Text))
79
80	getDeptCourses :: MonadIO m => T.Text -> m [Course]
81	getDeptCourses dept = liftIO $ runDb $ do	5✔
82	courses :: [Entity Courses] <- rawSql "SELECT ?? FROM courses WHERE code LIKE ?" [PersistText $ T.snoc dept '%']	5✔
83	let deptCourses = map entityVal courses	5✔
84	meetings :: [Entity Meeting] <- selectList [MeetingCode <-. map coursesCode deptCourses] []	5✔
85	mapM (processCourse meetings) deptCourses	5✔
86	where
87	processCourse allMeetings course = do	6✔
88	let courseMeetings = filter (\m -> meetingCode (entityVal m) == coursesCode course) allMeetings	6✔
89	allTimes <- mapM buildMeetTimes courseMeetings	6✔
90	buildCourse allTimes course	6✔
91
92	--contains' :: PersistEntity m => T.Text -> SqlPersistM m
93	--contains field query = Filter field (Left $ T.concat ["%", query, "%"]) (BackendSpecificFilter "LIKE")
94
95	-- Get Key of correspondig record in Distribution column
96	getDistributionKey :: T.Text -> SqlPersistM (Maybe (Key Distribution))
NEW 97	getDistributionKey description_ = do	×
NEW 98	keyListDistribution :: [Key Distribution] <- selectKeysList [ DistributionDescription ==. description_ ] []	×
99	-- option: keyListDistribution :: [DistributionId] <- selectKeysList [ DistributionDescription `contains'` description] []
NEW 100	return $ case keyListDistribution of	×
NEW 101	[] -> Nothing	×
NEW 102	(x:_) -> Just x	×
103
104	getBreadthKey :: T.Text -> SqlPersistM (Maybe (Key Breadth))
NEW 105	getBreadthKey description_ = do	×
NEW 106	keyListBreadth :: [Key Breadth] <- selectKeysList [ BreadthDescription ==. description_ ] []	×
107	-- option: selectKeysList [ BreadthDescription `contains'` description] []
NEW 108	return $ case keyListBreadth of	×
NEW 109	[] -> Nothing	×
NEW 110	(x:_) -> Just x	×
111
112	-- \| Inserts course into the Courses table.
113	insertCourse :: (Courses, T.Text, T.Text) -> SqlPersistM ()
NEW 114	insertCourse (course, breadth, distribution) = do	×
NEW 115	maybeCourse <- selectFirst [CoursesCode ==. coursesCode course] []	×
NEW 116	breadthKey <- getBreadthKey breadth	×
NEW 117	distributionKey <- getDistributionKey distribution	×
NEW 118	case maybeCourse of	×
NEW 119	Nothing -> insert_ $ course {coursesBreadth = breadthKey,	×
NEW 120	coursesDistribution = distributionKey}	×
NEW 121	Just _ -> return ()	×

Courseography / courseography / 6ca2fc21-e28e-4b1f-931e-25ce91baa664

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous