From ef23b6768830391bc7820c6514cd1261a808c127 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Fri, 19 Jul 2024 20:50:33 -0400 Subject: [PATCH] build hamming code display widget --- hamming.cabal | 6 + package.yaml | 1 + src/Hamming/App/Widgets.hs | 2 +- src/Hamming/App/Widgets/Internal.hs | 38 +++- test/Hamming/App/Widgets/InternalSpec.hs | 225 +++++++++++++++++++++++ test/Hamming/App/WidgetsSpec.hs | 32 ++++ test/Hamming/AppSpec.hs | 32 ++++ test/HammingSpec.hs | 4 +- 8 files changed, 336 insertions(+), 4 deletions(-) create mode 100644 test/Hamming/App/Widgets/InternalSpec.hs create mode 100644 test/Hamming/App/WidgetsSpec.hs create mode 100644 test/Hamming/AppSpec.hs diff --git a/hamming.cabal b/hamming.cabal index 40d4dd4..ccf8de5 100644 --- a/hamming.cabal +++ b/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 diff --git a/package.yaml b/package.yaml index f3b1e3f..799a30b 100644 --- a/package.yaml +++ b/package.yaml @@ -21,6 +21,7 @@ description: Please see the README on GitHub at = 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 diff --git a/src/Hamming/App/Widgets.hs b/src/Hamming/App/Widgets.hs index 985489f..972e5f6 100644 --- a/src/Hamming/App/Widgets.hs +++ b/src/Hamming/App/Widgets.hs @@ -44,7 +44,7 @@ hammingW = withAttr (attrName "hamming") . map ( \(ns, v) -> foldr (withAttr . attrName) - (str v) + (str [v]) ns ) ) diff --git a/src/Hamming/App/Widgets/Internal.hs b/src/Hamming/App/Widgets/Internal.hs index d05fe02..acdd7a2 100644 --- a/src/Hamming/App/Widgets/Internal.hs +++ b/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' = undefined +hammingW' :: AppState -> [[([String], Char)]] +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 diff --git a/test/Hamming/App/Widgets/InternalSpec.hs b/test/Hamming/App/Widgets/InternalSpec.hs new file mode 100644 index 0000000..29b1210 --- /dev/null +++ b/test/Hamming/App/Widgets/InternalSpec.hs @@ -0,0 +1,225 @@ +{- + +hamming +Copyright (C) Jonathan Lamothe + +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 +. + +-} + +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 diff --git a/test/Hamming/App/WidgetsSpec.hs b/test/Hamming/App/WidgetsSpec.hs new file mode 100644 index 0000000..41021e5 --- /dev/null +++ b/test/Hamming/App/WidgetsSpec.hs @@ -0,0 +1,32 @@ +{- + +hamming +Copyright (C) Jonathan Lamothe + +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 +. + +-} + +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 diff --git a/test/Hamming/AppSpec.hs b/test/Hamming/AppSpec.hs new file mode 100644 index 0000000..74747af --- /dev/null +++ b/test/Hamming/AppSpec.hs @@ -0,0 +1,32 @@ +{- + +hamming +Copyright (C) Jonathan Lamothe + +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 +. + +-} + +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 diff --git a/test/HammingSpec.hs b/test/HammingSpec.hs index 05c1a3f..72e197d 100644 --- a/test/HammingSpec.hs +++ b/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