From ed405e366e8830655a7314c59357448cd751f4ec Mon Sep 17 00:00:00 2001
From: Jonathan Lamothe <jonathan@jlamothe.net>
Date: Sat, 6 Jul 2024 20:37:07 -0400
Subject: [PATCH] find and correct single bit errors in 16-bit hamming codes

---
 src/Hamming.hs             | 24 ++++++++++++++++++++++--
 test/Hamming/Word16Spec.hs | 18 ++++++++++++++++--
 2 files changed, 38 insertions(+), 4 deletions(-)

diff --git a/src/Hamming.hs b/src/Hamming.hs
index e660151..b92fac3 100644
--- a/src/Hamming.hs
+++ b/src/Hamming.hs
@@ -26,7 +26,15 @@ License along with this program.  If not, see
 
 module Hamming (Hamming (..)) where
 
-import Data.Bits (Bits, complement, shiftR, (.&.), (.|.))
+import Data.Bits
+  ( Bits
+  , complement
+  , shiftL
+  , shiftR
+  , xor
+  , (.&.)
+  , (.|.)
+  )
 import Data.Word (Word16)
 
 -- | An implementation of a Hamming code
@@ -55,7 +63,19 @@ instance Hamming Word16 where
     , 0xffff
     ]
 
-  correctErrors = undefined
+  correctErrors c
+    | isValid c = Just c
+    | otherwise = let
+      errorFlags = map (oddParity . (c .&.))
+        [0xaaaa, 0xcccc, 0xf0f0, 0xff00]
+      flipAddr = foldl
+        ( \a (mask, err) -> if err
+          then let
+            in a .|. mask
+          else a
+        ) 0 $ zip [1, 2, 4, 8] errorFlags
+      flipBit = 1 `shiftL` flipAddr
+      in Just $ c `xor` flipBit
 
 setCheckBit :: (Num a, Bits a) => a -> (a, a) -> a
 setCheckBit a (pBit, chkMask) =
diff --git a/test/Hamming/Word16Spec.hs b/test/Hamming/Word16Spec.hs
index f612ec5..56e0b18 100644
--- a/test/Hamming/Word16Spec.hs
+++ b/test/Hamming/Word16Spec.hs
@@ -21,6 +21,7 @@ License along with this program.  If not, see
 
 module Hamming.Word16Spec (spec) where
 
+import Data.Bits (shiftL, xor)
 import Data.Word (Word16)
 
 import Hamming
@@ -61,8 +62,21 @@ isValidSpec = describe "isValid" $ mapM_
   ]
 
 correctErrorsSpec :: Spec
-correctErrorsSpec = describe "correctErrors" $
-  return ()
+correctErrorsSpec = describe "correctErrors" $ mapM_
+  ( \(desc, code, expected) -> context desc $ let
+    actual = correctErrors code
+    in it ("should be " ++ show expected) $
+      actual `shouldBe` expected
+  ) $ ("valid", withChkBits, Just withChkBits) :
+  singleBitErrors
+
+singleBitErrors :: [(String, Word16, Maybe Word16)]
+singleBitErrors = map
+  ( \bit -> let
+    mask = 1 `shiftL` bit
+    code = withChkBits `xor` mask
+    in ("bad bit " ++ show bit, code, Just withChkBits)
+  ) [0..15]
 
 noChkBits :: Word16
 noChkBits = 0x34c0