2024-07-19 20:50:33 -04:00
|
|
|
{-
|
|
|
|
|
|
|
|
hamming
|
|
|
|
Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
|
|
|
|
|
|
|
|
This program is free software: you can redistribute it and/or modify
|
|
|
|
it under the terms of the GNU Affero General Public License as
|
|
|
|
published by the Free Software Foundation, either version 3 of the
|
|
|
|
License, or (at your option) any later version.
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, but
|
|
|
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
|
Affero General Public License for more details.
|
|
|
|
|
|
|
|
You should have received a copy of the GNU Affero General Public
|
|
|
|
License along with this program. If not, see
|
|
|
|
<https://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Hamming.App.Widgets.InternalSpec (spec) where
|
|
|
|
|
|
|
|
import Lens.Micro ((&), (.~))
|
|
|
|
|
|
|
|
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
|
|
|
|
|
|
|
import Hamming.App
|
|
|
|
import Hamming.App.Types
|
|
|
|
import Hamming.App.Widgets.Internal
|
|
|
|
|
|
|
|
spec :: Spec
|
|
|
|
spec = describe "Internal"
|
|
|
|
hammingW'Spec
|
|
|
|
|
|
|
|
hammingW'Spec :: Spec
|
|
|
|
hammingW'Spec = describe "hammingW'" $ mapM_
|
|
|
|
( \(desc, state, expRes) -> context desc $ do
|
2024-07-20 16:27:41 -04:00
|
|
|
let
|
|
|
|
actRes = hammingW' state
|
|
|
|
numActRows = length actRes
|
|
|
|
numExpRows = length expRes
|
2024-07-19 20:50:33 -04:00
|
|
|
context "number of rows" $
|
2024-07-20 16:27:41 -04:00
|
|
|
it ("should be " ++ show numExpRows) $
|
|
|
|
numActRows `shouldBe` numExpRows
|
2024-07-19 20:50:33 -04:00
|
|
|
mapM_
|
2024-07-20 16:27:41 -04:00
|
|
|
( \(rowNum, actRow, expRow) -> let
|
|
|
|
numActCols = length actRow
|
|
|
|
numExpCols = length expRow
|
|
|
|
in context ("row " ++ show rowNum) $ do
|
2024-07-19 20:50:33 -04:00
|
|
|
context "number of columns" $
|
2024-07-20 16:27:41 -04:00
|
|
|
it ("should be " ++ show numExpCols) $
|
|
|
|
numActCols `shouldBe` numExpCols
|
2024-07-19 20:50:33 -04:00
|
|
|
mapM_
|
|
|
|
( \(colNum, actBit, expBit) ->
|
|
|
|
context ("column " ++ show colNum) $
|
|
|
|
it ("should be " ++ show expBit) $
|
|
|
|
actBit `shouldBe` expBit
|
|
|
|
) $ zip3 [(0 :: Int)..] actRow expRow
|
|
|
|
) $ zip3 [(0 :: Int)..] actRes expRes
|
|
|
|
)
|
|
|
|
[ ( "all zero", mkState 0, allZero )
|
|
|
|
, ( "all one", mkState 0xffff, allOne )
|
|
|
|
, ( "arbitrary", mkState 0x3c5a, arbitrary )
|
|
|
|
] where
|
|
|
|
mkState c = initialState & hammingCode .~ c
|
|
|
|
allZero =
|
2024-07-20 16:27:41 -04:00
|
|
|
[ [ ( []
|
|
|
|
, ' '
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '2'
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '3'
|
|
|
|
)
|
|
|
|
]
|
|
|
|
, [ ( ["margin"]
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( ["zero", "check"]
|
2024-07-19 20:50:33 -04:00
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
]
|
2024-07-20 16:27:41 -04:00
|
|
|
, [ ( ["margin"]
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
2024-07-19 20:50:33 -04:00
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
]
|
2024-07-20 16:27:41 -04:00
|
|
|
, [ ( ["margin"]
|
|
|
|
, '2'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
2024-07-19 20:50:33 -04:00
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
]
|
2024-07-20 16:27:41 -04:00
|
|
|
, [ ( ["margin"]
|
|
|
|
, '3'
|
|
|
|
)
|
|
|
|
, ( []
|
2024-07-19 20:50:33 -04:00
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
]
|
|
|
|
]
|
|
|
|
allOne =
|
2024-07-20 16:27:41 -04:00
|
|
|
[ [ ( []
|
|
|
|
, ' '
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '2'
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '3'
|
|
|
|
)
|
|
|
|
]
|
|
|
|
, [ ( ["margin"]
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( ["zero", "check"]
|
2024-07-19 20:50:33 -04:00
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
]
|
2024-07-20 16:27:41 -04:00
|
|
|
, [ ( ["margin"]
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
2024-07-19 20:50:33 -04:00
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
]
|
2024-07-20 16:27:41 -04:00
|
|
|
, [ ( ["margin"]
|
|
|
|
, '2'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
2024-07-19 20:50:33 -04:00
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
]
|
2024-07-20 16:27:41 -04:00
|
|
|
, [ ( ["margin"]
|
|
|
|
, '3'
|
|
|
|
)
|
|
|
|
, ( []
|
2024-07-19 20:50:33 -04:00
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
]
|
|
|
|
]
|
|
|
|
arbitrary =
|
2024-07-20 16:27:41 -04:00
|
|
|
[ [ ( []
|
|
|
|
, ' '
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '2'
|
|
|
|
)
|
|
|
|
, ( ["margin"]
|
|
|
|
, '3'
|
|
|
|
)
|
|
|
|
]
|
|
|
|
, [ ( ["margin"]
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( ["zero", "check"]
|
2024-07-19 20:50:33 -04:00
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
]
|
2024-07-20 16:27:41 -04:00
|
|
|
, [ ( ["margin"]
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
2024-07-19 20:50:33 -04:00
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
]
|
2024-07-20 16:27:41 -04:00
|
|
|
, [ ( ["margin"]
|
|
|
|
, '2'
|
|
|
|
)
|
|
|
|
, ( ["check"]
|
2024-07-19 20:50:33 -04:00
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
]
|
2024-07-20 16:27:41 -04:00
|
|
|
, [ ( ["margin"]
|
|
|
|
, '3'
|
|
|
|
)
|
|
|
|
, ( []
|
2024-07-19 20:50:33 -04:00
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '1'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
, ( []
|
|
|
|
, '0'
|
|
|
|
)
|
|
|
|
]
|
|
|
|
]
|
|
|
|
|
|
|
|
--jl
|