diff options
Diffstat (limited to 'users/wpcarro/website/habit-screens/src')
| -rw-r--r-- | users/wpcarro/website/habit-screens/src/Habits.elm | 463 | ||||
| -rw-r--r-- | users/wpcarro/website/habit-screens/src/Main.elm | 29 | ||||
| -rw-r--r-- | users/wpcarro/website/habit-screens/src/State.elm | 195 | ||||
| -rw-r--r-- | users/wpcarro/website/habit-screens/src/UI.elm | 9 | ||||
| -rw-r--r-- | users/wpcarro/website/habit-screens/src/Utils.elm | 37 |
5 files changed, 733 insertions, 0 deletions
diff --git a/users/wpcarro/website/habit-screens/src/Habits.elm b/users/wpcarro/website/habit-screens/src/Habits.elm new file mode 100644 index 0000000000..691adc9394 --- /dev/null +++ b/users/wpcarro/website/habit-screens/src/Habits.elm @@ -0,0 +1,463 @@ +module Habits exposing (render) + +import Browser +import Date exposing (Date) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Set exposing (Set) +import State exposing (HabitType(..)) +import Time exposing (Weekday(..)) +import UI +import Utils exposing (Strategy(..)) + + +morning : List State.Habit +morning = + List.map + (\( duration, x ) -> + { label = x + , habitType = State.Morning + , minutesDuration = duration + } + ) + [ ( 1, "Make bed" ) + , ( 2, "Brush teeth" ) + , ( 30, "Run (15 minutes)" ) + , ( 10, "Shower" ) + , ( 10, "Meditate" ) + ] + + +evening : List State.Habit +evening = + List.map + (\( duration, x ) -> + { label = x + , habitType = State.Evening + , minutesDuration = duration + } + ) + [ ( 30, "Read" ) + , ( 1, "Record in habit Journal" ) + ] + + +monday : List ( Int, String ) +monday = + [ ( 90, "Bikram Yoga @ 17:00" ) + ] + + +tuesday : List ( Int, String ) +tuesday = + [ ( 90, "Bikram Yoga @ 18:00" ) + ] + + +wednesday : List ( Int, String ) +wednesday = + [ ( 5, "Shave" ) + , ( 90, "Bikram Yoga @ 17:00" ) + ] + + +thursday : List ( Int, String ) +thursday = + [] + + +friday : List ( Int, String ) +friday = + [ ( 60, "Bikram Yoga @ 17:00" ) + , ( 3, "Take-out trash" ) + , ( 60, "Shop for groceries" ) + ] + + +saturday : List ( Int, String ) +saturday = + [ ( 60, "Warm Yin Yoga @ 15:00" ) + ] + + +sunday : List ( Int, String ) +sunday = + [ ( 1, "Shampoo" ) + , ( 5, "Shave" ) + , ( 1, "Trim nails" ) + , ( 1, "Combine trash cans" ) + , ( 10, "Mop tile and wood floors" ) + , ( 10, "Laundry" ) + , ( 5, "Vacuum bedroom" ) + , ( 5, "Clean desk" ) + ] + + +payday : List State.Habit +payday = + List.map + (\( duration, x ) -> + { label = x + , habitType = State.Payday + , minutesDuration = duration + } + ) + [ ( 1, "Ensure \"Emergency\" fund has a balance of 1000 GBP" ) + , ( 1, "Open \"finances_2020\" Google Sheet" ) + , ( 1, "Settle up with Mimi on TransferWise" ) + , ( 1, "Adjust GBP:USD exchange rate" ) + , ( 1, "Adjust \"Stocks (after tax)\" to reflect amount Google sent" ) + , ( 1, "Add remaining cash to \"Carryover (cash)\"" ) + , ( 1, "Adjust \"Paycheck\" to reflect amount Google sent" ) + , ( 5, "In the \"International Xfer\" table, send \"Xfer amount\" from Monzo to USAA" ) + , ( 10, "Go to an ATM and extract the amount in \"ATM withdrawal\"" ) + , ( 0, "Await the TransferWise transaction to complete and pay MyFedLoan in USD" ) + ] + + +firstOfTheMonth : List State.Habit +firstOfTheMonth = + List.map + (\( duration, x ) -> + { label = x + , habitType = State.FirstOfTheMonth + , minutesDuration = duration + } + ) + [ ( 10, "Create habit template in journal" ) + , ( 30, "Assess previous month's performance" ) + , ( 5, "Register for Bikram Yoga classes" ) + ] + + +firstOfTheYear : List State.Habit +firstOfTheYear = + List.map + (\( duration, x ) -> + { label = x + , habitType = State.FirstOfTheYear + , minutesDuration = duration + } + ) + [ ( 60, "Write a post mortem for the previous year" ) + ] + + +habitTypes : + { includeMorning : Bool + , includeEvening : Bool + , date : Date + } + -> List State.HabitType +habitTypes { includeMorning, includeEvening, date } = + let + habitTypePredicates : List ( State.HabitType, Date -> Bool ) + habitTypePredicates = + [ ( Morning, \_ -> includeMorning ) + , ( DayOfWeek, \_ -> True ) + , ( Payday, \x -> Date.day x == 25 ) + , ( FirstOfTheMonth, \x -> Date.day x == 1 ) + , ( FirstOfTheYear, \x -> Date.day x == 1 && Date.monthNumber x == 1 ) + , ( Evening, \_ -> includeEvening ) + ] + in + habitTypePredicates + |> List.filter (\( _, predicate ) -> predicate date) + |> List.map (\( habitType, _ ) -> habitType) + + +habitsFor : State.HabitType -> Weekday -> List State.Habit +habitsFor habitType weekday = + case habitType of + Morning -> + morning + + Evening -> + evening + + DayOfWeek -> + let + toHabit : List ( Int, String ) -> List State.Habit + toHabit = + List.map + (\( duration, x ) -> + { label = x + , habitType = State.DayOfWeek + , minutesDuration = duration + } + ) + in + case weekday of + Mon -> + toHabit monday + + Tue -> + toHabit tuesday + + Wed -> + toHabit wednesday + + Thu -> + toHabit thursday + + Fri -> + toHabit friday + + Sat -> + toHabit saturday + + Sun -> + toHabit sunday + + Payday -> + payday + + FirstOfTheMonth -> + firstOfTheMonth + + FirstOfTheYear -> + firstOfTheYear + + +weekdayLabelFor : Weekday -> State.WeekdayLabel +weekdayLabelFor weekday = + case weekday of + Mon -> + "Monday" + + Tue -> + "Tuesday" + + Wed -> + "Wednesday" + + Thu -> + "Thursday" + + Fri -> + "Friday" + + Sat -> + "Saturday" + + Sun -> + "Sunday" + + +timeRemaining : State.WeekdayLabel -> State.CompletedHabits -> List State.Habit -> Int +timeRemaining weekdayLabel completed habits = + habits + |> List.indexedMap + (\i { label, minutesDuration } -> + if Set.member ( weekdayLabel, label ) completed then + 0 + + else + minutesDuration + ) + |> List.sum + + +render : State.Model -> Html State.Msg +render { today, visibleDayOfWeek, completed, includeMorning, includeEvening } = + case ( today, visibleDayOfWeek ) of + ( Just todaysDate, Just visibleWeekday ) -> + let + todaysWeekday : Weekday + todaysWeekday = + Date.weekday todaysDate + + habits : List State.Habit + habits = + habitTypes + { includeMorning = includeMorning + , includeEvening = includeEvening + , date = todaysDate + } + |> List.map (\habitType -> habitsFor habitType todaysWeekday) + |> List.concat + in + div + [ Utils.class + [ Always "max-w-xl mx-auto py-6 px-6" + , When (todaysWeekday /= visibleWeekday) "pt-20" + ] + ] + [ header [] + [ if todaysWeekday /= visibleWeekday then + div [ class "text-center w-full bg-blue-600 text-white fixed top-0 left-0 px-3 py-4" ] + [ p [ class "py-2 inline pr-5" ] + [ text "As you are not viewing today's habits, the UI is in read-only mode" ] + , UI.button + [ class "bg-blue-200 px-4 py-2 rounded text-blue-600 text-xs font-bold" + , onClick State.ViewToday + ] + [ text "View Today's Habits" ] + ] + + else + text "" + , div [ class "flex center" ] + [ UI.button + [ class "w-1/4 text-gray-500" + , onClick State.ViewPrevious + ] + [ text "‹ previous" ] + , h1 [ class "font-bold text-blue-500 text-3xl text-center w-full" ] + [ text (weekdayLabelFor visibleWeekday) ] + , UI.button + [ class "w-1/4 text-gray-500" + , onClick State.ViewNext + ] + [ text "next ›" ] + ] + ] + , if todaysWeekday == visibleWeekday then + p [ class "text-center pt-1 pb-4" ] + [ let + t : Int + t = + timeRemaining (weekdayLabelFor todaysWeekday) completed habits + in + if t == 0 then + text "Nothing to do!" + + else + text + ((habits + |> timeRemaining (weekdayLabelFor todaysWeekday) completed + |> String.fromInt + ) + ++ " minutes remaining" + ) + ] + + else + text "" + , if todaysWeekday == visibleWeekday then + div [] + [ UI.button + [ onClick + (if Set.size completed == 0 then + State.DoNothing + + else + State.ClearAll + ) + , Utils.class + [ Always "ml-10 px-3" + , If (Set.size completed == 0) + "text-gray-500 cursor-not-allowed" + "text-red-500 underline cursor-pointer" + ] + ] + [ let + numCompleted : Int + numCompleted = + habits + |> List.indexedMap (\i { label } -> ( i, label )) + |> List.filter + (\( i, label ) -> + Set.member + ( weekdayLabelFor todaysWeekday, label ) + completed + ) + |> List.length + in + if numCompleted == 0 then + text "Clear" + + else + text ("Clear (" ++ String.fromInt numCompleted ++ ")") + ] + , UI.button + [ onClick State.ToggleMorning + , Utils.class + [ Always "px-3 underline" + , If includeMorning + "text-gray-600" + "text-blue-600" + ] + ] + [ text + (if includeMorning then + "Hide Morning" + + else + "Show Morning" + ) + ] + , UI.button + [ Utils.class + [ Always "px-3 underline" + , If includeEvening + "text-gray-600" + "text-blue-600" + ] + , onClick State.ToggleEvening + ] + [ text + (if includeEvening then + "Hide Evening" + + else + "Show Evening" + ) + ] + ] + + else + text "" + , ul [ class "pb-10" ] + (habits + |> List.indexedMap + (\i { label, minutesDuration } -> + let + isCompleted : Bool + isCompleted = + Set.member ( weekdayLabelFor todaysWeekday, label ) completed + in + li [ class "text-xl list-disc ml-6" ] + [ if todaysWeekday == visibleWeekday then + UI.button + [ class "py-5 px-3" + , onClick + (State.ToggleHabit + (weekdayLabelFor todaysWeekday) + label + ) + ] + [ span + [ Utils.class + [ Always "text-white pt-1 px-2 rounded" + , If isCompleted "bg-gray-400" "bg-blue-500" + ] + ] + [ text (String.fromInt minutesDuration ++ " mins") ] + , p + [ Utils.class + [ Always "inline pl-3" + , When isCompleted "line-through text-gray-400" + ] + ] + [ text label ] + ] + + else + UI.button + [ class "py-5 px-3 cursor-not-allowed" + , onClick State.DoNothing + ] + [ text label ] + ] + ) + ) + , footer [ class "bg-white text-sm text-center text-gray-500 fixed bottom-0 left-0 w-full py-4" ] + [ p [] [ text "This app is brought to you by William Carroll." ] + , p [] [ text "Client: Elm; Server: n/a" ] + ] + ] + + ( _, _ ) -> + p [] [ text "Unable to display habits because we do not know what day of the week it is." ] diff --git a/users/wpcarro/website/habit-screens/src/Main.elm b/users/wpcarro/website/habit-screens/src/Main.elm new file mode 100644 index 0000000000..2ddedb9133 --- /dev/null +++ b/users/wpcarro/website/habit-screens/src/Main.elm @@ -0,0 +1,29 @@ +module Main exposing (main) + +import Browser +import Habits +import Html exposing (..) +import State +import Time + + +subscriptions : State.Model -> Sub State.Msg +subscriptions model = + -- once per minute + Time.every (1000 * 60) (\_ -> State.MaybeAdjustWeekday) + + +view : State.Model -> Html State.Msg +view model = + case model.view of + State.Habits -> + Habits.render model + + +main = + Browser.element + { init = \() -> State.init + , subscriptions = subscriptions + , update = State.update + , view = view + } diff --git a/users/wpcarro/website/habit-screens/src/State.elm b/users/wpcarro/website/habit-screens/src/State.elm new file mode 100644 index 0000000000..ea00a01351 --- /dev/null +++ b/users/wpcarro/website/habit-screens/src/State.elm @@ -0,0 +1,195 @@ +module State exposing (..) + +import Date exposing (Date) +import Set exposing (Set) +import Task +import Time exposing (Weekday(..)) + + +type alias WeekdayLabel = + String + + +type alias HabitLabel = + String + + +type Msg + = DoNothing + | SetView View + | ReceiveDate Date + | ToggleHabit WeekdayLabel HabitLabel + | MaybeAdjustWeekday + | ViewToday + | ViewPrevious + | ViewNext + | ClearAll + | ToggleMorning + | ToggleEvening + + +type View + = Habits + + +type HabitType + = Morning + | Evening + | DayOfWeek + | Payday + | FirstOfTheMonth + | FirstOfTheYear + + +type alias Habit = + { label : HabitLabel + , habitType : HabitType + , minutesDuration : Int + } + + +type alias CompletedHabits = + Set ( WeekdayLabel, HabitLabel ) + + +type alias Model = + { isLoading : Bool + , view : View + , today : Maybe Date + , completed : CompletedHabits + , visibleDayOfWeek : Maybe Weekday + , includeMorning : Bool + , includeEvening : Bool + } + + +previousDay : Weekday -> Weekday +previousDay weekday = + case weekday of + Mon -> + Sun + + Tue -> + Mon + + Wed -> + Tue + + Thu -> + Wed + + Fri -> + Thu + + Sat -> + Fri + + Sun -> + Sat + + +nextDay : Weekday -> Weekday +nextDay weekday = + case weekday of + Mon -> + Tue + + Tue -> + Wed + + Wed -> + Thu + + Thu -> + Fri + + Fri -> + Sat + + Sat -> + Sun + + Sun -> + Mon + + +{-| The initial state for the application. +-} +init : ( Model, Cmd Msg ) +init = + ( { isLoading = False + , view = Habits + , today = Nothing + , completed = Set.empty + , visibleDayOfWeek = Nothing + , includeMorning = True + , includeEvening = True + } + , Date.today |> Task.perform ReceiveDate + ) + + +{-| Now that we have state, we need a function to change the state. +-} +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg ({ today, visibleDayOfWeek, completed } as model) = + case msg of + DoNothing -> + ( model, Cmd.none ) + + SetView x -> + ( { model + | view = x + , isLoading = True + } + , Cmd.none + ) + + ReceiveDate x -> + ( { model + | today = Just x + , visibleDayOfWeek = Just (Date.weekday x) + } + , Cmd.none + ) + + ToggleHabit weekdayLabel habitLabel -> + ( { model + | completed = + if Set.member ( weekdayLabel, habitLabel ) completed then + Set.remove ( weekdayLabel, habitLabel ) completed + + else + Set.insert ( weekdayLabel, habitLabel ) completed + } + , Cmd.none + ) + + MaybeAdjustWeekday -> + ( model, Date.today |> Task.perform ReceiveDate ) + + ViewToday -> + ( { model | visibleDayOfWeek = today |> Maybe.map Date.weekday }, Cmd.none ) + + ViewPrevious -> + ( { model + | visibleDayOfWeek = visibleDayOfWeek |> Maybe.map previousDay + } + , Cmd.none + ) + + ViewNext -> + ( { model + | visibleDayOfWeek = visibleDayOfWeek |> Maybe.map nextDay + } + , Cmd.none + ) + + ClearAll -> + ( { model | completed = Set.empty }, Cmd.none ) + + ToggleMorning -> + ( { model | includeMorning = not model.includeMorning }, Cmd.none ) + + ToggleEvening -> + ( { model | includeEvening = not model.includeEvening }, Cmd.none ) diff --git a/users/wpcarro/website/habit-screens/src/UI.elm b/users/wpcarro/website/habit-screens/src/UI.elm new file mode 100644 index 0000000000..5b54269135 --- /dev/null +++ b/users/wpcarro/website/habit-screens/src/UI.elm @@ -0,0 +1,9 @@ +module UI exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) + + +button : List (Attribute msg) -> List (Html msg) -> Html msg +button attrs children = + Html.button ([ class "focus:outline-none" ] ++ attrs) children diff --git a/users/wpcarro/website/habit-screens/src/Utils.elm b/users/wpcarro/website/habit-screens/src/Utils.elm new file mode 100644 index 0000000000..23b13c224c --- /dev/null +++ b/users/wpcarro/website/habit-screens/src/Utils.elm @@ -0,0 +1,37 @@ +module Utils exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Maybe.Extra + + +type Strategy + = Always String + | When Bool String + | If Bool String String + + +class : List Strategy -> Attribute msg +class classes = + classes + |> List.map + (\strategy -> + case strategy of + Always x -> + Just x + + When True x -> + Just x + + When False _ -> + Nothing + + If True x _ -> + Just x + + If False _ x -> + Just x + ) + |> Maybe.Extra.values + |> String.join " " + |> Html.Attributes.class |