Support multiple HabitTypes

I could have and should have broken this change into smaller pieces, but when I
came up for air, I had changed too much, and most of the changes are
intermingled. Oh well... this is an exciting change!

Include habits for:
- Morning
- Evening
- Payday (the 25th)
- First of the Month
- First of the Year

Since the Morning and Evening routines might be a bit noisy, I'm excluding them
from the output using a flag, `include{Morning,Evening}`, which I support in the
UI to toggle their visibility.

I made *much* more progress on this app that I expected to today, and I *think*
-- short of supporting a database and a server -- I'm close to
being *completely* finished.

Wahoo!

scratch/habit-screens/client/src/Habits.elm

@@ -1,11 +1,12 @@
 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
+import State exposing (HabitType(..))
 import Time exposing (Weekday(..))
 import UI
 import Utils exposing (Strategy(..))
@@ -38,7 +39,7 @@ evening =
             }
         )
         [ ( 30, "Read" )
-        , ( 1, "Record in State.Habit Journal" )
+        , ( 1, "Record in habit Journal" )
         ]
 
 
@@ -145,34 +146,41 @@ firstOfTheYear =
         ]
 
 
-weekdayName : Weekday -> String
+habitTypes :
-weekdayName weekday =
+    { includeMorning : Bool
-    case weekday of
+    , includeEvening : Bool
-        Mon ->
+    , date : Date
-            "Monday"
+    }
-
+    -> List State.HabitType
-        Tue ->
+habitTypes { includeMorning, includeEvening, date } =
-            "Tuesday"
-
-        Wed ->
-            "Wednesday"
-
-        Thu ->
-            "Thursday"
-
-        Fri ->
-            "Friday"
-
-        Sat ->
-            "Saturday"
-
-        Sun ->
-            "Sunday"
-
-
-habitsFor : Weekday -> List State.Habit
-habitsFor weekday =
     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 ) ->
@@ -204,13 +212,47 @@ habitsFor weekday =
                 Sun ->
                     toHabit sunday
 
+        Payday ->
+            payday
 
-timeRemaining : Set Int -> List State.Habit -> Int
+        FirstOfTheMonth ->
-timeRemaining completed habits =
+            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 { minutesDuration } ->
+            (\i { label, minutesDuration } ->
-                if Set.member i completed then
+                if Set.member ( weekdayLabel, label ) completed then
                     0
 
                 else
@@ -220,24 +262,32 @@ timeRemaining completed habits =
 
 
 render : State.Model -> Html State.Msg
-render { today, visibleDayOfWeek, completed } =
+render { today, visibleDayOfWeek, completed, includeMorning, includeEvening } =
-    case visibleDayOfWeek of
+    case ( today, visibleDayOfWeek ) of
-        Nothing ->
+        ( Just todaysDate, Just visibleWeekday ) ->
-            p [] [ text "Unable to display habits because we do not know what day of the week it is." ]
-
-        Just weekday ->
             let
+                todaysWeekday : Weekday
+                todaysWeekday =
+                    Date.weekday todaysDate
+
+                habits : List State.Habit
                 habits =
-                    habitsFor weekday
+                    habitTypes
+                        { includeMorning = includeMorning
+                        , includeEvening = includeEvening
+                        , date = todaysDate
+                        }
+                        |> List.map (\habitType -> habitsFor habitType todaysWeekday)
+                        |> List.concat
             in
             div
                 [ Utils.class
                     [ Always "container mx-auto py-6 px-6"
-                    , When (today /= visibleDayOfWeek) "pt-20"
+                    , When (todaysWeekday /= visibleWeekday) "pt-20"
                     ]
                 ]
                 [ header []
-                    [ if today /= visibleDayOfWeek then
+                    [ 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" ]
@@ -257,7 +307,7 @@ render { today, visibleDayOfWeek, completed } =
                             ]
                             [ text "‹ previous" ]
                         , h1 [ class "font-bold text-blue-500 text-3xl text-center w-full" ]
-                            [ text (weekdayName weekday) ]
+                            [ text (weekdayLabelFor visibleWeekday) ]
                         , UI.button
                             [ class "w-1/4 text-gray-500"
                             , onClick State.ViewNext
@@ -265,11 +315,12 @@ render { today, visibleDayOfWeek, completed } =
                             [ text "next ›" ]
                         ]
                     ]
-                , if today == visibleDayOfWeek then
+                , if todaysWeekday == visibleWeekday then
                     p [ class "text-center" ]
                         [ let
+                            t : Int
                             t =
-                                timeRemaining completed habits
+                                timeRemaining (weekdayLabelFor todaysWeekday) completed habits
                           in
                           if t == 0 then
                             text "Nothing to do!"
@@ -277,7 +328,7 @@ render { today, visibleDayOfWeek, completed } =
                           else
                             text
                                 ((habits
-                                    |> timeRemaining completed
+                                    |> timeRemaining (weekdayLabelFor todaysWeekday) completed
                                     |> String.fromInt
                                  )
                                     ++ " minutes remaining"
@@ -286,7 +337,7 @@ render { today, visibleDayOfWeek, completed } =
 
                   else
                     text ""
-                , if today == visibleDayOfWeek then
+                , if todaysWeekday == visibleWeekday then
                     div []
                         [ UI.button
                             [ onClick
@@ -304,10 +355,16 @@ render { today, visibleDayOfWeek, completed } =
                                 ]
                             ]
                             [ let
+                                numCompleted : Int
                                 numCompleted =
                                     habits
-                                        |> List.indexedMap (\i _ -> i)
+                                        |> List.indexedMap (\i { label } -> ( i, label ))
-                                        |> List.filter (\i -> Set.member i completed)
+                                        |> List.filter
+                                            (\( i, label ) ->
+                                                Set.member
+                                                    ( weekdayLabelFor todaysWeekday, label )
+                                                    completed
+                                            )
                                         |> List.length
                               in
                               if numCompleted == 0 then
@@ -316,6 +373,40 @@ render { today, visibleDayOfWeek, completed } =
                               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
@@ -325,14 +416,19 @@ render { today, visibleDayOfWeek, completed } =
                         |> List.indexedMap
                             (\i { label, minutesDuration } ->
                                 let
+                                    isCompleted : Bool
                                     isCompleted =
-                                        Set.member i completed
+                                        Set.member ( weekdayLabelFor todaysWeekday, label ) completed
                                 in
                                 li [ class "text-xl list-disc ml-6" ]
-                                    [ if today == visibleDayOfWeek then
+                                    [ if todaysWeekday == visibleWeekday then
                                         UI.button
                                             [ class "py-5 px-3"
-                                            , onClick (State.ToggleHabit i)
+                                            , onClick
+                                                (State.ToggleHabit
+                                                    (weekdayLabelFor todaysWeekday)
+                                                    label
+                                                )
                                             ]
                                             [ span
                                                 [ Utils.class
@@ -364,3 +460,6 @@ render { today, visibleDayOfWeek, completed } =
                     , 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." ]

scratch/habit-screens/client/src/State.elm

@@ -1,21 +1,31 @@
 module State exposing (..)
 
-import Date
+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.Date
+    | ReceiveDate Date
-    | ToggleHabit Int
+    | ToggleHabit WeekdayLabel HabitLabel
     | MaybeAdjustWeekday
     | ViewToday
     | ViewPrevious
     | ViewNext
     | ClearAll
+    | ToggleMorning
+    | ToggleEvening
 
 
 type View
@@ -32,18 +42,24 @@ type HabitType
 
 
 type alias Habit =
-    { label : String
+    { label : HabitLabel
     , habitType : HabitType
     , minutesDuration : Int
     }
 
 
+type alias CompletedHabits =
+    Set ( WeekdayLabel, HabitLabel )
+
+
 type alias Model =
     { isLoading : Bool
     , view : View
-    , today : Maybe Weekday
+    , today : Maybe Date
-    , completed : Set Int
+    , completed : CompletedHabits
     , visibleDayOfWeek : Maybe Weekday
+    , includeMorning : Bool
+    , includeEvening : Bool
     }
 
 
@@ -106,6 +122,8 @@ init =
       , today = Nothing
       , completed = Set.empty
       , visibleDayOfWeek = Nothing
+      , includeMorning = False
+      , includeEvening = False
       }
     , Date.today |> Task.perform ReceiveDate
     )
@@ -129,20 +147,20 @@ update msg ({ today, visibleDayOfWeek, completed } as model) =
 
         ReceiveDate x ->
             ( { model
-                | today = Just (Date.weekday x)
+                | today = Just x
                 , visibleDayOfWeek = Just (Date.weekday x)
               }
             , Cmd.none
             )
 
-        ToggleHabit i ->
+        ToggleHabit weekdayLabel habitLabel ->
             ( { model
                 | completed =
-                    if Set.member i completed then
+                    if Set.member ( weekdayLabel, habitLabel ) completed then
-                        Set.remove i completed
+                        Set.remove ( weekdayLabel, habitLabel ) completed
 
                     else
-                        Set.insert i completed
+                        Set.insert ( weekdayLabel, habitLabel ) completed
               }
             , Cmd.none
             )
@@ -151,7 +169,7 @@ update msg ({ today, visibleDayOfWeek, completed } as model) =
             ( model, Date.today |> Task.perform ReceiveDate )
 
         ViewToday ->
-            ( { model | visibleDayOfWeek = today }, Cmd.none )
+            ( { model | visibleDayOfWeek = today |> Maybe.map Date.weekday }, Cmd.none )
 
         ViewPrevious ->
             ( { model
@@ -169,3 +187,9 @@ update msg ({ today, visibleDayOfWeek, completed } as model) =
 
         ClearAll ->
             ( { model | completed = Set.empty }, Cmd.none )
+
+        ToggleMorning ->
+            ( { model | includeMorning = not model.includeMorning }, Cmd.none )
+
+        ToggleEvening ->
+            ( { model | includeEvening = not model.includeEvening }, Cmd.none )