diff --git a/CHANGELOG.md b/CHANGELOG.md index 2f3cdd88d..f734a2748 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -34,6 +34,7 @@ - Refactor graph helper functions from `app/Svg/Database.hs` to `app/Models/Graph.hs` - Refactor functions for performing matrix operations from `app/Svg/Parser.hs` to `app/Util/Matrix.hs` - Updated documentation in `app/Util/Blaze.hs` +- Moved the `Course` data type from `Database/Tables.hs` into `Models/Course.hs`, renamed it to `CourseData` - Removed `SvgJSON` data type in favour of `([Text], [Shape], [Path])` ## [0.7.2] - 2025-12-10 diff --git a/app/Database/Tables.hs b/app/Database/Tables.hs index 6249761fc..75431190d 100644 --- a/app/Database/Tables.hs +++ b/app/Database/Tables.hs @@ -183,21 +183,6 @@ data MeetTime = MeetTime {meetInfo :: Meeting, timeInfo :: [Time'] } data MeetTime' = MeetTime' { meetData :: Meeting, timeData :: [Time] } deriving (Show, Generic) --- | A Course. TODO: remove this data type (it's redundant). -data Course = - Course { breadth :: Maybe T.Text, - description :: Maybe T.Text, - title :: Maybe T.Text, - prereqString :: Maybe T.Text, - allMeetingTimes :: Maybe [MeetTime'], - name :: !T.Text, - exclusions :: Maybe T.Text, - distribution :: Maybe T.Text, - coreqs :: Maybe T.Text, - videoUrls :: [T.Text] - } deriving (Show, Generic) - -instance ToJSON Course instance ToJSON Program instance ToJSON Time instance ToJSON MeetTime' diff --git a/app/Models/Course.hs b/app/Models/Course.hs index 05946ae5b..23937d2d6 100644 --- a/app/Models/Course.hs +++ b/app/Models/Course.hs @@ -1,5 +1,8 @@ +{-# LANGUAGE DeriveGeneric #-} + module Models.Course - (buildCourse, + (CourseData (..), + buildCourse, returnCourse, prereqsForCourse, getDeptCourses, @@ -7,17 +10,43 @@ module Models.Course import Config (runDb) import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Aeson (ToJSON) 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 Database.Tables (Breadth (breadthDescription), + Courses (coursesBreadth, coursesCode, coursesCoreqs, coursesDescription, coursesDistribution, coursesExclusions, coursesPrereqString, coursesTitle, coursesVideoUrls), + Distribution (distributionDescription), + EntityField (BreadthDescription, CoursesCode, DistributionDescription, MeetingCode), + Key, MeetTime', Meeting (meetingCode)) +import GHC.Generics (Generic) import Models.Meeting (buildMeetTimes, meetingQuery) +-- | The data for a single course, as returned by the back-end to the front-end. +-- This is different from the schema-defined 'Courses' type (in "Database.Tables") +-- 'Courses' describes how a course is stored in the database, whereas +-- 'CourseData' describes the shape of the information sent to the client +-- when a course is requested. +data CourseData = + CourseData { breadth :: Maybe T.Text, + description :: Maybe T.Text, + title :: Maybe T.Text, + prereqString :: Maybe T.Text, + allMeetingTimes :: Maybe [MeetTime'], + name :: !T.Text, + exclusions :: Maybe T.Text, + distribution :: Maybe T.Text, + coreqs :: Maybe T.Text, + videoUrls :: [T.Text] + } deriving (Show, Generic) + +instance ToJSON CourseData + -- | Queries the database for all information about @course@, --- constructs and returns a Course value. -returnCourse :: T.Text -> IO (Maybe Course) +-- constructs and returns a CourseData value. +returnCourse :: T.Text -> IO (Maybe CourseData) returnCourse lowerStr = runDb $ do let courseStr = T.toUpper lowerStr -- TODO: require the client to pass the full course code @@ -44,13 +73,13 @@ getDescriptionD (Just key) = do maybeDistribution <- get key return $ fmap distributionDescription maybeDistribution --- | Builds a Course structure from a tuple from the Courses table. +-- | Builds a CourseData structure from a tuple from the Courses table. -- Some fields still need to be added in. -buildCourse :: [MeetTime'] -> Courses -> SqlPersistM Course +buildCourse :: [MeetTime'] -> Courses -> SqlPersistM CourseData buildCourse allMeetings course = do cBreadth <- getDescriptionB (coursesBreadth course) cDistribution <- getDescriptionD (coursesDistribution course) - return $ Course cBreadth + return $ CourseData cBreadth -- TODO: Remove the filter and allow double-quotes (fmap (T.filter (/='\"')) (coursesDescription course)) (fmap (T.filter (/='\"')) (coursesTitle course)) @@ -77,7 +106,7 @@ prereqsForCourse courseCode = runDb $ do fromMaybe "" $ coursesPrereqString $ entityVal courseEntity) ) :: SqlPersistM (Either String (T.Text, T.Text)) -getDeptCourses :: MonadIO m => T.Text -> m [Course] +getDeptCourses :: MonadIO m => T.Text -> m [CourseData] getDeptCourses dept = liftIO $ runDb $ do courses :: [Entity Courses] <- rawSql "SELECT ?? FROM courses WHERE code LIKE ?" [PersistText $ T.snoc dept '%'] let deptCourses = map entityVal courses @@ -111,10 +140,10 @@ getBreadthKey description_ = do -- | Inserts course into the Courses table. insertCourse :: (Courses, T.Text, T.Text) -> SqlPersistM () -insertCourse (course, breadth, distribution) = do +insertCourse (course, breadthDesc, distributionDesc) = do maybeCourse <- selectFirst [CoursesCode ==. coursesCode course] [] - breadthKey <- getBreadthKey breadth - distributionKey <- getDistributionKey distribution + breadthKey <- getBreadthKey breadthDesc + distributionKey <- getDistributionKey distributionDesc case maybeCourse of Nothing -> insert_ $ course {coursesBreadth = breadthKey, coursesDistribution = distributionKey}