build hamming code display widget

hamming.cabal

@@ -36,6 +36,7 @@ library
   build-depends:
       base >=4.7 && <5
     , brick >=2.1.1 && <2.2
+    , microlens >=0.4.13.1 && <0.5
     , microlens-th >=0.4.3.15 && <0.5
     , mtl >=2.3.1 && <2.4
   default-language: Haskell2010
@@ -53,6 +54,7 @@ executable hamming
       base >=4.7 && <5
     , brick >=2.1.1 && <2.2
     , hamming
+    , microlens >=0.4.13.1 && <0.5
     , microlens-th >=0.4.3.15 && <0.5
     , mtl >=2.3.1 && <2.4
   default-language: Haskell2010
@@ -61,6 +63,9 @@ test-suite hamming-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Hamming.App.Widgets.InternalSpec
+      Hamming.App.WidgetsSpec
+      Hamming.AppSpec
       Hamming.Word16Spec
       HammingSpec
       Paths_hamming
@@ -74,6 +79,7 @@ test-suite hamming-test
     , brick >=2.1.1 && <2.2
     , hamming
     , hspec >=2.11.9 && <2.12
+    , microlens >=0.4.13.1 && <0.5
     , microlens-th >=0.4.3.15 && <0.5
     , mtl >=2.3.1 && <2.4
   default-language: Haskell2010

package.yaml

@@ -21,6 +21,7 @@ description:         Please see the README on GitHub at <https://github.com/gith
 dependencies:
 - base >= 4.7 && < 5
 - brick >= 2.1.1 && < 2.2
+- microlens >= 0.4.13.1 && < 0.5
 - microlens-th >= 0.4.3.15 && < 0.5
 - mtl >= 2.3.1 && < 2.4
 

src/Hamming/App/Widgets.hs

@@ -44,7 +44,7 @@ hammingW = withAttr (attrName "hamming")
       . map
         ( \(ns, v) -> foldr
           (withAttr . attrName)
-          (str v)
+          (str [v])
           ns
         )
     )

src/Hamming/App/Widgets/Internal.hs

@@ -26,9 +26,43 @@ License along with this program.  If not, see
 
 module Hamming.App.Widgets.Internal (hammingW') where
 
+import Data.Bits ((.&.))
+import Lens.Micro (_2, (^.), (%~))
+
 import Hamming.App.Types
 
-hammingW' :: AppState -> [[([String], String)]]
+hammingW' :: AppState -> [[([String], Char)]]
-hammingW' = undefined
+hammingW' state = let
+  code = state^.hammingCode
+  in map
+  ( map
+    ( _2 %~
+      ( \mask -> if code .&. mask == 0
+        then '0'
+        else '1'
+      )
+    )
+  )
+  [ [ ( ["zero", "check"], 0x0001 )
+    , ( ["check"],         0x0002 )
+    , ( ["check"],         0x0004 )
+    , ( [],                0x0008 )
+    ]
+  , [ ( ["check"],         0x0010 )
+    , ( [],                0x0020 )
+    , ( [],                0x0040 )
+    , ( [],                0x0080 )
+    ]
+  , [ ( ["check"],         0x0100 )
+    , ( [],                0x0200 )
+    , ( [],                0x0400 )
+    , ( [],                0x0800 )
+    ]
+  , [ ( [],                0x1000 )
+    , ( [],                0x2000 )
+    , ( [],                0x4000 )
+    , ( [],                0x8000 )
+    ]
+  ]
 
 --jl

test/Hamming/App/Widgets/InternalSpec.hs

@@ -0,0 +1,225 @@
+{-
+
+hamming
+Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this program.  If not, see
+<https://www.gnu.org/licenses/>.
+
+-}
+
+module Hamming.App.Widgets.InternalSpec (spec) where
+
+import Lens.Micro ((&), (.~))
+
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Hamming.App
+import Hamming.App.Types
+import Hamming.App.Widgets.Internal
+
+spec :: Spec
+spec = describe "Internal"
+  hammingW'Spec
+
+hammingW'Spec :: Spec
+hammingW'Spec = describe "hammingW'" $ mapM_
+  ( \(desc, state, expRes) -> context desc $ do
+    let actRes = hammingW' state
+    context "number of rows" $
+      it "should be 4" $
+        length actRes `shouldBe` 4
+    mapM_
+      ( \(rowNum, actRow, expRow) ->
+        context ("row " ++ show rowNum) $ do
+          context "number of columns" $
+            it "should be 4" $
+              length actRow `shouldBe` 4
+          mapM_
+            ( \(colNum, actBit, expBit) ->
+              context ("column " ++ show colNum) $
+                it ("should be " ++ show expBit) $
+                  actBit `shouldBe` expBit
+            ) $ zip3 [(0 :: Int)..] actRow expRow
+      ) $ zip3 [(0 :: Int)..] actRes expRes
+  )
+  [ ( "all zero",  mkState 0,      allZero   )
+  , ( "all one",   mkState 0xffff, allOne    )
+  , ( "arbitrary", mkState 0x3c5a, arbitrary )
+  ] where
+  mkState c = initialState & hammingCode .~ c
+  allZero =
+    [ [ ( ["zero", "check"]
+        , '0'
+        )
+      , ( ["check"]
+        , '0'
+        )
+      , ( ["check"]
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      ]
+    , [ ( ["check"]
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      ]
+    , [ ( ["check"]
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      ]
+    , [ ( []
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      ]
+    ]
+  allOne =
+    [ [ ( ["zero", "check"]
+        , '1'
+        )
+      , ( ["check"]
+        , '1'
+        )
+      , ( ["check"]
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      ]
+    , [ ( ["check"]
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      ]
+    , [ ( ["check"]
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      ]
+    , [ ( []
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      ]
+    ]
+  arbitrary =
+    [ [ ( ["zero", "check"]
+        , '0'
+        )
+      , ( ["check"]
+        , '1'
+        )
+      , ( ["check"]
+        , '0'
+        )
+      , ( []
+        , '1'
+        )
+      ]
+    , [ ( ["check"]
+        , '1'
+        )
+      , ( []
+        , '0'
+        )
+      , ( []
+        , '1'
+        )
+      , ( []
+        , '0'
+        )
+      ]
+    , [ ( ["check"]
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      , ( []
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      ]
+    , [ ( []
+        , '1'
+        )
+      , ( []
+        , '1'
+        )
+      , ( []
+        , '0'
+        )
+      , ( []
+        , '0'
+        )
+      ]
+    ]
+
+--jl

test/Hamming/App/WidgetsSpec.hs

@@ -0,0 +1,32 @@
+{-
+
+hamming
+Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this program.  If not, see
+<https://www.gnu.org/licenses/>.
+
+-}
+
+module Hamming.App.WidgetsSpec (spec) where
+
+import Test.Hspec (Spec, describe)
+
+import qualified Hamming.App.Widgets.InternalSpec as Internal
+
+spec :: Spec
+spec = describe "Widgets"
+  Internal.spec
+
+--jl

test/Hamming/AppSpec.hs

@@ -0,0 +1,32 @@
+{-
+
+hamming
+Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this program.  If not, see
+<https://www.gnu.org/licenses/>.
+
+-}
+
+module Hamming.AppSpec (spec) where
+
+import Test.Hspec (Spec, describe)
+
+import qualified Hamming.App.WidgetsSpec as Widgets
+
+spec :: Spec
+spec = describe "App"
+  Widgets.spec
+
+--jl

test/HammingSpec.hs

@@ -23,10 +23,12 @@ module HammingSpec (spec) where
 
 import Test.Hspec (Spec, describe)
 
+import qualified Hamming.AppSpec as App
 import qualified Hamming.Word16Spec as Word16
 
 spec :: Spec
-spec = describe "Hamming"
+spec = describe "Hamming" $ do
   Word16.spec
+  App.spec
 
 --jl