From af26fcedd86f0628e77c8be33af188fc7f800d34 Mon Sep 17 00:00:00 2001
From: Jonathan Lamothe <jonathan@jlamothe.net>
Date: Sun, 30 Jun 2024 08:57:13 -0400
Subject: [PATCH] implemented calculation of check bits for Word16

---
 hamming.cabal              |  2 ++
 src/Hamming.hs             | 39 +++++++++++++++++++++-
 test/Hamming/Word16Spec.hs | 66 ++++++++++++++++++++++++++++++++++++++
 test/HammingSpec.hs        | 32 ++++++++++++++++++
 test/Spec.hs               |  4 ++-
 5 files changed, 141 insertions(+), 2 deletions(-)
 create mode 100644 test/Hamming/Word16Spec.hs
 create mode 100644 test/HammingSpec.hs

diff --git a/hamming.cabal b/hamming.cabal
index ac05220..a0dfff1 100644
--- a/hamming.cabal
+++ b/hamming.cabal
@@ -51,6 +51,8 @@ test-suite hamming-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Hamming.Word16Spec
+      HammingSpec
       Paths_hamming
   autogen-modules:
       Paths_hamming
diff --git a/src/Hamming.hs b/src/Hamming.hs
index bb6d846..cf7d669 100644
--- a/src/Hamming.hs
+++ b/src/Hamming.hs
@@ -24,6 +24,43 @@ License along with this program.  If not, see
 
 |-}
 
-module Hamming () where
+module Hamming (Hamming (..)) where
+
+import Data.Bits (Bits, complement, shiftR, (.&.), (.|.))
+import Data.Word (Word16)
+
+-- | An implementation of a Hamming code
+class Hamming h where
+  -- | Sets the check bits (overwriting previous values)
+  setCheckBits :: h -> h
+  -- | Determines whether or not the code is valid
+  isValid :: h -> Bool
+  -- | Attempts to correct a single bit error
+  correctErrors :: h -> Maybe h
+
+instance Hamming Word16 where
+  setCheckBits c = foldl setCheckBit c
+    [ ( 0x0002, 0xaaa8 )
+    , ( 0x0004, 0xccc8 )
+    , ( 0x0010, 0xf0e0 )
+    , ( 0x0100, 0xfe00 )
+    , ( 0x0001, 0xfffe )
+    ]
+
+  isValid = undefined
+  correctErrors = undefined
+
+setCheckBit :: (Num a, Bits a) => a -> (a, a) -> a
+setCheckBit a (pBit, chkMask) =
+  if oddParity (a .&. chkMask)
+    then a .|. pBit
+    else a .&. complement pBit
+
+oddParity :: (Bits a, Num a) => a -> Bool
+oddParity = f False where
+  f p x
+    | x == 0       = p
+    | x .&. 1 == 1 = f (not p) (shiftR x 1)
+    | otherwise    = f p (shiftR x 1)
 
 --jl
diff --git a/test/Hamming/Word16Spec.hs b/test/Hamming/Word16Spec.hs
new file mode 100644
index 0000000..cfbffd1
--- /dev/null
+++ b/test/Hamming/Word16Spec.hs
@@ -0,0 +1,66 @@
+{-
+
+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.Word16Spec (spec) where
+
+import Data.Word (Word16)
+
+import Hamming
+
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+spec :: Spec
+spec = describe "Word16" $ do
+  setCheckBitsSpec
+  isValidSpec
+  correctErrorsSpec
+
+setCheckBitsSpec :: Spec
+setCheckBitsSpec = describe "setCheckBits" $ mapM_
+  ( \(desc, code, expected) -> context desc $ let
+    actual = setCheckBits code
+    in it ("should be " ++ show expected) $
+      actual `shouldBe` expected
+  )
+  [ ( "all zeroes",     0,          0           )
+  , ( "all ones",       0xffff,     0xffff      )
+  , ( "no check bits",  noChkBits,  withChkBits )
+  , ( "bad check bits", badChkBits, withChkBits )
+  ]
+
+isValidSpec :: Spec
+isValidSpec = describe "isValid" $
+  return ()
+
+correctErrorsSpec :: Spec
+correctErrorsSpec = describe "correctErrors" $
+  return ()
+
+noChkBits :: Word16
+noChkBits = 0x34c0
+
+withChkBits :: Word16
+withChkBits = 0x35c5
+
+badChkBits :: Word16
+badChkBits = 0x34d2
+
+--jl
diff --git a/test/HammingSpec.hs b/test/HammingSpec.hs
new file mode 100644
index 0000000..05c1a3f
--- /dev/null
+++ b/test/HammingSpec.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 HammingSpec (spec) where
+
+import Test.Hspec (Spec, describe)
+
+import qualified Hamming.Word16Spec as Word16
+
+spec :: Spec
+spec = describe "Hamming"
+  Word16.spec
+
+--jl
diff --git a/test/Spec.hs b/test/Spec.hs
index 242ab19..a080c95 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -21,7 +21,9 @@ License along with this program.  If not, see
 
 import Test.Hspec (hspec)
 
+import qualified HammingSpec as Hamming
+
 main :: IO ()
-main = hspec $ return ()
+main = hspec Hamming.spec
 
 --jl