put margins on Hamming widget
This commit is contained in:
parent
1565c1fe99
commit
7531cf192f
|
@ -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
|
||||
|
|
|
@ -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'
|
||||
)
|
||||
, ( []
|
||||
|
|
Loading…
Reference in New Issue
Block a user