CS-565/Homework-4
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add redesign for Homework 4c.

Browse Source
This commit is contained in:
Danila Fedorin 2021-05-30 20:40:10 -07:00
parent 7b7b543416
commit 125d6391ba
7 changed files with 245 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
elm.json
View File

@ -9,10 +9,13 @@
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0",
"elm/http": "2.0.0",
"elm/json": "1.1.3",
"feathericons/elm-feather": "1.5.0"
},
"indirect": {
"elm/json": "1.1.3",
"elm/bytes": "1.0.8",
"elm/file": "1.0.5",
"elm/svg": "1.0.1",
"elm/time": "1.0.0",
"elm/url": "1.0.0",

1
index.html
View File

@ -4,6 +4,7 @@
<link rel="preconnect" href="https://fonts.gstatic.com">
<link href="https://fonts.googleapis.com/css2?family=Lora&family=Roboto+Mono&display=swap" rel="stylesheet">
<link rel="stylesheet" media="screen" href="css/style.css">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
</head>
<body>
<div id="#elm">

116
scss/style.scss
View File

@ -22,7 +22,7 @@ body {
.split-elem {
flex-grow: 1;
flex-shrink: 0;
flex-shrink: 1;
flex-basis: 40%;
margin: 0.25rem;
}
@ -36,15 +36,20 @@ body {
margin-top: 1rem;
box-shadow: 0px 0px 5px rgba(grey, 0.1);
box-sizing: border-box;
width: 100%;
}
.class-table {
border-collapse: collapse;
table-layout: fixed;
th, td {
padding: 0.5rem;
padding-left: 1rem;
padding-right: 1rem;
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;
}
th {
@ -54,17 +59,9 @@ body {
tr {
transition: background-color 0.2s;
&:nth-child(2n+3) {
background-color: $off-color;
}
&.hoverable:hover {
background-color: lighten(yellow, 30%);
}
&.selected {
border: 1px dashed black;
}
}
}
@ -87,24 +84,17 @@ body {
vertical-align: middle;
}
.color-green {
background-color: lighten(#5bc275, 30%);
border-color: #5bc275;
color: darken(#5bc275, 30%);
}
.color-red {
background-color: lighten(#c25b75, 30%);
border-color: #c25b75;
color: darken(#c25b75, 30%);
}
.week-grid {
display: grid;
width: 100%;
height: 70vh;
grid-template-columns: auto repeat(5, 1fr);
grid-template-rows: auto repeat(10, 1fr);
grid-template-rows: auto repeat(12, 1fr);
.selected {
border-style: dashed;
border-width: 2px;
}
}
.course-block {
@ -114,11 +104,6 @@ body {
padding: 0.25rem;
box-sizing: border-box;
&.selected {
border-style: dashed;
border-width: 2px;
}
p {
margin-top: 0.1rem;
margin-bottom: 0.1rem;
@ -146,3 +131,80 @@ body {
.time-column {
padding-right: 1rem;
}
.bubble {
padding: 0.2rem;
padding-right: 0.5rem;
padding-left: 0.5rem;
border: 0.1rem solid;
border-radius: 0.5rem;
margin-right: 0.5rem;
background-color: lighten(#86b2ff, 10%);
border-color: #86b2ff;
white-space: nowrap;
}
.course {
padding: 1rem;
display: flex;
&.selected {
border-style: dashed;
border-width: 2px;
}
&:nth-child(2n) {
background-color: $off-color;
}
&.selected {
border: 1px dashed black;
}
p {
margin: 0;
}
}
.course-content {
flex-grow: 1;
}
.course-add-remove {
display: flex;
flex-direction: column;
justify-content: center;
}
.course-title {
font-weight: bold;
font-size: 1.1rem;
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;
max-width: 40vw;
}
p.course-info {
margin-top: 0.5rem;
display: flex;
}
.feather {
height: 1.3rem;
stroke-width: 0.15rem;
margin-right: 0.1rem;
vertical-align: middle;
}
.color-green {
background-color: lighten(#5bc275, 30%);
border-color: #5bc275;
color: darken(#5bc275, 30%);
}
.color-red {
background-color: lighten(#c25b75, 30%);
border-color: #c25b75;
color: darken(#c25b75, 30%);
}

47
src/ClassSchedule/Decode.elm Normal file
View File

@ -0,0 +1,47 @@
module ClassSchedule.Decode exposing (..)
import ClassSchedule.Model exposing (..)
import Json.Decode exposing (..)
dayOfWeek : Decoder DayOfWeek
dayOfWeek =
let
runDayOfWeek s =
case s of
"M" -> succeed Monday
"T" -> succeed Tuesday
"W" -> succeed Wednesday
"R" -> succeed Thursday
"F" -> succeed Friday
_ -> fail "Not a valid day of the week!"
in
string |> andThen runDayOfWeek
duration : Decoder (Time, Time)
duration =
let mkRange i j = (from24 i, addMinutes (round (j*60)) (from24 i))
in field "hour" int |> andThen (\i -> field "duration" float |> map (mkRange i))
time : Decoder (DayOfWeek, Time, Time)
time = map2 (\x (y, z) -> (x, y, z))
(field "day" dayOfWeek)
duration
crn : Decoder Crn
crn = string
|> andThen (\s ->
case String.split " " s of
[c, is] ->
case String.toInt is of
Just i -> succeed (c, i)
Nothing -> fail "Invalid course number!"
_ -> fail "Invalid course code!")
course : Decoder Course
course = map4 Course
(field "code" crn)
(field "title" string)
(field "instructor" (map List.singleton string))
(field "times" (list time))
response : Decoder (List Course)
response = field "courses" (list course)

16
src/ClassSchedule/Model.elm
View File

@ -1,13 +1,8 @@
module ClassSchedule.Model exposing (..)
import Dict exposing (..)
import Http exposing (Error)
type Department
= ComputerScience
| Mathematics
| Art
| Biology
type alias Crn = (Department, Int)
type alias Crn = (String, Int)
type DayOfWeek
= Monday
@ -28,6 +23,12 @@ flipDayHalf dh =
AM -> PM
PM -> AM
hour24 : Time -> Int
hour24 (h, _, th) = if th == AM then h else h + 12
from24 : Int -> Time
from24 i = (modBy 12 i, 0, if i >= 12 then PM else AM)
addHours : Int -> Time -> Time
addHours hh (h, m, dh) =
if h + hh >= 12
@ -59,6 +60,7 @@ type Msg
| SelectCourse Int
| AddCourse Int
| RemoveCourse Int
| ReceiveData (Result Error (List Course))
type alias Model =
{ terms : Dict String (List (CourseStatus, Course))

124
src/ClassSchedule/View.elm
View File

@ -11,16 +11,8 @@ iconButton : String -> FeatherIcons.Icon -> String -> List (Attribute Msg) -> Ht
iconButton c i s attrs = span ([ class "button", class ("color-" ++ c) ] ++ attrs)
[ FeatherIcons.toHtml [] i, text s ]
viewDept : Department -> String
viewDept d =
case d of
ComputerScience -> "CS"
Mathematics -> "MTH"
Art -> "ART"
Biology -> "BIO"
viewCrn : Crn -> String
viewCrn (d, i) = viewDept d ++ " " ++ (String.pad 3 '0' <| String.fromInt i)
viewCrn (d, i) = d ++ " " ++ (String.pad 3 '0' <| String.fromInt i)
viewTimeNumber : Int -> String
viewTimeNumber i = String.pad 2 '0' <| String.fromInt i
@ -72,41 +64,89 @@ extractTimeCodes c =
in dayCodes ++ " " ++ viewTimeRange tr
in List.map fromTime <| extractTimes c
-- viewClass : Maybe Int -> Int -> (CourseStatus, Course) -> Html Msg
-- viewClass sel i (cs, c) =
-- let
-- isSelected = sel == Just i
-- addedIndicator =
-- case cs of
-- Added -> [ FeatherIcons.check |> FeatherIcons.toHtml [] ]
-- NotAdded -> []
-- in
-- tr [ class "hoverable", onClick (SelectCourse i), classList [("selected", isSelected)] ]
-- [ td [] addedIndicator
-- , td [] [ text <| viewCrn (c.crn) ]
-- , td [] [ text <| c.name ]
-- , td [] [ text <| String.join ", " <| c.instructors ]
-- , td [] [ text <| String.join ", " <| extractTimeCodes c ]
-- , td [] <|
-- case (isSelected, cs) of
-- (True, NotAdded) -> [ iconButton "green" (FeatherIcons.check) "Add" [ onClick (AddCourse i)] ]
-- (True, Added) -> [ iconButton "red" (FeatherIcons.x) "Remove" [onClick (RemoveCourse i)] ]
-- _ -> []
-- ]
crnIcon : Html Msg
crnIcon = FeatherIcons.code |> FeatherIcons.toHtml []
instructorIcon : Html Msg
instructorIcon = FeatherIcons.user |> FeatherIcons.toHtml []
instructorsIcon : Html Msg
instructorsIcon = FeatherIcons.users |> FeatherIcons.toHtml []
timeIcon : Html Msg
timeIcon = FeatherIcons.clock |> FeatherIcons.toHtml []
checkIcon : Html Msg
checkIcon = FeatherIcons.check |> FeatherIcons.toHtml []
viewCrnBubble : Crn -> Html Msg
viewCrnBubble crn = span [ class "bubble" ] [ crnIcon, text <| viewCrn crn ]
viewTimeBubble : Course -> Html Msg
viewTimeBubble c = span [ class "bubble" ] [ timeIcon, text <| String.join ", " <| extractTimeCodes c ]
viewAddedBubble : Bool -> List (Html Msg)
viewAddedBubble b = if b then [ span [ class "bubble", class "color-green" ] [ checkIcon, text "Added!" ] ] else []
viewInstructorBubble : List String -> Html Msg
viewInstructorBubble is = span [ class "bubble" ] <|
case is of
[] -> [ instructorIcon, text <| "(no instructor assigned)" ]
[i] -> [ instructorIcon, text <| i ]
_ -> [ instructorsIcon, text <| String.join ", " is ]
viewClass : Maybe Int -> Int -> (CourseStatus, Course) -> Html Msg
viewClass sel i (cs, c) =
let
isSelected = sel == Just i
addedIndicator =
case cs of
Added -> [ FeatherIcons.check |> FeatherIcons.toHtml [] ]
NotAdded -> []
isAdded = cs == Added
in
tr [ class "hoverable", onClick (SelectCourse i), classList [("selected", isSelected)] ]
[ td [] addedIndicator
, td [] [ text <| viewCrn (c.crn) ]
, td [] [ text <| c.name ]
, td [] [ text <| String.join ", " <| c.instructors ]
, td [] [ text <| String.join ", " <| extractTimeCodes c ]
, td [] <|
div [ class "course", onClick (SelectCourse i), classList [("selected", isSelected )] ]
[ div [ class "course-content" ]
[ p [ class "course-title" ] <|
[ text <| c.name ]
, p [ class "course-info" ] <|
viewAddedBubble isAdded ++
[ viewCrnBubble c.crn
, viewInstructorBubble c.instructors
, viewTimeBubble c
]
]
, div [ class "course-add-remove" ] <|
case (isSelected, cs) of
(True, NotAdded) -> [ iconButton "green" (FeatherIcons.check) "Add" [ onClick (AddCourse i)] ]
(True, Added) -> [ iconButton "red" (FeatherIcons.x) "Remove" [onClick (RemoveCourse i)] ]
_ -> []
]
viewClassTable : Maybe Int -> List (CourseStatus, Course) -> Html Msg
viewClassTable sel =
let
header = tr []
[ th [] [ ]
, th [] [ text "Crn." ]
, th [] [ text "Course Name" ]
, th [] [ text "Instructors" ]
, th [] [ text "Times" ]
, th [] []
]
in
div [ class "table-wrapper" ] << List.singleton << table [ class "class-table" ] << (::) header << List.indexedMap (viewClass sel)
viewVisibleClass : String -> Maybe Int -> Int -> (CourseStatus, Course) -> List (Html Msg)
viewVisibleClass s mi i p = if courseContains s p then [ viewClass mi i p ] else []
viewClassTable : String -> Maybe Int -> List (CourseStatus, Course) -> Html Msg
viewClassTable s sel =
div [ class "table-wrapper" ] << List.concat << List.indexedMap (viewVisibleClass s sel)
viewToolbar : Model -> Html Msg
viewToolbar m = div []
@ -114,18 +154,10 @@ viewToolbar m = div []
]
viewClassList : Model -> Html Msg
viewClassList m = div []
[ viewToolbar m
, case get (m.term) (m.terms) of
Just cs -> viewClassTable (m.selected) <| List.filter (courseContains m.searchInput) cs
viewClassList m =
case get (m.term) (m.terms) of
Just cs -> viewClassTable m.searchInput m.selected cs
Nothing -> text "Please select a term!"
]
hour24 : Time -> Int
hour24 (h, _, th) = if th == AM then h else h + 12
from24 : Int -> Time
from24 i = (modBy 12 i, 0, if i >= 12 then PM else AM)
timeSortable : Time -> Int
timeSortable (h, m, th) = hour24 (h,m,th) * 60 + m
@ -254,7 +286,7 @@ viewClassSchedule m =
let
header = span [] [] :: List.map viewTableDayHeader (List.take 5 days)
cellDict = buildCellDict m.selected (Maybe.withDefault [] <| Dict.get m.term m.terms)
times = List.range 0 10
times = List.range 0 12
time h = List.map (\w -> Maybe.withDefault [] <| Maybe.andThen (Dict.get h) <| Dict.get w cellDict) (List.range 0 4)
container xs = div [ class "column-container" ] <|
List.map (\(c, ci) -> viewCourseBlock ci c) xs
@ -268,7 +300,7 @@ viewModel : Model -> Html Msg
viewModel m = div [ class "main" ]
[ h1 [] [ text "Oregon State University Course Schedule" ]
, div [ class "split-pane" ]
[ div [ class "split-elem" ] [ viewClassList m ]
[ div [ class "split-elem" ] [ viewToolbar m, viewClassList m ]
, div [ class "split-elem" ] [ viewClassSchedule m ]
]
]

52
src/Main.elm
View File

@ -1,9 +1,11 @@
module Main exposing (..)
import ClassSchedule.Model exposing (..)
import ClassSchedule.View exposing (..)
import ClassSchedule.Decode exposing (..)
import Browser exposing (Document, document)
import Dict exposing (..)
import Tuple exposing (..)
import Http exposing (..)
oneHour : Time -> (Time, Time)
oneHour t = (t, addMinutes 50 t)
@ -20,46 +22,14 @@ nPm i = (i, 0, PM)
onDays : List DayOfWeek -> (Time, Time) -> List (DayOfWeek, Time, Time)
onDays dds (t1, t2) = List.map (\d -> (d, t1, t2)) dds
classes : List Course
classes =
[ { crn = (ComputerScience, 517)
, name = "Theory of Comp"
, instructors = ["Mike Rosulek"]
, times = onDays [Monday, Wednesday, Friday] <| oneHour <| nPm 2
}
, { crn = (ComputerScience, 531)
, name = "Artificial Intelligence"
, instructors = ["John Doe"]
, times = onDays [Monday, Wednesday, Friday] <| oneHour <| nPm 0
}
, { crn = (ComputerScience, 533)
, name = "Intelligent Somethings"
, instructors = ["Alan Fern"]
, times = onDays [Monday, Wednesday] <| twoHours <| nAm 10
}
, { crn = (ComputerScience, 535)
, name = "Deep Learning"
, instructors = ["F. Li"]
, times = onDays [Tuesday, Thursday] <| twoHours <| nPm 2
}
, { crn = (ComputerScience, 551)
, name = "Computer Graphics"
, instructors = ["Mike Bailey"]
, times = onDays [Monday, Wednesday] <| twoHours <| nPm 0
}
, { crn = (ComputerScience, 565)
, name = "Human-Computer Interaction"
, instructors = ["Minsuk Kahng"]
, times = onDays [Tuesday, Thursday] <| twoHours <| nPm 4
}
]
terms : Dict String (List (CourseStatus, Course))
terms = Dict.singleton "Spring 2021"
<| List.map (pair NotAdded) classes
init : Flags -> (Model, Cmd Msg)
init () = ({ terms = terms, term = "Spring 2021", searchInput = "", selected = Nothing }, Cmd.none)
init () =
( { terms = Dict.empty, term = "Spring 2021", searchInput = "", selected = Nothing }
, Http.get
{ url = "cs565_hw4c_schedule_data.json"
, expect = expectJson ReceiveData response
}
)
view : Model -> Document Msg
view m =
@ -82,6 +52,10 @@ update msg m =
AddCourse i -> (modifyCurrent (changeCourse i Added) m, Cmd.none)
RemoveCourse i -> (modifyCurrent (changeCourse i NotAdded) m, Cmd.none)
SearchInput s -> ({ m | searchInput = s }, Cmd.none)
ReceiveData e ->
case e of
Err er -> Debug.log (Debug.toString er) (m, Cmd.none)
Ok d -> ({ m | terms = Dict.singleton "Spring 2021" <| List.map (pair NotAdded) d }, Cmd.none)
_ -> (m, Cmd.none)
subscriptions : Model -> Sub Msg