From f02aa25bb9501b3f1339376e3aa551bc291ace7e Mon Sep 17 00:00:00 2001
From: Jonathan Lamothe <jonathan@jlamothe.net>
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