implemented rungL

This commit is contained in:
Jonathan Lamothe 2024-08-21 16:08:21 -04:00
parent e52bee47c3
commit f02aa25bb9
4 changed files with 56 additions and 1 deletions

View File

@ -30,6 +30,7 @@ library
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends:
base >=4.7 && <5
, microlens-platform >=0.4.3.5 && <0.5
default-language: Haskell2010
executable abacus
@ -44,6 +45,7 @@ executable abacus
build-depends:
abacus
, base >=4.7 && <5
, microlens-platform >=0.4.3.5 && <0.5
default-language: Haskell2010
test-suite abacus-test
@ -61,4 +63,5 @@ test-suite abacus-test
abacus
, base >=4.7 && <5
, hspec >=2.11.9 && <2.12
, microlens-platform >=0.4.3.5 && <0.5
default-language: Haskell2010

View File

@ -20,6 +20,7 @@ description: Please see README.md
dependencies:
- base >= 4.7 && < 5
- microlens-platform >= 0.4.3.5 && < 0.5
ghc-options:
- -Wall

View File

@ -24,6 +24,8 @@ License along with this program. If not, see
-}
{-# LANGUAGE RankNTypes #-}
module Abacus (
Abacus,
newAbacus,
@ -31,9 +33,12 @@ module Abacus (
getNumRungs,
getRung,
setRung,
rungL,
) where
import Data.List (find)
import Data.Maybe (fromJust)
import Lens.Micro.Platform (Lens', lens)
import Abacus.Internal
@ -91,4 +96,13 @@ setRung r v a = a
| v > getNumBeads a = getNumBeads a
| otherwise = v
-- | Lens for a specific rung of an "Abacus"
rungL
:: Int
-- ^ The rung number
-> Lens' Abacus Int
rungL n = lens
(fromJust . getRung n)
(flip $ setRung n)
--jl

View File

@ -22,7 +22,14 @@ License along with this program. If not, see
module AbacusSpec (spec) where
import Data.Maybe (fromJust)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Lens.Micro.Platform ((^.), (&), (.~), (%~))
import Test.Hspec
( Spec
, context
, describe
, it
, shouldBe
)
import Abacus
import Abacus.Internal
@ -34,6 +41,7 @@ spec = describe "Abacus" $ do
getNumRungsSpec
getRungSpec
setRungSpec
rungLSpec
newAbacusSpec :: Spec
newAbacusSpec = describe "newAbacusSpec" $ mapM_
@ -105,4 +113,33 @@ setRungSpec = describe "setRung" $ mapM_
] where
mkA = Abacus 10
rungLSpec :: Spec
rungLSpec = describe "rungL" $ do
let
mkA = Abacus 10
abacus = mkA [2, 3, 5]
context "getter" $
context "rung 1" $
it "should be 3" $
abacus^.rungL 1 `shouldBe` 3
context "setter" $ mapM_
( \(desc, rung, val, expected) -> context desc $ let
actual = abacus & rungL rung .~ val
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "valid rung and value", 1, 7, mkA [2, 7, 5] )
, ( "bad rung", -1, 7, abacus )
, ( "bad value", 1, -1, mkA [2, 0, 5] )
]
context "modifier" $ mapM_
( \(desc, rung, expected) -> context desc $ let
actual = abacus & rungL rung %~ succ
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "valid rung", 1, mkA [2, 4, 5] )
, ( "invalid rung", -1, mkA [2, 3, 5] )
]
--jl