From d2371e956b87e9c2abc6cc59a2777ba38bee35c3 Mon Sep 17 00:00:00 2001
From: Jonathan Lamothe <jonathan@jlamothe.net>
Date: Thu, 1 Aug 2024 18:33:33 -0400
Subject: [PATCH] show validity of hamming code

---
 src/Hamming/App.hs                       | 14 ++++++---
 src/Hamming/App/Widgets.hs               |  2 ++
 src/Hamming/App/Widgets/Internal.hs      | 14 ++++++++-
 test/Hamming/App/Widgets/InternalSpec.hs | 39 ++++++++++++++++++++++--
 4 files changed, 61 insertions(+), 8 deletions(-)

diff --git a/src/Hamming/App.hs b/src/Hamming/App.hs
index dc54686..6e12282 100644
--- a/src/Hamming/App.hs
+++ b/src/Hamming/App.hs
@@ -29,7 +29,7 @@ module Hamming.App (mainApp, initialState) where
 import Brick.AttrMap (attrMap)
 import Brick.Main (App (..), showFirstCursor)
 import Brick.Util (fg, style)
-import Graphics.Vty.Attributes (bold)
+import Graphics.Vty.Attributes (Attr (..), MaybeDefault (..), bold)
 import Graphics.Vty.Attributes.Color (green, red)
 
 import Hamming.App.Draw
@@ -44,9 +44,15 @@ mainApp = App
   , appHandleEvent  = eventHandler
   , appStartEvent   = return ()
   , appAttrMap      = const $ attrMap (style 0)
-    [ ( marginAttr, fg green    )
-    , ( checkAttr,  style bold )
-    , ( zeroAttr,   fg red     )
+    [ ( marginAttr,  fg green   )
+    , ( checkAttr,   style bold )
+    , ( zeroAttr,    fg red     )
+    , ( validAttr
+      , (style bold) { attrForeColor = SetTo green }
+      )
+    , ( invalidAttr
+      , (style bold) { attrForeColor = SetTo red }
+      )
     ]
   }
 
diff --git a/src/Hamming/App/Widgets.hs b/src/Hamming/App/Widgets.hs
index a50cd5b..cbd6aad 100644
--- a/src/Hamming/App/Widgets.hs
+++ b/src/Hamming/App/Widgets.hs
@@ -30,6 +30,8 @@ module Hamming.App.Widgets (
   -- ** Attribute Names
   hammingAttr,
   marginAttr,
+  validAttr,
+  invalidAttr,
   bodyAttr,
   checkAttr,
   zeroAttr,
diff --git a/src/Hamming/App/Widgets/Internal.hs b/src/Hamming/App/Widgets/Internal.hs
index 42516d1..8483adf 100644
--- a/src/Hamming/App/Widgets/Internal.hs
+++ b/src/Hamming/App/Widgets/Internal.hs
@@ -35,6 +35,8 @@ module Hamming.App.Widgets.Internal (
   -- ** Attribute Names
   hammingAttr,
   marginAttr,
+  validAttr,
+  invalidAttr,
   bodyAttr,
   checkAttr,
   zeroAttr,
@@ -46,12 +48,16 @@ import Lens.Micro (_2, (^.), (%~))
 import Brick.AttrMap (AttrName, attrName)
 import Brick.Types (Location)
 
+import Hamming
 import Hamming.App.Types
 import Hamming.App.Util
 
 hammingW' :: AppState -> ([[(AttrName, Char)]], Maybe Location)
 hammingW' state = let
-  header = (hammingAttr, ' ') : map (marginAttr,) ['0'..'3']
+  valid = if isValid (state^.hammingCode)
+    then (validAttr, '✓')
+    else (invalidAttr, 'X')
+  header = valid : map (marginAttr,) ['0'..'3']
   body   = hammingBody state
   widget = header : zipWith
     (\n row -> (marginAttr, n) : row)
@@ -65,6 +71,12 @@ hammingAttr = attrName "hamming"
 marginAttr :: AttrName
 marginAttr = hammingAttr <> attrName "margin"
 
+validAttr :: AttrName
+validAttr = marginAttr <> attrName "valid"
+
+invalidAttr :: AttrName
+invalidAttr = marginAttr <> attrName "invalid"
+
 bodyAttr :: AttrName
 bodyAttr = hammingAttr <> attrName "body"
 
diff --git a/test/Hamming/App/Widgets/InternalSpec.hs b/test/Hamming/App/Widgets/InternalSpec.hs
index a86b6ea..4ad5710 100644
--- a/test/Hamming/App/Widgets/InternalSpec.hs
+++ b/test/Hamming/App/Widgets/InternalSpec.hs
@@ -65,13 +65,14 @@ hammingW'Spec = describe "hammingW'" $ mapM_
   [ ( "all zero",  mkState 0,      allZero,   Nothing   )
   , ( "all one",   mkState 0xffff, allOne,    Nothing   )
   , ( "arbitrary", mkState 0x3c5a, arbitrary, Nothing   )
+  , ( "invalid",   mkState 0x3c5b, invalid,   Nothing   )
   , ( "edit",      es,             allZero,   Just eLoc )
   ] where
   mkState c = initialState & hammingCode .~ c
   es = mkState 0 & appMode .~ EditMode initialEditor
   eLoc = Location (1, 1)
   allZero =
-    [ [ ( hammingAttr, ' ' )
+    [ [ ( validAttr,   '✓' )
       , ( marginAttr,  '0' )
       , ( marginAttr,  '1' )
       , ( marginAttr,  '2' )
@@ -103,7 +104,7 @@ hammingW'Spec = describe "hammingW'" $ mapM_
       ]
     ]
   allOne =
-    [ [ ( hammingAttr, ' ' )
+    [ [ ( validAttr,   '✓' )
       , ( marginAttr,  '0' )
       , ( marginAttr,  '1' )
       , ( marginAttr,  '2' )
@@ -135,7 +136,7 @@ hammingW'Spec = describe "hammingW'" $ mapM_
       ]
     ]
   arbitrary =
-    [ [ ( hammingAttr, ' ' )
+    [ [ ( validAttr,   '✓' )
       , ( marginAttr,  '0' )
       , ( marginAttr,  '1' )
       , ( marginAttr,  '2' )
@@ -166,5 +167,37 @@ hammingW'Spec = describe "hammingW'" $ mapM_
       , ( bodyAttr,    '0' )
       ]
     ]
+  invalid =
+    [ [ ( invalidAttr, 'X' )
+      , ( marginAttr,  '0' )
+      , ( marginAttr,  '1' )
+      , ( marginAttr,  '2' )
+      , ( marginAttr,  '3' )
+      ]
+    , [ ( marginAttr,  '0' )
+      , ( zeroAttr,    '1' )
+      , ( checkAttr,   '1' )
+      , ( checkAttr,   '0' )
+      , ( bodyAttr,    '1' )
+      ]
+    , [ ( marginAttr,  '1' )
+      , ( checkAttr,   '1' )
+      , ( bodyAttr,    '0' )
+      , ( bodyAttr,    '1' )
+      , ( bodyAttr,    '0' )
+      ]
+    , [ ( marginAttr,  '2' )
+      , ( checkAttr,   '0' )
+      , ( bodyAttr,    '0' )
+      , ( bodyAttr,    '1' )
+      , ( bodyAttr,    '1' )
+      ]
+    , [ ( marginAttr,  '3' )
+      , ( bodyAttr,    '1' )
+      , ( bodyAttr,    '1' )
+      , ( bodyAttr,    '0' )
+      , ( bodyAttr,    '0' )
+      ]
+    ]
 
 --jl