diff --git a/CHANGELOG.md b/CHANGELOG.md index c1753926f..5e85da9b8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,6 +30,7 @@ - Added static info existence test for `Database/Database.hs` - Converted more JS files to TypeScript - Enabled `noUnusedLocals`/`noUnusedParameters` in `tsconfig.json` and disabled ESLint's `no-unused-vars` for `.ts`/`.tsx` files +- Refactored backend database `runDb` helper in `app/Config.hs` ## [0.8.1] - 2026-08-10 diff --git a/app/Config.hs b/app/Config.hs index dec2c4b02..1319dd591 100644 --- a/app/Config.hs +++ b/app/Config.hs @@ -27,16 +27,13 @@ module Config ( holidays, ) where -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger (NoLoggingT) -import Control.Monad.Trans.Reader (ReaderT) -import Control.Monad.Trans.Resource (MonadUnliftIO, ResourceT) +import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson (FromJSON (..), Value, object, withObject, (.:), (.=)) import Data.Text (Text) import qualified Data.Text as T import Data.Time (Day) import Data.Yaml.Config (loadYamlSettings, useEnv) -import Database.Persist.Sqlite (SqlBackend, runSqlite) +import Database.Persist.Sqlite (SqlPersistM, runSqlite) import Happstack.Server (Conf (..), LogAccess, nullConf) import Network.HTTP.Types.Header (RequestHeaders) import System.Environment (lookupEnv) @@ -126,10 +123,10 @@ databasePath :: IO Text databasePath = databasePathValue <$> loadConfig -- | Fetch the database path and execute the given action in the context of the database. -runDb :: MonadUnliftIO m => ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a +runDb :: MonadIO m => SqlPersistM a -> m a runDb action = do dbPath <- liftIO databasePath - runSqlite dbPath action + liftIO $ runSqlite dbPath action -- FILE PATH STRINGS diff --git a/app/Controllers/Course.hs b/app/Controllers/Course.hs index 5dca45a4b..f8b81767e 100644 --- a/app/Controllers/Course.hs +++ b/app/Controllers/Course.hs @@ -23,7 +23,7 @@ retrieveCourse = do -- | Builds a list of all course codes in the database. index :: ServerPart Response index = do - response <- liftIO $ runDb $ do + response <- runDb $ do coursesList :: [Entity Course] <- selectList [] [] let codes = map (courseCode . entityVal) coursesList return $ T.unlines codes :: SqlPersistM T.Text diff --git a/app/Controllers/Graph.hs b/app/Controllers/Graph.hs index e59743e54..542a1c1fc 100644 --- a/app/Controllers/Graph.hs +++ b/app/Controllers/Graph.hs @@ -35,7 +35,7 @@ graphResponse = graphScripts index :: ServerPart Response -index = liftIO $ runDb $ do +index = runDb $ do graphsList :: [Entity Graph] <- selectList [GraphDynamic ==. False] [Asc GraphTitle] return $ createJSONResponse graphsList :: SqlPersistM Response @@ -74,5 +74,5 @@ saveGraphJSON = do case jsonObj of Nothing -> return $ toResponse ("Error" :: String) Just components -> do - _ <- liftIO $ runDb $ insertGraph nameStr components + _ <- runDb $ insertGraph nameStr components return $ toResponse ("Success" :: String) diff --git a/app/Controllers/Program.hs b/app/Controllers/Program.hs index 35ab0484d..7aa0881cc 100644 --- a/app/Controllers/Program.hs +++ b/app/Controllers/Program.hs @@ -22,7 +22,7 @@ import Util.Happstack (createJSONResponse) -- | Builds a list of all program codes in the database index :: ServerPart Response index = do - response <- liftIO $ runDb $ do + response <- runDb $ do programsList :: [Entity Program] <- selectList [] [] let codes = map (programCode . entityVal) programsList rmEmpty = filter (not . T.null . T.strip) codes diff --git a/app/Models/Course.hs b/app/Models/Course.hs index ded8b7645..0e0684727 100644 --- a/app/Models/Course.hs +++ b/app/Models/Course.hs @@ -10,7 +10,7 @@ module Models.Course ( ) where import Config (runDb) -import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.IO.Class (MonadIO) import Data.Aeson (ToJSON) import Data.Maybe (fromMaybe) import qualified Data.Text as T (Text, append, filter, snoc, toUpper) @@ -147,7 +147,7 @@ prereqsForCourse code = runDb $ do SqlPersistM (Either String (T.Text, T.Text)) getDeptCourses :: MonadIO m => T.Text -> m [CourseData] -getDeptCourses dept = liftIO $ runDb $ do +getDeptCourses dept = runDb $ do courses :: [Entity Course] <- rawSql "SELECT ?? FROM course WHERE code LIKE ?" [PersistText $ T.snoc dept '%'] let deptCourses = map entityVal courses meetings :: [Entity Meeting] <- selectList [MeetingCode <-. map courseCode deptCourses] []