@@ -1,4 +1,4 @@
1−{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin -dsuppress-all #-}
1+{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-}
22
33{-# LANGUAGE AllowAmbiguousTypes #-}
44{-# LANGUAGE DataKinds #-}
@@ -10,7 +10,7 @@
1010{-# LANGUAGE TypeApplications #-}
1111{-# LANGUAGE TemplateHaskell #-}
1212-- For the VL prism test
13−{-# OPTIONS_GHC -funfolding-use-threshold=70 #-}
13+{-# OPTIONS_GHC -funfolding-use-threshold=100 #-}
1414
1515module Main where
1616
@@ -53,6 +53,11 @@ prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
5353prism bt seta eta = dimap (\x -> plus pure id (seta x)) (either id (\x -> fmap bt x)) (right' eta)
5454{-# INLINE prism #-}
5555
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
5661plus f g (Left x) = Left (f x)
5762plus f g (Right y) = Right (g y)
5863
@@ -110,6 +115,14 @@ sum1PrismManual eta = prism g f eta
110115 s -> Left s
111116 g = B
112117
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+
113126
114127--------------------------------------------------------------------------------
115128-- * Tests
@@ -154,3 +167,6 @@ inspect $ 'typeChangingManual === 'typeChangingGenericPos
154167inspect $ 'typeChangingManualCompose === 'typeChangingGenericCompose
155168inspect $ 'intTraversalManual === 'intTraversalDerived
156169inspect $ 'sum1PrismManual === 'sum1PrismB
170+inspect $ 'sum1PrismPManual === 'sum1PrismBP
171+
172+