git.iko.soy/generic-lens
on master help sign in
Add more tests, one still failing
762db01Csongor Kiss
src/Data/Generics/Internal/Profunctor/Lens.hs−1
compare with master
unifiedsplit
@@ -23,7 +23,6 @@ module Data.Generics.Internal.Profunctor.Lens where
23
23
24import Data.Profunctor (Profunctor(..), Strong(..))
24import Data.Profunctor (Profunctor(..), Strong(..))
25import Data.Bifunctor
25import Data.Bifunctor
26−import Data.Tagged
27import GHC.Generics
26import GHC.Generics
28import Data.Generics.Internal.Profunctor.Iso
27import Data.Generics.Internal.Profunctor.Iso
29
28
test/Spec.hs+41
@@ -96,6 +96,34 @@ sum1PrismManual eta = prism g f eta
96 s -> Left s
96 s -> Left s
97 g = B
97 g = B
98
98
99+sum1PrismManualChar :: Prism Sum1 Sum1 Char Char
100+sum1PrismManualChar eta = prism g f eta
101+ where
102+ f s1 = case s1 of
103+ A i -> Right i
104+ B _ -> Left s1
105+ C _ -> Left s1
106+ D _ -> Left s1
107+ g = A
108+
109+sum2PrismManual :: Prism Sum2 Sum2 Int Int
110+sum2PrismManual eta = prism g f eta
111+ where
112+ f s1 = case s1 of
113+ B2 i -> Right i
114+ s -> Left s
115+ g = B2
116+
117+
118+sum2PrismManualChar :: Prism Sum2 Sum2 Char Char
119+sum2PrismManualChar eta = prism g f eta
120+ where
121+ f s1 = case s1 of
122+ A2 i -> Right i
123+ s -> Left s
124+ g = A2
125+
126+
99subtypePrismManual :: Prism Sum1 Sum1 Sum2 Sum2
127subtypePrismManual :: Prism Sum1 Sum1 Sum2 Sum2
100subtypePrismManual eta = prism g f eta
128subtypePrismManual eta = prism g f eta
101 where
129 where
@@ -144,6 +172,15 @@ subtypePrismGeneric = _Sub
144sum1TypePrism :: Prism Sum1 Sum1 Int Int
172sum1TypePrism :: Prism Sum1 Sum1 Int Int
145sum1TypePrism = _Typed @Int
173sum1TypePrism = _Typed @Int
146
174
175+sum1TypePrismChar :: Prism Sum1 Sum1 Char Char
176+sum1TypePrismChar = _Typed @Char
177+
178+sum2TypePrism :: Prism Sum2 Sum2 Int Int
179+sum2TypePrism = _Typed @Int
180+
181+sum2TypePrismChar :: Prism Sum2 Sum2 Char Char
182+sum2TypePrismChar = _Typed @Char
183+
147tests :: Test
184tests :: Test
148tests = TestList $ map mkHUnitTest
185tests = TestList $ map mkHUnitTest
149 [ $(inspectTest $ 'fieldALensManual === 'fieldALensName)
186 [ $(inspectTest $ 'fieldALensManual === 'fieldALensName)
@@ -156,4 +193,8 @@ tests = TestList $ map mkHUnitTest
156 , $(inspectTest $ 'intTraversalManual === 'intTraversalDerived)
193 , $(inspectTest $ 'intTraversalManual === 'intTraversalDerived)
157 , $(inspectTest $ 'sum1PrismManual === 'sum1PrismB)
194 , $(inspectTest $ 'sum1PrismManual === 'sum1PrismB)
158 , $(inspectTest $ 'subtypePrismManual === 'subtypePrismGeneric)
195 , $(inspectTest $ 'subtypePrismManual === 'subtypePrismGeneric)
196+ , $(inspectTest $ 'sum2PrismManualChar === 'sum2TypePrismChar)
197+ , $(inspectTest $ 'sum2PrismManual === 'sum2TypePrism)
198+ , $(inspectTest $ 'sum1PrismManualChar === 'sum1TypePrismChar)
199+ , $(inspectTest $ 'sum2PrismManualChar === 'sum2TypePrismChar)
159 , $(inspectTest $ 'sum1PrismManual === 'sum1TypePrism) ]
200 , $(inspectTest $ 'sum1PrismManual === 'sum1TypePrism) ]