diff options
| -rw-r--r-- | src/Accessor.hs | 5 | ||||
| -rw-r--r-- | test/AccessorTest.hs | 7 |
2 files changed, 10 insertions, 2 deletions
diff --git a/src/Accessor.hs b/src/Accessor.hs index a1623fc..ace78eb 100644 --- a/src/Accessor.hs +++ b/src/Accessor.hs @@ -15,7 +15,7 @@ module Accessor ) where -type Accessor s a r = (a -> a) -> s -> (s, r) +type Accessor s w r = (w -> w) -> s -> (s, r) accessor :: (s -> a) -> (a -> s -> s) -> Accessor s a a accessor getter setter f x = (setter newVal x, getter x) where @@ -33,7 +33,7 @@ set acc x = over acc (const x) infixr # (#) :: - Accessor obj middle middle -> Accessor middle end end -> Accessor obj end end + Accessor s1 a1 a1 -> Accessor a1 w2 r -> Accessor s1 w2 r (#) = composeAccessors where composeAccessors ac1 ac2 modifier obj = (newObj, value) @@ -92,3 +92,4 @@ sndAcc :: Accessor (a, b) b b sndAcc = accessor getter setter where getter (_, b) = b setter n x = (fst x, n) + diff --git a/test/AccessorTest.hs b/test/AccessorTest.hs index 861a7a4..39a619a 100644 --- a/test/AccessorTest.hs +++ b/test/AccessorTest.hs @@ -25,6 +25,13 @@ testListSet_3 = TestCase (assertEqual "list set 3" expect result) where in over (_1 #> self) (+1) lst expect = [[1,2,3],[5,6,7],[7,8,9]] +testListSet_4 :: Test +testListSet_4 = TestCase (assertEqual "list set 4" expect result) where + result = + let lst = [[[1,2,3],[4,5,6],[7,8,9]]] :: [[[Int]]] + in set (_0 # _1 # _1) 42 lst + expect = [[[1,2,3],[4,42,6],[7,8,9]]] + testTuple_1 :: Test testTuple_1 = TestCase (assertEqual "tuple 1" expect result) where result = view (self #> sndAcc) $ Just (1 :: Int, 42 :: Int) |