c1af5ae6-6501-463e-8e2b-3f62f7a4d663

Committed 07 Nov 2025 07:09PM UTC coverage: 55.158% (+0.04%) from 55.118%

Build # c1af5ae6-6501-463e-8e2b-3f62f7a4d663

Build Type

Pull #1607

circleci

Committed by

akarki2005

Commit Message

Merge branch 'master' of https://github.com/Courseography/courseography into rename-post-table-to-program

Pull Request Pull Request #1607: Rename post table to program

Run Details

487 of 958 branches covered (50.84%)

Branch coverage included in aggregate %.

16 of 32 new or added lines in 6 files covered. (50.0%)

16 existing lines in 1 file now uncovered.

2224 of 3957 relevant lines covered (56.2%)

159.45 hits per line

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

48.65

/app/Controllers/Generate.hs

module Controllers.Generate
    (generateResponse, findAndSavePrereqsResponse) where

import Control.Monad ()
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (decode, object, (.=))
import Data.List (nub)
import Data.Maybe (fromJust, isNothing, mapMaybe)
import qualified Data.Text.Lazy as TL
import DynamicGraphs.GraphOptions (CourseGraphOptions (..), GraphOptions (..))
import DynamicGraphs.WriteRunDot (generateAndSavePrereqResponse, getBody)
import Happstack.Server
import MasterTemplate
import Models.Program (reqsForProgram, returnProgram)
import Scripts
import Text.Blaze ((!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Util.Happstack (createJSONResponse)

generateResponse :: ServerPart Response
generateResponse =
    ok $ toResponse $
        masterTemplate "Courseography - Generate"
                    []
                    (do
                        H.div ! A.id "navbar" $ ""
                        generatePrerequisites
                    )
                    generateScripts

generatePrerequisites :: H.Html
generatePrerequisites =
    H.html $ do
        H.head $
            H.title "Generate Prerequisites!"
        H.div ! A.id "generateRoot" $ ""

findAndSavePrereqsResponse :: ServerPart Response
findAndSavePrereqsResponse = do
    method PUT
    requestBody <- getBody
    let coursesOptions :: CourseGraphOptions = fromJust $ decode requestBody

    programResults <- liftIO $ mapM (\code -> do
                        program <- returnProgram (TL.toStrict code)
                        return (TL.toStrict code, program))
                   (programs coursesOptions)

    let invalidPrograms = map fst $ filter (isNothing . snd) programResults
        validPrograms = mapMaybe snd programResults

    allCourses <- liftIO $ nub <$>
        if all (== TL.empty) (courses coursesOptions)
            then return $ map TL.pack (concatMap reqsForProgram validPrograms)
            else return $ courses coursesOptions

    let updatedCoursesOptions = coursesOptions
            { courses = map TL.toUpper allCourses
            , graphOptions = (graphOptions coursesOptions)
                { taken = map TL.toUpper (taken (graphOptions coursesOptions))
                , departments = map TL.toUpper (departments (graphOptions coursesOptions))
                }
            }

    if all (== TL.empty) (courses coursesOptions) && not (null invalidPrograms)
        then return $ createJSONResponse $ object ["error" .= object ["invalidPrograms" .= invalidPrograms]]
        else liftIO $ generateAndSavePrereqResponse updatedCoursesOptions

1	module Controllers.Generate
2	(generateResponse, findAndSavePrereqsResponse) where
3
4	import Control.Monad ()
5	import Control.Monad.IO.Class (liftIO)
6	import Data.Aeson (decode, object, (.=))
7	import Data.List (nub)
8	import Data.Maybe (fromJust, isNothing, mapMaybe)
9	import qualified Data.Text.Lazy as TL
10	import DynamicGraphs.GraphOptions (CourseGraphOptions (..), GraphOptions (..))
11	import DynamicGraphs.WriteRunDot (generateAndSavePrereqResponse, getBody)
12	import Happstack.Server
13	import MasterTemplate
14	import Models.Program (reqsForProgram, returnProgram)
15	import Scripts
16	import Text.Blaze ((!))
17	import qualified Text.Blaze.Html5 as H
18	import qualified Text.Blaze.Html5.Attributes as A
19	import Util.Happstack (createJSONResponse)
20
21	generateResponse :: ServerPart Response
22	generateResponse =
23	ok $ toResponse $	×
24	masterTemplate "Courseography - Generate"	×
25	[]	×
26	(do	×
27	H.div ! A.id "navbar" $ ""	×
28	generatePrerequisites	×
29	)
30	generateScripts	×
31
32	generatePrerequisites :: H.Html
33	generatePrerequisites =
34	H.html $ do	×
35	H.head $	×
36	H.title "Generate Prerequisites!"	×
37	H.div ! A.id "generateRoot" $ ""	×
38
39	findAndSavePrereqsResponse :: ServerPart Response
40	findAndSavePrereqsResponse = do	1✔
41	method PUT	1✔
42	requestBody <- getBody	1✔
43	let coursesOptions :: CourseGraphOptions = fromJust $ decode requestBody	2✔
44
45	programResults <- liftIO $ mapM (\code -> do	2✔
NEW 46	program <- returnProgram (TL.toStrict code)	×
NEW 47	return (TL.toStrict code, program))	×
48	(programs coursesOptions)	2✔
49
NEW 50	let invalidPrograms = map fst $ filter (isNothing . snd) programResults	×
NEW 51	validPrograms = mapMaybe snd programResults	×
52
53	allCourses <- liftIO $ nub <$>	2✔
54	if all (== TL.empty) (courses coursesOptions)	2!
55	then return $ map TL.pack (concatMap reqsForProgram validPrograms)	×
56	else return $ courses coursesOptions	2✔
57
58	let updatedCoursesOptions = coursesOptions	2✔
59	{ courses = map TL.toUpper allCourses	2✔
60	, graphOptions = (graphOptions coursesOptions)	2✔
61	{ taken = map TL.toUpper (taken (graphOptions coursesOptions))	2✔
62	, departments = map TL.toUpper (departments (graphOptions coursesOptions))	2✔
63	}
64	}
65
66	if all (== TL.empty) (courses coursesOptions) && not (null invalidPrograms)	2!
67	then return $ createJSONResponse $ object ["error" .= object ["invalidPrograms" .= invalidPrograms]]	×
68	else liftIO $ generateAndSavePrereqResponse updatedCoursesOptions	2✔

Courseography / courseography / c1af5ae6-6501-463e-8e2b-3f62f7a4d663

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