Refactor runDb database helper

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
 

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
 

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

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)

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

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] []