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

build hamming code display widget

This commit is contained in:
Jonathan Lamothe 2024-07-19 20:50:33 -04:00
parent e216432a77
commit ef23b67688
8 changed files with 336 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
hamming.cabal
View File

@ -36,6 +36,7 @@ library
build-depends:
base >=4.7 && <5
, brick >=2.1.1 && <2.2
, microlens >=0.4.13.1 && <0.5
, microlens-th >=0.4.3.15 && <0.5
, mtl >=2.3.1 && <2.4
default-language: Haskell2010
@ -53,6 +54,7 @@ executable hamming
base >=4.7 && <5
, brick >=2.1.1 && <2.2
, hamming
, microlens >=0.4.13.1 && <0.5
, microlens-th >=0.4.3.15 && <0.5
, mtl >=2.3.1 && <2.4
default-language: Haskell2010
@ -61,6 +63,9 @@ test-suite hamming-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Hamming.App.Widgets.InternalSpec
Hamming.App.WidgetsSpec
Hamming.AppSpec
Hamming.Word16Spec
HammingSpec
Paths_hamming
@ -74,6 +79,7 @@ test-suite hamming-test
, brick >=2.1.1 && <2.2
, hamming
, hspec >=2.11.9 && <2.12
, microlens >=0.4.13.1 && <0.5
, microlens-th >=0.4.3.15 && <0.5
, mtl >=2.3.1 && <2.4
default-language: Haskell2010

1
package.yaml
View File

@ -21,6 +21,7 @@ description: Please see the README on GitHub at <https://github.com/gith
dependencies:
- base >= 4.7 && < 5
- brick >= 2.1.1 && < 2.2
- microlens >= 0.4.13.1 && < 0.5
- microlens-th >= 0.4.3.15 && < 0.5
- mtl >= 2.3.1 && < 2.4

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

@ -44,7 +44,7 @@ hammingW = withAttr (attrName "hamming")
. map
( \(ns, v) -> foldr
(withAttr . attrName)
(str v)
(str [v])
ns
)
)

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

@ -26,9 +26,43 @@ License along with this program. If not, see
module Hamming.App.Widgets.Internal (hammingW') where
import Data.Bits ((.&.))
import Lens.Micro (_2, (^.), (%~))
import Hamming.App.Types
hammingW' :: AppState -> [[([String], String)]]
hammingW' = undefined
hammingW' :: AppState -> [[([String], Char)]]
hammingW' state = let
code = state^.hammingCode
in map
( map
( _2 %~
( \mask -> if code .&. mask == 0
then '0'
else '1'
)
)
)
[ [ ( ["zero", "check"], 0x0001 )
, ( ["check"], 0x0002 )
, ( ["check"], 0x0004 )
, ( [], 0x0008 )
]
, [ ( ["check"], 0x0010 )
, ( [], 0x0020 )
, ( [], 0x0040 )
, ( [], 0x0080 )
]
, [ ( ["check"], 0x0100 )
, ( [], 0x0200 )
, ( [], 0x0400 )
, ( [], 0x0800 )
]
, [ ( [], 0x1000 )
, ( [], 0x2000 )
, ( [], 0x4000 )
, ( [], 0x8000 )
]
]
--jl

225
test/Hamming/App/Widgets/InternalSpec.hs Normal file
View File

@ -0,0 +1,225 @@
{-
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
let actRes = hammingW' state
context "number of rows" $
it "should be 4" $
length actRes `shouldBe` 4
mapM_
( \(rowNum, actRow, expRow) ->
context ("row " ++ show rowNum) $ do
context "number of columns" $
it "should be 4" $
length actRow `shouldBe` 4
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 =
[ [ ( ["zero", "check"]
, '0'
)
, ( ["check"]
, '0'
)
, ( ["check"]
, '0'
)
, ( []
, '0'
)
]
, [ ( ["check"]
, '0'
)
, ( []
, '0'
)
, ( []
, '0'
)
, ( []
, '0'
)
]
, [ ( ["check"]
, '0'
)
, ( []
, '0'
)
, ( []
, '0'
)
, ( []
, '0'
)
]
, [ ( []
, '0'
)
, ( []
, '0'
)
, ( []
, '0'
)
, ( []
, '0'
)
]
]
allOne =
[ [ ( ["zero", "check"]
, '1'
)
, ( ["check"]
, '1'
)
, ( ["check"]
, '1'
)
, ( []
, '1'
)
]
, [ ( ["check"]
, '1'
)
, ( []
, '1'
)
, ( []
, '1'
)
, ( []
, '1'
)
]
, [ ( ["check"]
, '1'
)
, ( []
, '1'
)
, ( []
, '1'
)
, ( []
, '1'
)
]
, [ ( []
, '1'
)
, ( []
, '1'
)
, ( []
, '1'
)
, ( []
, '1'
)
]
]
arbitrary =
[ [ ( ["zero", "check"]
, '0'
)
, ( ["check"]
, '1'
)
, ( ["check"]
, '0'
)
, ( []
, '1'
)
]
, [ ( ["check"]
, '1'
)
, ( []
, '0'
)
, ( []
, '1'
)
, ( []
, '0'
)
]
, [ ( ["check"]
, '0'
)
, ( []
, '0'
)
, ( []
, '1'
)
, ( []
, '1'
)
]
, [ ( []
, '1'
)
, ( []
, '1'
)
, ( []
, '0'
)
, ( []
, '0'
)
]
]
--jl

32
test/Hamming/App/WidgetsSpec.hs Normal file
View File

@ -0,0 +1,32 @@
{-
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.WidgetsSpec (spec) where
import Test.Hspec (Spec, describe)
import qualified Hamming.App.Widgets.InternalSpec as Internal
spec :: Spec
spec = describe "Widgets"
Internal.spec
--jl

32
test/Hamming/AppSpec.hs Normal file
View File

@ -0,0 +1,32 @@
{-
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.AppSpec (spec) where
import Test.Hspec (Spec, describe)
import qualified Hamming.App.WidgetsSpec as Widgets
spec :: Spec
spec = describe "App"
Widgets.spec
--jl

4
test/HammingSpec.hs
View File

@ -23,10 +23,12 @@ module HammingSpec (spec) where
import Test.Hspec (Spec, describe)
import qualified Hamming.AppSpec as App
import qualified Hamming.Word16Spec as Word16
spec :: Spec
spec = describe "Hamming"
spec = describe "Hamming" $ do
Word16.spec
App.spec
--jl