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

fixed hamming code attribute names

This commit is contained in:
Jonathan Lamothe 2024-07-31 18:22:12 -04:00
parent 36bc32a688
commit 633a1b7b24
3 changed files with 93 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Hamming/App/Widgets.hs
View File

@ -30,6 +30,7 @@ module Hamming.App.Widgets (
-- ** Attribute Names -- ** Attribute Names
hammingAttr, hammingAttr,
marginAttr, marginAttr,
bodyAttr,
checkAttr, checkAttr,
zeroAttr, zeroAttr,
) where ) where

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

@ -35,6 +35,7 @@ module Hamming.App.Widgets.Internal (
-- ** Attribute Names -- ** Attribute Names
hammingAttr, hammingAttr,
marginAttr, marginAttr,
bodyAttr,
checkAttr, checkAttr,
zeroAttr, zeroAttr,
) where ) where
@ -48,7 +49,7 @@ import Hamming.App.Types
hammingW' :: AppState -> [[(AttrName, Char)]] hammingW' :: AppState -> [[(AttrName, Char)]]
hammingW' state = let hammingW' state = let
header = (mempty, ' ') : map (marginAttr,) ['0'..'3'] header = (hammingAttr, ' ') : map (marginAttr,) ['0'..'3']
body = hammingBody state body = hammingBody state
in header : zipWith in header : zipWith
(\n row -> (marginAttr, n) : row) (\n row -> (marginAttr, n) : row)
@ -61,8 +62,11 @@ hammingAttr = attrName "hamming"
marginAttr :: AttrName marginAttr :: AttrName
marginAttr = hammingAttr <> attrName "margin" marginAttr = hammingAttr <> attrName "margin"
bodyAttr :: AttrName
bodyAttr = hammingAttr <> attrName "body"
checkAttr :: AttrName checkAttr :: AttrName
checkAttr = hammingAttr <> attrName "check" checkAttr = bodyAttr <> attrName "check"
zeroAttr :: AttrName zeroAttr :: AttrName
zeroAttr = checkAttr <> attrName "zero" zeroAttr = checkAttr <> attrName "zero"
@ -82,22 +86,22 @@ hammingBody state = let
[ [ ( zeroAttr, 0x0001 ) [ [ ( zeroAttr, 0x0001 )
, ( checkAttr, 0x0002 ) , ( checkAttr, 0x0002 )
, ( checkAttr, 0x0004 ) , ( checkAttr, 0x0004 )
, ( mempty, 0x0008 ) , ( bodyAttr, 0x0008 )
] ]
, [ ( checkAttr, 0x0010 ) , [ ( checkAttr, 0x0010 )
, ( mempty, 0x0020 ) , ( bodyAttr, 0x0020 )
, ( mempty, 0x0040 ) , ( bodyAttr, 0x0040 )
, ( mempty, 0x0080 ) , ( bodyAttr, 0x0080 )
] ]
, [ ( checkAttr, 0x0100 ) , [ ( checkAttr, 0x0100 )
, ( mempty, 0x0200 ) , ( bodyAttr, 0x0200 )
, ( mempty, 0x0400 ) , ( bodyAttr, 0x0400 )
, ( mempty, 0x0800 ) , ( bodyAttr, 0x0800 )
] ]
, [ ( mempty, 0x1000 ) , [ ( bodyAttr, 0x1000 )
, ( mempty, 0x2000 ) , ( bodyAttr, 0x2000 )
, ( mempty, 0x4000 ) , ( bodyAttr, 0x4000 )
, ( mempty, 0x8000 ) , ( bodyAttr, 0x8000 )
] ]
] ]

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

@ -65,7 +65,7 @@ hammingW'Spec = describe "hammingW'" $ mapM_
] where ] where
mkState c = initialState & hammingCode .~ c mkState c = initialState & hammingCode .~ c
allZero = allZero =
[ [ ( mempty, ' ' ) [ [ ( hammingAttr, ' ' )
, ( marginAttr, '0' ) , ( marginAttr, '0' )
, ( marginAttr, '1' ) , ( marginAttr, '1' )
, ( marginAttr, '2' ) , ( marginAttr, '2' )
@ -75,29 +75,29 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, ( zeroAttr, '0' ) , ( zeroAttr, '0' )
, ( checkAttr, '0' ) , ( checkAttr, '0' )
, ( checkAttr, '0' ) , ( checkAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
] ]
, [ ( marginAttr, '1' ) , [ ( marginAttr, '1' )
, ( checkAttr, '0' ) , ( checkAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
] ]
, [ ( marginAttr, '2' ) , [ ( marginAttr, '2' )
, ( checkAttr, '0' ) , ( checkAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
] ]
, [ ( marginAttr, '3' ) , [ ( marginAttr, '3' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
] ]
] ]
allOne = allOne =
[ [ ( mempty, ' ' ) [ [ ( hammingAttr, ' ' )
, ( marginAttr, '0' ) , ( marginAttr, '0' )
, ( marginAttr, '1' ) , ( marginAttr, '1' )
, ( marginAttr, '2' ) , ( marginAttr, '2' )
@ -106,30 +106,30 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, [ ( marginAttr, '0' ) , [ ( marginAttr, '0' )
, ( zeroAttr, '1' ) , ( zeroAttr, '1' )
, ( checkAttr, '1' ) , ( checkAttr, '1' )
, ( checkAttr, '1' ) , ( checkAttr , '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
] ]
, [ ( marginAttr, '1' ) , [ ( marginAttr, '1' )
, ( checkAttr, '1' ) , ( checkAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
] ]
, [ ( marginAttr, '2' ) , [ ( marginAttr, '2' )
, ( checkAttr, '1' ) , ( checkAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
] ]
, [ ( marginAttr, '3' ) , [ ( marginAttr, '3' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
] ]
] ]
arbitrary = arbitrary =
[ [ ( mempty, ' ' ) [ [ ( hammingAttr, ' ' )
, ( marginAttr, '0' ) , ( marginAttr, '0' )
, ( marginAttr, '1' ) , ( marginAttr, '1' )
, ( marginAttr, '2' ) , ( marginAttr, '2' )
@ -139,25 +139,25 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, ( zeroAttr, '0' ) , ( zeroAttr, '0' )
, ( checkAttr, '1' ) , ( checkAttr, '1' )
, ( checkAttr, '0' ) , ( checkAttr, '0' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
] ]
, [ ( marginAttr, '1' ) , [ ( marginAttr, '1' )
, ( checkAttr, '1' ) , ( checkAttr, '1' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
] ]
, [ ( marginAttr, '2' ) , [ ( marginAttr, '2' )
, ( checkAttr, '0' ) , ( checkAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
] ]
, [ ( marginAttr, '3' ) , [ ( marginAttr, '3' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '1' ) , ( bodyAttr, '1' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
, ( mempty, '0' ) , ( bodyAttr, '0' )
] ]
] ]