show validity of hamming code

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
@@ -47,6 +47,12 @@ mainApp = App
     [ ( marginAttr,  fg green   )
     , ( checkAttr,   style bold )
     , ( zeroAttr,    fg red     )
+    , ( validAttr
+      , (style bold) { attrForeColor = SetTo green }
+      )
+    , ( invalidAttr
+      , (style bold) { attrForeColor = SetTo red }
+      )
     ]
   }
 

src/Hamming/App/Widgets.hs

@@ -30,6 +30,8 @@ module Hamming.App.Widgets (
   -- ** Attribute Names
   hammingAttr,
   marginAttr,
+  validAttr,
+  invalidAttr,
   bodyAttr,
   checkAttr,
   zeroAttr,

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"
 

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