Whitelist and blacklist chordTypes

Allow and disallow chords by the type of chords.

website/sandbox/chord-drill-sergeant/src/Main.elm

@@ -15,6 +15,8 @@ import Time exposing (..)
 
 type alias Model =
     { whitelistedChords : List Theory.Chord
+    , whitelistedChordTypes : List Theory.ChordType
+    , whitelistedInversions : List Theory.ChordInversion
     , selectedChord : Theory.Chord
     , isPaused : Bool
     , tempo : Int
@@ -24,7 +26,6 @@ type alias Model =
         { enable : Bool
         , inspectChord : Bool
         }
-    , whitelistedInversions : List Theory.ChordInversion
     }
 
 
@@ -38,6 +39,7 @@ type Msg
     | SetTempo String
     | ToggleInspectChord
     | ToggleInversion Theory.ChordInversion
+    | ToggleChordType Theory.ChordType
 
 
 tempoStep : Int
@@ -73,7 +75,14 @@ init =
         ( firstNote, lastNote ) =
             ( Theory.C3, Theory.C5 )
     in
-    { whitelistedChords = Theory.allChords firstNote lastNote Theory.allInversions
+    { whitelistedChords =
+        Theory.allChords
+            { start = firstNote
+            , end = lastNote
+            , inversions = Theory.allInversions
+            , chordTypes = Theory.allChordTypes
+            }
+    , whitelistedChordTypes = Theory.allChordTypes
     , whitelistedInversions = Theory.allInversions
     , selectedChord = cmajor
     , isPaused = True
@@ -150,6 +159,28 @@ update msg model =
             , Cmd.none
             )
 
+        ToggleChordType chordType ->
+            let
+                chordTypes =
+                    if List.member chordType model.whitelistedChordTypes then
+                        List.filter ((/=) chordType) model.whitelistedChordTypes
+
+                    else
+                        chordType :: model.whitelistedChordTypes
+            in
+            ( { model
+                | whitelistedChordTypes = chordTypes
+                , whitelistedChords =
+                    Theory.allChords
+                        { start = model.firstNote
+                        , end = model.lastNote
+                        , inversions = model.whitelistedInversions
+                        , chordTypes = chordTypes
+                        }
+              }
+            , Cmd.none
+            )
+
         ToggleInversion inversion ->
             let
                 inversions =
@@ -161,7 +192,13 @@ update msg model =
             in
             ( { model
                 | whitelistedInversions = inversions
-                , whitelistedChords = Theory.allChords model.firstNote model.lastNote inversions
+                , whitelistedChords =
+                    Theory.allChords
+                        { start = model.firstNote
+                        , end = model.lastNote
+                        , inversions = inversions
+                        , chordTypes = model.whitelistedChordTypes
+                        }
               }
             , Cmd.none
             )
@@ -197,6 +234,25 @@ debugger =
         ]
 
 
+chordTypeCheckboxes : List Theory.ChordType -> Html Msg
+chordTypeCheckboxes chordTypes =
+    ul []
+        (Theory.allChordTypes
+            |> List.map
+                (\chordType ->
+                    li []
+                        [ label [] [ text (Theory.chordTypeName chordType) ]
+                        , input
+                            [ type_ "checkbox"
+                            , onClick (ToggleChordType chordType)
+                            , checked (List.member chordType chordTypes)
+                            ]
+                            []
+                        ]
+                )
+        )
+
+
 inversionCheckboxes : List Theory.ChordInversion -> Html Msg
 inversionCheckboxes inversions =
     ul []
@@ -238,6 +294,7 @@ view model =
                     , handleInput = SetTempo
                     }
                 , inversionCheckboxes model.whitelistedInversions
+                , chordTypeCheckboxes model.whitelistedChordTypes
                 , playPause model
                 , if model.debug.enable then
                     debugger

website/sandbox/chord-drill-sergeant/src/Theory.elm

@@ -284,6 +284,45 @@ inversionName inversion =
             "Second"
 
 
+{-| Return the human-readable version of a chord type.
+-}
+chordTypeName : ChordType -> String
+chordTypeName chordType =
+    case chordType of
+        Major ->
+            "major"
+
+        Major7 ->
+            "major 7th"
+
+        MajorDominant7 ->
+            "major dominant 7th"
+
+        Minor ->
+            "minor"
+
+        MinorMajor7 ->
+            "minor major 7th"
+
+        MinorDominant7 ->
+            "minor dominant 7th"
+
+        Augmented ->
+            "augmented"
+
+        AugmentedDominant7 ->
+            "augmented dominant 7th"
+
+        Diminished ->
+            "diminished"
+
+        DiminishedDominant7 ->
+            "diminished dominant 7th"
+
+        DiminishedMajor7 ->
+            "diminished major 7th"
+
+
 {-| Return the note that is one half step away from `note` in the direction,
 `dir`.
 In the case of stepping up or down from the end of the piano, this returns a
@@ -794,14 +833,17 @@ allChordTypes =
 Only create chords from the range of notes delimited by the range `start` and
 `end`.
 -}
-allChords : Note -> Note -> List ChordInversion -> List Chord
+allChords :
-allChords start end chordInversions =
+    { start : Note
+    , end : Note
+    , inversions : List ChordInversion
+    , chordTypes : List ChordType
+    }
+    -> List Chord
+allChords { start, end, inversions, chordTypes } =
     let
         notes =
             notesFromRange start end
-
-        chordTypes =
-            allChordTypes
     in
     notes
         |> List.Extra.andThen
@@ -809,12 +851,12 @@ allChords start end chordInversions =
                 chordTypes
                     |> List.Extra.andThen
                         (\chordType ->
-                            chordInversions
+                            inversions
                                 |> List.Extra.andThen
-                                    (\chordInversion ->
+                                    (\inversion ->
                                         [ { note = note
                                           , chordType = chordType
-                                          , chordInversion = chordInversion
+                                          , chordInversion = inversion
                                           }
                                         ]
                                     )
@@ -1085,104 +1127,12 @@ viewNote note =
 
 inspectChord : Chord -> String
 inspectChord { note, chordType, chordInversion } =
-    viewNote note
+    viewNote note ++ " " ++ chordTypeName chordType ++ " " ++ inversionName chordInversion ++ " position"
-        ++ " "
-        ++ (case chordType of
-                Major ->
-                    "major"
-
-                Major7 ->
-                    "major 7th"
-
-                MajorDominant7 ->
-                    "major dominant 7th"
-
-                Minor ->
-                    "minor"
-
-                MinorMajor7 ->
-                    "minor major 7th"
-
-                MinorDominant7 ->
-                    "minor dominant 7th"
-
-                Augmented ->
-                    "augmented"
-
-                AugmentedDominant7 ->
-                    "augmented dominant 7th"
-
-                Diminished ->
-                    "diminished"
-
-                DiminishedDominant7 ->
-                    "diminished dominant 7th"
-
-                DiminishedMajor7 ->
-                    "diminished major 7th"
-           )
-        ++ " "
-        ++ (case chordInversion of
-                Root ->
-                    "root position"
-
-                First ->
-                    "1st inversion"
-
-                Second ->
-                    "2nd inversion"
-           )
 
 
 viewChord : Chord -> String
 viewChord { note, chordType, chordInversion } =
-    viewNoteClass (classifyNote note)
+    viewNoteClass (classifyNote note) ++ " " ++ chordTypeName chordType ++ " " ++ inversionName chordInversion ++ " position"
-        ++ " "
-        ++ (case chordType of
-                Major ->
-                    "major"
-
-                Major7 ->
-                    "major 7th"
-
-                MajorDominant7 ->
-                    "major dominant 7th"
-
-                Minor ->
-                    "minor"
-
-                MinorMajor7 ->
-                    "minor 7th"
-
-                MinorDominant7 ->
-                    "minor dominant 7th"
-
-                Augmented ->
-                    "augmented"
-
-                AugmentedDominant7 ->
-                    "augmented 7th"
-
-                Diminished ->
-                    "diminished"
-
-                DiminishedDominant7 ->
-                    "diminished 7th"
-
-                DiminishedMajor7 ->
-                    "diminished major 7th"
-           )
-        ++ " "
-        ++ (case chordInversion of
-                Root ->
-                    "root position"
-
-                First ->
-                    "1st inversion"
-
-                Second ->
-                    "2nd inversion"
-           )
 
 
 {-| Serialize a human-readable format of `noteClass`.