implemented bit flipping

src/Hamming/App/Actions.hs

@@ -1,7 +1,7 @@
 {-|
 
 Module      : Hamming.App.Actions
-Description : Utilities for working with Hamming codes
+Description : Functions that transform the application state
 Copyright   : (C) Jonathan Lamothe
 License     : AGPL-3.0-or-later
 Maintainer  : jonathan@jlamothe.net
@@ -25,15 +25,20 @@ License along with this program.  If not, see
 |-}
 
 module Hamming.App.Actions (
+  -- * Cursor Movement
   moveUp,
   moveDown,
   moveLeft,
-  moveRight
+  moveRight,
+  -- * Other Edits
+  flipBit,
   ) where
 
-import Lens.Micro ((%~))
+import Data.Bits (xor)
+import Lens.Micro ((^.), (&), (%~))
 
 import Hamming.App.Types
+import Hamming.App.Util
 
 moveUp :: EditState -> EditState
 moveUp = rowNum %~
@@ -63,4 +68,9 @@ moveRight = colNum %~
     else 3
   )
 
+flipBit :: AppState -> AppState
+flipBit s = case s^.appMode of
+  EditMode es -> s & hammingCode %~ xor (bitmask es)
+  _           -> s
+
 --jl

src/Hamming/App/Events.hs

@@ -1,7 +1,7 @@
 {-|
 
 Module      : Hamming.App.Events
-Description : Utilities for working with Hamming codes
+Description : Main event handler functions
 Copyright   : (C) Jonathan Lamothe
 License     : AGPL-3.0-or-later
 Maintainer  : jonathan@jlamothe.net
@@ -72,6 +72,8 @@ editHandler (VtyEvent (EvKey KRight [])) =
   modify $ appMode.editState %~ moveRight
 editHandler (VtyEvent (EvKey (KChar 'l') [])) =
   modify $ appMode.editState %~ moveRight
+editHandler (VtyEvent (EvKey (KChar 'f') [])) =
+  modify flipBit
 editHandler _ = return ()
 
 --jl

src/Hamming/App/Util.hs

@@ -27,13 +27,19 @@ considered subject to change at any time.
 
 |-}
 
-module Hamming.App.Util (getLocation) where
+module Hamming.App.Util (bitmask, getLocation) where
 
 import Brick.Types (Location (..))
+import Data.Bits (shiftL)
+import Data.Word (Word16)
 import Lens.Micro ((^.))
 
 import Hamming.App.Types
 
+-- | Returns the mask for the currently selected bit
+bitmask :: EditState -> Word16
+bitmask s = shiftL 1 $ s^.rowNum * 4 + s^.colNum
+
 -- | Gets the location of the edit cursor (if available)
 getLocation :: AppState -> Maybe Location
 getLocation s = case s^.appMode of

test/Hamming/App/ActionsSpec.hs

@@ -33,6 +33,7 @@ spec = describe "Actions" $ do
   moveDownSpec
   moveLeftSpec
   moveRightSpec
+  flipBitSpec
 
 moveUpSpec :: Spec
 moveUpSpec = describe "moveUp" $ mapM_
@@ -102,4 +103,23 @@ moveRightSpec = describe "moveRight" $ mapM_
     & rowNum .~ 1
     & colNum .~ 2
 
+flipBitSpec :: Spec
+flipBitSpec = describe "flipBit" $ mapM_
+  ( \(desc, state, expected) -> context desc $ let
+    actual = flipBit state
+    in it ("should be " ++ show expected) $
+      actual `shouldBe` expected
+  )
+  [ ( "turn on",       unflipped, flipped   )
+  , ( "turn off",      flipped,   unflipped )
+  , ( "non-edit mode", nonEdit,   nonEdit   )
+  ] where
+  nonEdit = initialState & hammingCode .~ 0x3c5a
+  unflipped = nonEdit & appMode .~ EditMode
+    ( initialEditor
+    & rowNum .~ 1
+    & colNum .~ 3
+    )
+  flipped = unflipped & hammingCode .~ 0x3cda
+
 --jl

test/Hamming/App/UtilSpec.hs

@@ -29,8 +29,9 @@ import Hamming.App.Types
 import Hamming.App.Util
 
 spec :: Spec
-spec = describe "Util"
+spec = describe "Util" $ do
   getLocationSpec
+  bitmaskSpec
 
 getLocationSpec :: Spec
 getLocationSpec = describe "getLocation" $ mapM_
@@ -50,4 +51,14 @@ getLocationSpec = describe "getLocation" $ mapM_
       )
     l = Location (4, 3)
 
+bitmaskSpec :: Spec
+bitmaskSpec = describe "bitmask" $ let
+  s = initialEditor
+    & rowNum .~ 1
+    & colNum .~ 2
+  actual = bitmask s
+  expected = 0x0040
+  in it ("should be " ++ show expected) $
+    actual `shouldBe` expected
+
 --jl