From f02aa25bb9501b3f1339376e3aa551bc291ace7e Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 21 Aug 2024 16:08:21 -0400 Subject: [PATCH] implemented `rungL` --- abacus.cabal | 3 +++ package.yaml | 1 + src/Abacus.hs | 14 ++++++++++++++ test/AbacusSpec.hs | 39 ++++++++++++++++++++++++++++++++++++++- 4 files changed, 56 insertions(+), 1 deletion(-) diff --git a/abacus.cabal b/abacus.cabal index b699cbd..7d38211 100644 --- a/abacus.cabal +++ b/abacus.cabal @@ -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 diff --git a/package.yaml b/package.yaml index 0969041..bc226e0 100644 --- a/package.yaml +++ b/package.yaml @@ -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 diff --git a/src/Abacus.hs b/src/Abacus.hs index 7edceec..d88aabe 100644 --- a/src/Abacus.hs +++ b/src/Abacus.hs @@ -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 diff --git a/test/AbacusSpec.hs b/test/AbacusSpec.hs index 21dfe0d..40298c3 100644 --- a/test/AbacusSpec.hs +++ b/test/AbacusSpec.hs @@ -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