git.iko.soy/generic-lens
on master help sign in
Add profunctor prism test
6eb09a5Matthew Pickering
generic-lens.cabal+1−1
compare with master
unifiedsplit
@@ -86,7 +86,7 @@ test-suite generic-lens-test
86 , inspection-testing >= 0.1
86 , inspection-testing >= 0.1
87
87
88 default-language: Haskell2010
88 default-language: Haskell2010
89− ghc-options: -Wall -O2
89+ ghc-options: -Wall -O2 -dsuppress-all
90 if flag(dump-core)
90 if flag(dump-core)
91 build-depends: dump-core
91 build-depends: dump-core
92 ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html
92 ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html
test/Spec.hs+18−2
@@ -1,4 +1,4 @@
1−{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin -dsuppress-all #-}
1+{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-}
2
2
3{-# LANGUAGE AllowAmbiguousTypes #-}
3{-# LANGUAGE AllowAmbiguousTypes #-}
4{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DataKinds #-}
@@ -10,7 +10,7 @@
10{-# LANGUAGE TypeApplications #-}
10{-# LANGUAGE TypeApplications #-}
11{-# LANGUAGE TemplateHaskell #-}
11{-# LANGUAGE TemplateHaskell #-}
12-- For the VL prism test
12-- For the VL prism test
13−{-# OPTIONS_GHC -funfolding-use-threshold=70 #-}
13+{-# OPTIONS_GHC -funfolding-use-threshold=100 #-}
14
14
15module Main where
15module Main where
16
16
@@ -53,6 +53,11 @@ prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
53prism bt seta eta = dimap (\x -> plus pure id (seta x)) (either id (\x -> fmap bt x)) (right' eta)
53prism bt seta eta = dimap (\x -> plus pure id (seta x)) (either id (\x -> fmap bt x)) (right' eta)
54{-# INLINE prism #-}
54{-# INLINE prism #-}
55
55
56+prismP :: (b -> t) -> (s -> Either t a) -> PrismP s t a b
57+prismP bt seta eta = dimap seta (either id bt) (right' eta)
58+{-# INLINE prismP #-}
59+
60+plus :: (a -> b) -> (c -> d) -> Either a c -> Either b d
56plus f g (Left x) = Left (f x)
61plus f g (Left x) = Left (f x)
57plus f g (Right y) = Right (g y)
62plus f g (Right y) = Right (g y)
58
63
@@ -110,6 +115,14 @@ sum1PrismManual eta = prism g f eta
110 s -> Left s
115 s -> Left s
111 g = B
116 g = B
112
117
118+sum1PrismPManual :: PrismP Sum1 Sum1 Int Int
119+sum1PrismPManual eta = prismP g f eta
120+ where
121+ f s1 = case s1 of
122+ B i -> Right i
123+ s -> Left s
124+ g = B
125+
113
126
114--------------------------------------------------------------------------------
127--------------------------------------------------------------------------------
115-- * Tests
128-- * Tests
@@ -154,3 +167,6 @@ inspect $ 'typeChangingManual === 'typeChangingGenericPos
154inspect $ 'typeChangingManualCompose === 'typeChangingGenericCompose
167inspect $ 'typeChangingManualCompose === 'typeChangingGenericCompose
155inspect $ 'intTraversalManual === 'intTraversalDerived
168inspect $ 'intTraversalManual === 'intTraversalDerived
156inspect $ 'sum1PrismManual === 'sum1PrismB
169inspect $ 'sum1PrismManual === 'sum1PrismB
170+inspect $ 'sum1PrismPManual === 'sum1PrismBP
171+
172+