implemented rungL
This commit is contained in:
parent
e52bee47c3
commit
f02aa25bb9
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user