5c00948b-e964-4355-a92e-635ceece6223

Committed 18 Jul 2026 02:16AM UTC coverage: 58.657% (-0.6%) from 59.228%

Build # 5c00948b-e964-4355-a92e-635ceece6223

Build Type

push

circleci

Committed by

web-flow

Commit Message

Switched Haskell formatter to fourmolu and ran on all files (#1763)

Coverage Stats

517 of 966 branches covered (53.52%)

Branch coverage included in aggregate %.

851 of 1590 new or added lines in 34 files covered. (53.52%)

84 existing lines in 13 files now uncovered.

2522 of 4215 relevant lines covered (59.83%)

154.42 hits per line

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

47.62

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

Courseography / courseography / 5c00948b-e964-4355-a92e-635ceece6223

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