From 475b1ed05c50062effd2f70114fe50fe1ac32f7b Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 21 Aug 2024 20:14:32 -0400 Subject: [PATCH] implemented rendering of left side of abacus widget --- abacus.cabal | 3 + src/Abacus/App/Widgets/Internal.hs | 12 ++- test/Abacus/App/Widgets/InternalSpec.hs | 100 ++++++++++++++++++++++++ test/Abacus/App/WidgetsSpec.hs | 32 ++++++++ test/Abacus/AppSpec.hs | 32 ++++++++ test/AbacusSpec.hs | 3 + 6 files changed, 181 insertions(+), 1 deletion(-) create mode 100644 test/Abacus/App/Widgets/InternalSpec.hs create mode 100644 test/Abacus/App/WidgetsSpec.hs create mode 100644 test/Abacus/AppSpec.hs diff --git a/abacus.cabal b/abacus.cabal index b86b0ba..c832721 100644 --- a/abacus.cabal +++ b/abacus.cabal @@ -58,6 +58,9 @@ test-suite abacus-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + Abacus.App.Widgets.InternalSpec + Abacus.App.WidgetsSpec + Abacus.AppSpec AbacusSpec Paths_abacus autogen-modules: diff --git a/src/Abacus/App/Widgets/Internal.hs b/src/Abacus/App/Widgets/Internal.hs index f196b83..2fe24d5 100644 --- a/src/Abacus/App/Widgets/Internal.hs +++ b/src/Abacus/App/Widgets/Internal.hs @@ -36,11 +36,21 @@ module Abacus.App.Widgets.Internal ( abacusRight, ) where +import Lens.Micro.Platform ((^.)) + import Abacus import Abacus.App.Types abacusLeft :: AppState -> [String] -abacusLeft = undefined +abacusLeft s = + " " : map + (\n -> mark n : show n) + [0..pred (getNumRungs $ s^.abacus)] + ++ [" "] + where + mark n = if n == s^.rungNum + then '>' + else ' ' beads :: Abacus -> [(String, String)] beads = undefined diff --git a/test/Abacus/App/Widgets/InternalSpec.hs b/test/Abacus/App/Widgets/InternalSpec.hs new file mode 100644 index 0000000..6d5701d --- /dev/null +++ b/test/Abacus/App/Widgets/InternalSpec.hs @@ -0,0 +1,100 @@ +{- + +abacus +Copyright (C) Jonathan Lamothe + +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 +. + +-} + +module Abacus.App.Widgets.InternalSpec (spec) where + +import Lens.Micro.Platform ((&), (.~)) +import Test.Hspec (Spec, describe, context, it, shouldBe) + +import Abacus.App.Types +import Abacus.App.Widgets.Internal + +spec :: Spec +spec = describe "Internal" $ do + abacusLeftSpec + beadsSpec + abacusRightSpec + +abacusLeftSpec :: Spec +abacusLeftSpec = describe "abacusLeft" $ mapM_ + ( \(desc, state, expected) -> context desc $ + it ("should be " ++ show expected) $ + abacusLeft state `shouldBe` expected + ) + [ ( "initial state", initialState, initStr ) + , ( "rung 5", r5State, r5Str ) + , ( "negative", negState, nStr ) + ] + where + initStr = + [ " " + , ">0" + , " 1" + , " 2" + , " 3" + , " 4" + , " 5" + , " 6" + , " 7" + , " 8" + , " 9" + , " " + ] + r5Str = + [ " " + , " 0" + , " 1" + , " 2" + , " 3" + , " 4" + , ">5" + , " 6" + , " 7" + , " 8" + , " 9" + , " " + ] + nStr = + [ " " + , " 0" + , " 1" + , " 2" + , " 3" + , " 4" + , " 5" + , " 6" + , " 7" + , " 8" + , " 9" + , " " + ] + r5State = initialState & rungNum .~ 5 + negState = initialState & rungNum .~ (-1) + +beadsSpec :: Spec +beadsSpec = describe "beads" $ + return () + +abacusRightSpec :: Spec +abacusRightSpec = describe "abacusRight" $ + return () + +--jl diff --git a/test/Abacus/App/WidgetsSpec.hs b/test/Abacus/App/WidgetsSpec.hs new file mode 100644 index 0000000..8aaefc3 --- /dev/null +++ b/test/Abacus/App/WidgetsSpec.hs @@ -0,0 +1,32 @@ +{- + +abacus +Copyright (C) Jonathan Lamothe + +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 +. + +-} + +module Abacus.App.WidgetsSpec (spec) where + +import Test.Hspec (Spec, describe) + +import qualified Abacus.App.Widgets.InternalSpec as Internal + +spec :: Spec +spec = describe "Widgets" + Internal.spec + +--jl diff --git a/test/Abacus/AppSpec.hs b/test/Abacus/AppSpec.hs new file mode 100644 index 0000000..a36f65e --- /dev/null +++ b/test/Abacus/AppSpec.hs @@ -0,0 +1,32 @@ +{- + +abacus +Copyright (C) Jonathan Lamothe + +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 +. + +-} + +module Abacus.AppSpec (spec) where + +import Test.Hspec (Spec, describe) + +import qualified Abacus.App.WidgetsSpec as Widgets + +spec :: Spec +spec = describe "App" + Widgets.spec + +--jl diff --git a/test/AbacusSpec.hs b/test/AbacusSpec.hs index 85e6689..8a5c506 100644 --- a/test/AbacusSpec.hs +++ b/test/AbacusSpec.hs @@ -34,6 +34,8 @@ import Test.Hspec import Abacus import Abacus.Internal +import qualified Abacus.AppSpec as App + spec :: Spec spec = describe "Abacus" $ do newAbacusSpec @@ -44,6 +46,7 @@ spec = describe "Abacus" $ do rungLSpec resetAbacusSpec rungListSpec + App.spec newAbacusSpec :: Spec newAbacusSpec = describe "newAbacusSpec" $ mapM_