adca2d5c-ee08-468b-98c5-4ae33caa619c

Committed 20 Oct 2025 01:25AM UTC coverage: 55.118% (+0.06%) from 55.063%

Build # adca2d5c-ee08-468b-98c5-4ae33caa619c

Build Type

push

circleci

Committed by

web-flow

Commit Message

Initialized SchemaVersion table (#1616)

Run Details

486 of 956 branches covered (50.84%)

Branch coverage included in aggregate %.

9 of 10 new or added lines in 1 file covered. (90.0%)

2217 of 3948 relevant lines covered (56.16%)

159.78 hits per line

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

38.46

/app/Database/Database.hs

{-|
    Module      : Database.Database
    Description : Main module for database course seeding.

The main module for parsing course information from the web and
inserting it into the database. Run when @cabal run database@ is executed.
-}

module Database.Database
    (populateCalendar, setupDatabase) where

import Config (databasePath, runDb)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Maybe (fromMaybe)
import Data.Text as T (findIndex, length, reverse, take, unpack)
import Database.CourseVideoSeed (seedVideos)
import Database.Persist.Sqlite (SqlPersistT, entityVal, insert_, runMigration, runMigrationQuiet,
                                selectFirst)
import Database.Tables
import System.Directory (createDirectoryIfMissing)
import WebParsing.ArtSciParser (parseCalendar)


distTableSetUpStr :: String
distTableSetUpStr = "Distribution table set up"
breathTableSetUpStr :: String
breathTableSetUpStr = "breadth table set up"


-- | Creates the database if it doesn't exist and runs migrations.
setupDatabase :: Bool -> IO ()
setupDatabase quiet = do
    -- Create db folder if it doesn't exist
    dbPath <- liftIO databasePath
    let ind = (T.length dbPath -) . fromMaybe 0 . T.findIndex (=='/') . T.reverse $ dbPath
        db = T.unpack $ T.take ind dbPath
    createDirectoryIfMissing True db

    -- Match SQL database with ORM, then initialize schema version table
    let migrateFunction = if quiet then void . runMigrationQuiet else runMigration
    runDb $ void $ migrateFunction migrateAll >> getDatabaseVersion

-- | Gets the current version of the database.
-- If no version is defined, initialize the
-- version to 1 and return that.
getDatabaseVersion :: MonadIO m => SqlPersistT m Int
getDatabaseVersion = do
    result <- selectFirst [] []
    case result of
        Just entity -> pure $ schemaVersionVersion $ entityVal entity
        Nothing -> do
            let initialVersion = 1
            insert_ $ SchemaVersion initialVersion
            pure initialVersion

-- | Sets up the course information from Artsci Calendar
populateCalendar :: IO ()
populateCalendar = do
    populateStaticInfo
    parseCalendar

-- | Sets up the tables and seeds the videos for the database.
populateStaticInfo :: IO ()
populateStaticInfo = do
    setupDistributionTable
    print distTableSetUpStr
    setupBreadthTable
    print breathTableSetUpStr
    seedVideos

-- | Sets up the Distribution table.
setupDistributionTable :: IO ()
setupDistributionTable = runDb $ do
    insert_ $ Distribution "Humanities"
    insert_ $ Distribution "Social Science"
    insert_ $ Distribution "Science"

-- | Sets up the Breadth table.
setupBreadthTable :: IO ()
setupBreadthTable = runDb $ do
    insert_ $ Breadth "Creative and Cultural Representations (1)"
    insert_ $ Breadth "Thought, Belief, and Behaviour (2)"
    insert_ $ Breadth "Society and its Institutions (3)"
    insert_ $ Breadth "Living Things and Their Environment (4)"
    insert_ $ Breadth "The Physical and Mathematical Universes (5)"
    insert_ $ Breadth "No Breadth"

1	{-\|
2	Module : Database.Database
3	Description : Main module for database course seeding.
4
5	The main module for parsing course information from the web and
6	inserting it into the database. Run when @cabal run database@ is executed.
7	-}
8
9	module Database.Database
10	(populateCalendar, setupDatabase) where
11
12	import Config (databasePath, runDb)
13	import Control.Monad (void)
14	import Control.Monad.IO.Class (MonadIO, liftIO)
15	import Data.Maybe (fromMaybe)
16	import Data.Text as T (findIndex, length, reverse, take, unpack)
17	import Database.CourseVideoSeed (seedVideos)
18	import Database.Persist.Sqlite (SqlPersistT, entityVal, insert_, runMigration, runMigrationQuiet,
19	selectFirst)
20	import Database.Tables
21	import System.Directory (createDirectoryIfMissing)
22	import WebParsing.ArtSciParser (parseCalendar)
23
24
25	distTableSetUpStr :: String
26	distTableSetUpStr = "Distribution table set up"	×
27	breathTableSetUpStr :: String
28	breathTableSetUpStr = "breadth table set up"	×
29
30
31	-- \| Creates the database if it doesn't exist and runs migrations.
32	setupDatabase :: Bool -> IO ()
33	setupDatabase quiet = do	1✔
34	-- Create db folder if it doesn't exist
35	dbPath <- liftIO databasePath	5✔
36	let ind = (T.length dbPath -) . fromMaybe 0 . T.findIndex (=='/') . T.reverse $ dbPath	5✔
37	db = T.unpack $ T.take ind dbPath	5✔
38	createDirectoryIfMissing True db	5✔
39
40	-- Match SQL database with ORM, then initialize schema version table
41	let migrateFunction = if quiet then void . runMigrationQuiet else runMigration	5!
42	runDb $ void $ migrateFunction migrateAll >> getDatabaseVersion	5✔
43
44	-- \| Gets the current version of the database.
45	-- If no version is defined, initialize the
46	-- version to 1 and return that.
47	getDatabaseVersion :: MonadIO m => SqlPersistT m Int
48	getDatabaseVersion = do	1✔
49	result <- selectFirst [] []	1✔
50	case result of	5✔
NEW 51	Just entity -> pure $ schemaVersionVersion $ entityVal entity	×
52	Nothing -> do	1✔
53	let initialVersion = 1	1✔
54	insert_ $ SchemaVersion initialVersion	5✔
55	pure initialVersion	5✔
56
57	-- \| Sets up the course information from Artsci Calendar
58	populateCalendar :: IO ()
59	populateCalendar = do	×
60	populateStaticInfo	×
61	parseCalendar	×
62
63	-- \| Sets up the tables and seeds the videos for the database.
64	populateStaticInfo :: IO ()
65	populateStaticInfo = do	×
66	setupDistributionTable	×
67	print distTableSetUpStr	×
68	setupBreadthTable	×
69	print breathTableSetUpStr	×
70	seedVideos	×
71
72	-- \| Sets up the Distribution table.
73	setupDistributionTable :: IO ()
74	setupDistributionTable = runDb $ do	×
75	insert_ $ Distribution "Humanities"	×
76	insert_ $ Distribution "Social Science"	×
77	insert_ $ Distribution "Science"	×
78
79	-- \| Sets up the Breadth table.
80	setupBreadthTable :: IO ()
81	setupBreadthTable = runDb $ do	×
82	insert_ $ Breadth "Creative and Cultural Representations (1)"	×
83	insert_ $ Breadth "Thought, Belief, and Behaviour (2)"	×
84	insert_ $ Breadth "Society and its Institutions (3)"	×
85	insert_ $ Breadth "Living Things and Their Environment (4)"	×
86	insert_ $ Breadth "The Physical and Mathematical Universes (5)"	×
87	insert_ $ Breadth "No Breadth"	×

Courseography / courseography / adca2d5c-ee08-468b-98c5-4ae33caa619c

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