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 ] ] ]