jlamothe/hamming
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

put margins on Hamming widget

This commit is contained in:
Jonathan Lamothe 2024-07-20 16:27:41 -04:00
parent 1565c1fe99
commit 7531cf192f
2 changed files with 119 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Hamming/App/Widgets/Internal.hs
View File

@ -24,6 +24,8 @@ License along with this program. If not, see
|-}
{-# LANGUAGE TupleSections #-}
module Hamming.App.Widgets.Internal (hammingW') where
import Data.Bits ((.&.))
@ -33,6 +35,15 @@ import Hamming.App.Types
hammingW' :: AppState -> [[([String], Char)]]
hammingW' state = let
header = ([], ' ') : map (["margin"],) ['0'..'3']
body = hammingBody state
in header : zipWith
(\n row -> (["margin"], n) : row)
['0'..'3']
body
hammingBody :: AppState -> [[([String], Char)]]
hammingBody state = let
code = state^.hammingCode
in map
( map

127
test/Hamming/App/Widgets/InternalSpec.hs
View File

@ -36,16 +36,21 @@ spec = describe "Internal"
hammingW'Spec :: Spec
hammingW'Spec = describe "hammingW'" $ mapM_
( \(desc, state, expRes) -> context desc $ do
let actRes = hammingW' state
let
actRes = hammingW' state
numActRows = length actRes
numExpRows = length expRes
context "number of rows" $
it "should be 4" $
length actRes `shouldBe` 4
it ("should be " ++ show numExpRows) $
numActRows `shouldBe` numExpRows
mapM_
( \(rowNum, actRow, expRow) ->
context ("row " ++ show rowNum) $ do
( \(rowNum, actRow, expRow) -> let
numActCols = length actRow
numExpCols = length expRow
in context ("row " ++ show rowNum) $ do
context "number of columns" $
it "should be 4" $
length actRow `shouldBe` 4
it ("should be " ++ show numExpCols) $
numActCols `shouldBe` numExpCols
mapM_
( \(colNum, actBit, expBit) ->
context ("column " ++ show colNum) $
@ -60,7 +65,26 @@ hammingW'Spec = describe "hammingW'" $ mapM_
] where
mkState c = initialState & hammingCode .~ c
allZero =
[ [ ( ["zero", "check"]
[ [ ( []
, ' '
)
, ( ["margin"]
, '0'
)
, ( ["margin"]
, '1'
)
, ( ["margin"]
, '2'
)
, ( ["margin"]
, '3'
)
]
, [ ( ["margin"]
, '0'
)
, ( ["zero", "check"]
, '0'
)
, ( ["check"]
@ -73,7 +97,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, '0'
)
]
, [ ( ["check"]
, [ ( ["margin"]
, '1'
)
, ( ["check"]
, '0'
)
, ( []
@ -86,7 +113,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, '0'
)
]
, [ ( ["check"]
, [ ( ["margin"]
, '2'
)
, ( ["check"]
, '0'
)
, ( []
@ -99,7 +129,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, '0'
)
]
, [ ( []
, [ ( ["margin"]
, '3'
)
, ( []
, '0'
)
, ( []
@ -114,7 +147,26 @@ hammingW'Spec = describe "hammingW'" $ mapM_
]
]
allOne =
[ [ ( ["zero", "check"]
[ [ ( []
, ' '
)
, ( ["margin"]
, '0'
)
, ( ["margin"]
, '1'
)
, ( ["margin"]
, '2'
)
, ( ["margin"]
, '3'
)
]
, [ ( ["margin"]
, '0'
)
, ( ["zero", "check"]
, '1'
)
, ( ["check"]
@ -127,7 +179,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, '1'
)
]
, [ ( ["check"]
, [ ( ["margin"]
, '1'
)
, ( ["check"]
, '1'
)
, ( []
@ -140,7 +195,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, '1'
)
]
, [ ( ["check"]
, [ ( ["margin"]
, '2'
)
, ( ["check"]
, '1'
)
, ( []
@ -153,7 +211,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, '1'
)
]
, [ ( []
, [ ( ["margin"]
, '3'
)
, ( []
, '1'
)
, ( []
@ -168,7 +229,26 @@ hammingW'Spec = describe "hammingW'" $ mapM_
]
]
arbitrary =
[ [ ( ["zero", "check"]
[ [ ( []
, ' '
)
, ( ["margin"]
, '0'
)
, ( ["margin"]
, '1'
)
, ( ["margin"]
, '2'
)
, ( ["margin"]
, '3'
)
]
, [ ( ["margin"]
, '0'
)
, ( ["zero", "check"]
, '0'
)
, ( ["check"]
@ -181,7 +261,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, '1'
)
]
, [ ( ["check"]
, [ ( ["margin"]
, '1'
)
, ( ["check"]
, '1'
)
, ( []
@ -194,7 +277,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, '0'
)
]
, [ ( ["check"]
, [ ( ["margin"]
, '2'
)
, ( ["check"]
, '0'
)
, ( []
@ -207,7 +293,10 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, '1'
)
]
, [ ( []
, [ ( ["margin"]
, '3'
)
, ( []
, '1'
)
, ( []