275 lines
9.5 KiB
Elm
275 lines
9.5 KiB
Elm
module ClassSchedule.View exposing (..)
|
|
import ClassSchedule.Model exposing (..)
|
|
import Html exposing (Html, Attribute, div, text, table, td, th, tr, span, input, h1, p)
|
|
import Html.Attributes exposing (class, classList, type_, style)
|
|
import Html.Events exposing (onClick, onInput)
|
|
import Tuple exposing (..)
|
|
import Dict exposing (..)
|
|
import FeatherIcons
|
|
|
|
iconButton : String -> FeatherIcons.Icon -> String -> List (Attribute Msg) -> Html Msg
|
|
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)
|
|
|
|
viewTimeNumber : Int -> String
|
|
viewTimeNumber i = String.pad 2 '0' <| String.fromInt i
|
|
|
|
viewDayHalf : DayHalf -> String
|
|
viewDayHalf dh =
|
|
case dh of
|
|
AM -> "AM"
|
|
PM -> "PM"
|
|
|
|
viewTime : Time -> String
|
|
viewTime (m, h, dh) = viewTimeNumber m ++ ":" ++ viewTimeNumber h ++ viewDayHalf dh
|
|
|
|
viewTimeRange : (Time, Time) -> String
|
|
viewTimeRange (t1, t2) = viewTime t1 ++ "-" ++ viewTime t2
|
|
|
|
viewDayCode : DayOfWeek -> String
|
|
viewDayCode dw =
|
|
case dw of
|
|
Monday -> "M"
|
|
Tuesday -> "T"
|
|
Wednesday -> "W"
|
|
Thursday -> "R"
|
|
Friday -> "F"
|
|
Saturday -> "S"
|
|
Sunday -> "U"
|
|
|
|
unique : List eq -> List eq
|
|
unique l =
|
|
case l of
|
|
[] -> []
|
|
(x::xs) -> x :: unique (List.filter ((/=) x) xs)
|
|
|
|
extractTimes : Course -> List (Time, Time)
|
|
extractTimes c =
|
|
let extractTime (d, t1, t2) = (t1, t2)
|
|
in unique <| List.map extractTime (c.times)
|
|
|
|
extractClasses : Course -> (Time, Time) -> List DayOfWeek
|
|
extractClasses c (t1, t2) =
|
|
let matches (d, tt1, tt2) = if tt1 == t1 && tt2 == t2 then Just d else Nothing
|
|
in List.filterMap matches (c.times)
|
|
|
|
extractTimeCodes : Course -> List String
|
|
extractTimeCodes c =
|
|
let
|
|
fromTime tr =
|
|
let dayCodes = String.concat <| List.map viewDayCode <| extractClasses c tr
|
|
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)] ]
|
|
_ -> []
|
|
]
|
|
|
|
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)
|
|
|
|
viewToolbar : Model -> Html Msg
|
|
viewToolbar m = div []
|
|
[ span [] [ text "Search: " , input [ type_ "text", onInput SearchInput ] [] ]
|
|
]
|
|
|
|
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
|
|
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
|
|
|
|
rangeSortable : (Time, Time) -> (Int, Int)
|
|
rangeSortable (t1, t2) = (timeSortable t1, -(timeSortable t2))
|
|
|
|
toHourCount : Time -> Time -> Float
|
|
toHourCount t1 t2 = toFloat (timeSortable t2 - timeSortable t1) / 60
|
|
|
|
maxTime : Time -> Time -> Time
|
|
maxTime t1 t2 = if timeSortable t1 > timeSortable t2 then t1 else t2
|
|
|
|
index : List a -> List (Int, a)
|
|
index =
|
|
let
|
|
indexWith n l =
|
|
case l of
|
|
[] -> []
|
|
(x::xs) -> (n,x) :: indexWith (n+1) xs
|
|
in indexWith 0
|
|
|
|
type alias SelectionReason = (CourseStatus, Bool)
|
|
|
|
findDay : Maybe Int -> DayOfWeek -> List (CourseStatus, Course) -> List (Course, SelectionReason, (Time, Time))
|
|
findDay ms dw l =
|
|
let
|
|
find (cs, b, c) = List.filter (\(ndw, _, _) -> ndw == dw) c.times
|
|
|> List.map (\(_, t1, t2) -> (c, (cs, b), (t1, t2)))
|
|
active (i, (cs, c)) =
|
|
if cs == Added || ms == Just i
|
|
then Just (cs, ms == Just i, c)
|
|
else Nothing
|
|
in
|
|
index l
|
|
|> List.filterMap active
|
|
|> List.concatMap find
|
|
|
|
findGroups : List (Course, SelectionReason, (Time, Time)) -> List (List (Course, SelectionReason, (Time, Time)))
|
|
findGroups cs =
|
|
let
|
|
findGroupsRec acc mt rcs =
|
|
case rcs of
|
|
[] ->
|
|
case acc of
|
|
[] -> []
|
|
_ -> [List.reverse acc]
|
|
((c, sr, (t1, t2))::trcs) ->
|
|
if timeSortable mt > timeSortable t1
|
|
then findGroupsRec ((c,sr,(t1,t2))::acc) (maxTime t2 mt) trcs
|
|
else List.reverse acc :: findGroupsRec [(c, sr, (t1, t2))] (maxTime t2 mt) trcs
|
|
in
|
|
findGroupsRec [] (0, 0, AM) <| List.sortBy (\(_, _, r) -> rangeSortable r) cs
|
|
|
|
type alias CellInfo =
|
|
{ width : Float
|
|
, height : Float
|
|
, verticalOffset : Float
|
|
, index : Int
|
|
, reason : SelectionReason
|
|
}
|
|
|
|
const : a -> b -> a
|
|
const x _ = x
|
|
|
|
mergeDicts : (a -> a -> a) -> Dict comparable a -> Dict comparable a -> Dict comparable a
|
|
mergeDicts f d1 d2 = Dict.merge Dict.insert (\k a b -> Dict.insert k (f a b)) Dict.insert d1 d2 Dict.empty
|
|
|
|
groupDims : List (Course, SelectionReason, (Time, Time)) -> Dict Int (List (Course, CellInfo))
|
|
groupDims l =
|
|
let
|
|
width = 100.0 / toFloat (List.length l)
|
|
courseInfo i (c, cr, (t1, t2)) = Dict.singleton (hour24 t1 - 8)
|
|
<| List.singleton
|
|
<| pair c
|
|
<|
|
|
{ width = width
|
|
, height = 100 * toHourCount t1 t2
|
|
, verticalOffset = let (_, m, _) = t1 in 100 * toFloat m / 60
|
|
, index = i
|
|
, reason = cr
|
|
}
|
|
in
|
|
List.foldl (mergeDicts (++)) Dict.empty <| List.indexedMap courseInfo l
|
|
|
|
days : List DayOfWeek
|
|
days = [Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday]
|
|
|
|
courseContains : String -> (CourseStatus, Course) -> Bool
|
|
courseContains s (_, c) = String.contains s (viewCrn c.crn) || String.contains s c.name || List.any (String.contains s) c.instructors
|
|
|
|
buildCellDict : Maybe Int -> List (CourseStatus, Course) -> Dict Int (Dict Int (List (Course, CellInfo)))
|
|
buildCellDict ms l =
|
|
let
|
|
singleDay i dw = findDay ms dw l
|
|
|> findGroups
|
|
|> List.map groupDims
|
|
|> List.foldl (mergeDicts (++)) Dict.empty
|
|
|> Dict.singleton i
|
|
in
|
|
List.foldl Dict.union Dict.empty <| List.indexedMap singleDay days
|
|
|
|
viewCourseBlock : CellInfo -> Course -> Html Msg
|
|
viewCourseBlock ci c =
|
|
let
|
|
ps f = String.fromFloat f ++ "%"
|
|
nw = if (ci.width) == 100.0 then 100.0 else (ci.width)*0.95
|
|
(ad, sel) = ci.reason
|
|
in div
|
|
[ class "course-block"
|
|
, style "width" (ps nw)
|
|
, style "height" (ps (ci.height))
|
|
, style "left" (ps (toFloat ci.index * ci.width))
|
|
, style "top" (ps (ci.verticalOffset))
|
|
, classList [("selected", sel), ("color-green", ad == Added)]
|
|
]
|
|
[ p [] [ text <| viewCrn <| c.crn ]
|
|
, p [] [ text <| c.name ]
|
|
]
|
|
|
|
viewTableDayHeader : DayOfWeek -> Html Msg
|
|
viewTableDayHeader dw = span [ class "table-day-header" ] [ text <| viewDayCode dw ]
|
|
|
|
viewClassSchedule : Model -> Html Msg
|
|
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
|
|
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
|
|
in
|
|
Debug.log (Debug.toString cellDict) <| div [ class "table-wrapper", style "width" "100%", style "padding" "1rem" ]
|
|
[ div [ class "week-grid" ] <|
|
|
header ++ (List.concatMap (\i -> span [ style "padding-right" "1rem" ] [ text <| viewTime <| from24 (i+8)] :: List.map container (time i)) times)
|
|
]
|
|
|
|
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" ] [ viewClassSchedule m ]
|
|
]
|
|
]
|