put margins on Hamming widget

src/Hamming/App/Widgets/Internal.hs

@@ -24,6 +24,8 @@ License along with this program.  If not, see
 
 |-}
 
+{-# LANGUAGE TupleSections #-}
+
 module Hamming.App.Widgets.Internal (hammingW') where
 
 import Data.Bits ((.&.))
@@ -33,6 +35,15 @@ import Hamming.App.Types
 
 hammingW' :: AppState -> [[([String], Char)]]
 hammingW' state = let
+  header = ([], ' ') : map (["margin"],) ['0'..'3']
+  body   = hammingBody state
+  in header : zipWith
+    (\n row -> (["margin"], n) : row)
+    ['0'..'3']
+    body
+
+hammingBody :: AppState -> [[([String], Char)]]
+hammingBody state = let
   code = state^.hammingCode
   in map
   ( map

test/Hamming/App/Widgets/InternalSpec.hs

@@ -36,16 +36,21 @@ spec = describe "Internal"
 hammingW'Spec :: Spec
 hammingW'Spec = describe "hammingW'" $ mapM_
   ( \(desc, state, expRes) -> context desc $ do
-    let actRes = hammingW' state
+    let
+      actRes = hammingW' state
+      numActRows = length actRes
+      numExpRows = length expRes
     context "number of rows" $
-      it "should be 4" $
+      it ("should be " ++ show numExpRows) $
-        length actRes `shouldBe` 4
+        numActRows `shouldBe` numExpRows
     mapM_
-      ( \(rowNum, actRow, expRow) ->
+      ( \(rowNum, actRow, expRow) -> let
-        context ("row " ++ show rowNum) $ do
+        numActCols = length actRow
+        numExpCols = length expRow
+        in context ("row " ++ show rowNum) $ do
           context "number of columns" $
-            it "should be 4" $
+            it ("should be " ++ show numExpCols) $
-              length actRow `shouldBe` 4
+              numActCols `shouldBe` numExpCols
           mapM_
             ( \(colNum, actBit, expBit) ->
               context ("column " ++ show colNum) $
@@ -60,7 +65,26 @@ hammingW'Spec = describe "hammingW'" $ mapM_
   ] where
   mkState c = initialState & hammingCode .~ c
   allZero =
-    [ [ ( ["zero", "check"]
+    [ [ ( []
+        , ' '
+        )
+      , ( ["margin"]
+        , '0'
+        )
+      , ( ["margin"]
+        , '1'
+        )
+      , ( ["margin"]
+        , '2'
+        )
+      , ( ["margin"]
+        , '3'
+        )
+      ]
+    , [ ( ["margin"]
+        , '0'
+        )
+      , ( ["zero", "check"]
         , '0'
         )
       , ( ["check"]
@@ -73,7 +97,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
         , '0'
         )
       ]
-    , [ ( ["check"]
+    , [ ( ["margin"]
+        , '1'
+        )
+      , ( ["check"]
         , '0'
         )
       , ( []
@@ -86,7 +113,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
         , '0'
         )
       ]
-    , [ ( ["check"]
+    , [ ( ["margin"]
+        , '2'
+        )
+      , ( ["check"]
         , '0'
         )
       , ( []
@@ -99,7 +129,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
         , '0'
         )
       ]
-    , [ ( []
+    , [ ( ["margin"]
+        , '3'
+        )
+      , ( []
         , '0'
         )
       , ( []
@@ -114,7 +147,26 @@ hammingW'Spec = describe "hammingW'" $ mapM_
       ]
     ]
   allOne =
-    [ [ ( ["zero", "check"]
+    [ [ ( []
+        , ' '
+        )
+      , ( ["margin"]
+        , '0'
+        )
+      , ( ["margin"]
+        , '1'
+        )
+      , ( ["margin"]
+        , '2'
+        )
+      , ( ["margin"]
+        , '3'
+        )
+      ]
+    , [ ( ["margin"]
+        , '0'
+        )
+      , ( ["zero", "check"]
         , '1'
         )
       , ( ["check"]
@@ -127,7 +179,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
         , '1'
         )
       ]
-    , [ ( ["check"]
+    , [ ( ["margin"]
+        , '1'
+        )
+      , ( ["check"]
         , '1'
         )
       , ( []
@@ -140,7 +195,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
         , '1'
         )
       ]
-    , [ ( ["check"]
+    , [ ( ["margin"]
+        , '2'
+        )
+      , ( ["check"]
         , '1'
         )
       , ( []
@@ -153,7 +211,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
         , '1'
         )
       ]
-    , [ ( []
+    , [ ( ["margin"]
+        , '3'
+        )
+      , ( []
         , '1'
         )
       , ( []
@@ -168,7 +229,26 @@ hammingW'Spec = describe "hammingW'" $ mapM_
       ]
     ]
   arbitrary =
-    [ [ ( ["zero", "check"]
+    [ [ ( []
+        , ' '
+        )
+      , ( ["margin"]
+        , '0'
+        )
+      , ( ["margin"]
+        , '1'
+        )
+      , ( ["margin"]
+        , '2'
+        )
+      , ( ["margin"]
+        , '3'
+        )
+      ]
+    , [ ( ["margin"]
+        , '0'
+        )
+      , ( ["zero", "check"]
         , '0'
         )
       , ( ["check"]
@@ -181,7 +261,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
         , '1'
         )
       ]
-    , [ ( ["check"]
+    , [ ( ["margin"]
+        , '1'
+        )
+      , ( ["check"]
         , '1'
         )
       , ( []
@@ -194,7 +277,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
         , '0'
         )
       ]
-    , [ ( ["check"]
+    , [ ( ["margin"]
+        , '2'
+        )
+      , ( ["check"]
         , '0'
         )
       , ( []
@@ -207,7 +293,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
         , '1'
         )
       ]
-    , [ ( []
+    , [ ( ["margin"]
+        , '3'
+        )
+      , ( []
         , '1'
         )
       , ( []