Skip to content

Commit 2b51c6c

Browse files
fpringlefpringle
committed
Update tests
1 parent df2c84e commit 2b51c6c

6 files changed

Lines changed: 73 additions & 96 deletions

File tree

‎test/Generics/Case/BoolSpec.hs‎

Lines changed: 15 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -6,28 +6,28 @@ import qualified Test.Hspec as H
66
import qualified Test.QuickCheck as Q
77
import Util
88

9+
type BoolFn r = Bool -> r -> r -> r
10+
11+
type FunArgs r = '[Bool, r, r]
12+
13+
manual :: BoolFn r
14+
manual b f t = bool f t b
15+
916
specBool ::
10-
forall a.
11-
(Show a, Eq a, Q.Arbitrary a) =>
17+
forall r.
18+
(Show r, Eq r, Q.Arbitrary r) =>
1219
String ->
13-
(a -> a -> Bool -> a) ->
20+
BoolFn r ->
1421
H.Spec
15-
specBool name f = specG @'[a, a, Bool] ("bool", bool) (name, f)
16-
17-
boolL_ :: a -> a -> Bool -> a
18-
boolL_ x y b = boolL b x y
22+
specBool name f = specG @(FunArgs r) ("bool", manual) (name, f)
1923

2024
spec :: H.Spec
2125
spec = do
2226
H.describe "()" $ do
23-
specBool @() "boolR" boolR
24-
specBool @() "boolL" boolL_
27+
specBool @() "boolL" boolL
2528
H.describe "Char" $ do
26-
specBool @Char "boolR" boolR
27-
specBool @Char "boolL" boolL_
29+
specBool @Char "boolL" boolL
2830
H.describe "String" $ do
29-
specBool @String "boolR" boolR
30-
specBool @String "boolL" boolL_
31+
specBool @String "boolL" boolL
3132
H.describe "[Maybe (Int, String)]" $ do
32-
specBool @[Maybe (Int, String)] "boolR" boolR
33-
specBool @[Maybe (Int, String)] "boolL" boolL_
33+
specBool @[Maybe (Int, String)] "boolL" boolL

‎test/Generics/Case/Custom/NoParamTypeSpec.hs‎

Lines changed: 10 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -28,23 +28,20 @@ instance Q.Arbitrary NoParamType where
2828
]
2929
shrink = Q.genericShrink
3030

31-
type NPTFn r = r -> (Int -> r) -> (String -> Char -> r) -> NoParamType -> r
31+
type NPTFn r = NoParamType -> r -> (Int -> r) -> (String -> Char -> r) -> r
3232

33-
type FunArgs r = '[r, Fun Int r, Fun String (Fun Char r), NoParamType]
33+
type FunArgs r = '[NoParamType, r, Fun Int r, Fun String (Fun Char r)]
3434

3535
type NPTFun r = Chain (FunArgs r) r
3636

3737
manual :: NPTFn r
38-
manual r fromInt fromStringChar = \case
38+
manual npt r fromInt fromStringChar = case npt of
3939
NPT1 -> r
4040
NPT2 int -> fromInt int
4141
NPT3 string char -> fromStringChar string char
4242

43-
nptR :: NPTFn r
44-
nptR = gcaseR @NoParamType
45-
46-
nptL :: NoParamType -> r -> (Int -> r) -> (String -> Char -> r) -> r
47-
nptL = gcaseL @NoParamType
43+
nptL :: NPTFn r
44+
nptL = gcase @NoParamType
4845

4946
specNPT ::
5047
forall r.
@@ -63,22 +60,15 @@ specNPT name f =
6360
mkFn ::
6461
NPTFn r ->
6562
NPTFun r
66-
mkFn f r f1 f2 = f r (applyFun f1) (applyFun <$> applyFun f2)
67-
68-
nptL_ :: NPTFn r
69-
nptL_ r fromInt fromStringChar npt = nptL npt r fromInt fromStringChar
63+
mkFn f npt' r f1 f2 = f npt' r (applyFun f1) (applyFun <$> applyFun f2)
7064

7165
spec :: H.Spec
7266
spec = do
7367
H.describe "()" $ do
74-
specNPT @() "nptR" nptR
75-
specNPT @() "nptL" nptL_
68+
specNPT @() "nptL" nptL
7669
H.describe "Char" $ do
77-
specNPT @Char "nptR" nptR
78-
specNPT @Char "nptL" nptL_
70+
specNPT @Char "nptL" nptL
7971
H.describe "String" $ do
80-
specNPT @String "nptR" nptR
81-
specNPT @String "nptL" nptL_
72+
specNPT @String "nptL" nptL
8273
H.describe "[Maybe (Int, String)]" $ do
83-
specNPT @[Maybe (Int, String)] "nptR" nptR
84-
specNPT @[Maybe (Int, String)] "nptL" nptL_
74+
specNPT @[Maybe (Int, String)] "nptL" nptL

‎test/Generics/Case/Custom/OneParamTypeSpec.hs‎

Lines changed: 11 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -28,23 +28,20 @@ instance (Q.Arbitrary a) => Q.Arbitrary (OneParamType a) where
2828
]
2929
shrink = Q.genericShrink
3030

31-
type OPTFn a r = (a -> r) -> (Maybe a -> r) -> (a -> a -> r) -> OneParamType a -> r
31+
type OPTFn a r = OneParamType a -> (a -> r) -> (Maybe a -> r) -> (a -> a -> r) -> r
3232

33-
type FunArgs a r = '[Fun a r, Fun (Maybe a) r, Fun a (Fun a r), OneParamType a]
33+
type FunArgs a r = '[OneParamType a, Fun a r, Fun (Maybe a) r, Fun a (Fun a r)]
3434

3535
type OPTFun a r = Chain (FunArgs a r) r
3636

3737
manual :: OPTFn a r
38-
manual fromA fromM fromAs = \case
38+
manual opt fromA fromM fromAs = case opt of
3939
OPT1 a -> fromA a
4040
OPT2 m -> fromM m
4141
OPT3 a1 a2 -> fromAs a1 a2
4242

43-
optR :: forall a r. OPTFn a r
44-
optR = gcaseR @(OneParamType a)
45-
46-
optL :: forall a r. OneParamType a -> (a -> r) -> (Maybe a -> r) -> (a -> a -> r) -> r
47-
optL = gcaseL @(OneParamType a)
43+
gopt :: forall a r. OPTFn a r
44+
gopt = gcase @(OneParamType a)
4845

4946
specOPT ::
5047
forall a r.
@@ -65,24 +62,18 @@ specOPT name f =
6562
(name, mkFn f)
6663

6764
mkFn ::
65+
forall a r.
6866
OPTFn a r ->
6967
OPTFun a r
70-
mkFn f f1 f2 f3 = f (applyFun f1) (applyFun f2) (applyFun <$> applyFun f3)
71-
72-
optL_ :: OPTFn a r
73-
optL_ r fromInt fromStringChar opt = optL opt r fromInt fromStringChar
68+
mkFn f m f1 f2 f3 = f m (applyFun f1) (applyFun f2) (applyFun <$> applyFun f3)
7469

7570
spec :: H.Spec
7671
spec = do
7772
H.describe "OneParamType () -> Char" $ do
78-
specOPT @() @Char "optR" optR
79-
specOPT @() @Char "optL" optL_
73+
specOPT @() @Char "gopt" gopt
8074
H.describe "OneParamType Char -> Either String ()" $ do
81-
specOPT @Char @(Either String ()) "optR" optR
82-
specOPT @Char @(Either String ()) "optL" optL_
75+
specOPT @Char @(Either String ()) "gopt" gopt
8376
H.describe "OneParamType String -> (Int, Either Integer Int)" $ do
84-
specOPT @String @(Int, Either Integer Int) "optR" optR
85-
specOPT @String @(Int, Either Integer Int) "optL" optL_
77+
specOPT @String @(Int, Either Integer Int) "gopt" gopt
8678
H.describe "OneParamType [Maybe (Int, String)] -> (Int, [Either (Maybe ()) String])" $ do
87-
specOPT @[Maybe (Int, String)] @(Int, [Either (Maybe ()) String]) "optR" optR
88-
specOPT @[Maybe (Int, String)] @(Int, [Either (Maybe ()) String]) "optL" optL_
79+
specOPT @[Maybe (Int, String)] @(Int, [Either (Maybe ()) String]) "gopt" gopt

‎test/Generics/Case/EitherSpec.hs‎

Lines changed: 12 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,16 @@ import qualified Test.QuickCheck as Q
77
import Test.QuickCheck.Function
88
import Util
99

10-
type EitherFn a b r = (a -> r) -> (b -> r) -> Either a b -> r
10+
type EitherFn a b r = Either a b -> (a -> r) -> (b -> r) -> r
1111

12-
type FunArgs a b r = '[Fun a r, Fun b r, Either a b]
12+
type FunArgs a b r = '[Either a b, Fun a r, Fun b r]
1313

1414
type EitherFun a b r = Chain (FunArgs a b r) r
1515

16+
manual :: EitherFn a b r
17+
manual (Left a) f _ = f a
18+
manual (Right b) _ g = g b
19+
1620
specEither ::
1721
forall a b r.
1822
( Show a
@@ -32,28 +36,21 @@ specEither ::
3236
H.Spec
3337
specEither name f =
3438
specG @(FunArgs a b r)
35-
("either", mkFn either)
39+
("either", mkFn manual)
3640
(name, mkFn f)
3741

3842
mkFn ::
3943
EitherFn a b r ->
4044
EitherFun a b r
41-
mkFn e f g = e (applyFun f) (applyFun g)
42-
43-
eitherL_ :: EitherFn a b r
44-
eitherL_ f g e = eitherL e f g
45+
mkFn e x f g = e x (applyFun f) (applyFun g)
4546

4647
spec :: H.Spec
4748
spec = do
4849
H.describe "Either () Char -> Char" $ do
49-
specEither @() @Char @Char "eitherR" eitherR
50-
specEither @() @Char @Char "eitherL" eitherL_
50+
specEither @() @Char @Char "eitherL" eitherL
5151
H.describe "Either Char String -> Either String ()" $ do
52-
specEither @Char @String @(Either String ()) "eitherR" eitherR
53-
specEither @Char @String @(Either String ()) "eitherL" eitherL_
52+
specEither @Char @String @(Either String ()) "eitherL" eitherL
5453
H.describe "Either String (Maybe Integer) -> (Int, Either Integer Int)" $ do
55-
specEither @String @(Maybe Integer) @(Int, Either Integer Int) "eitherR" eitherR
56-
specEither @String @(Maybe Integer) @(Int, Either Integer Int) "eitherL" eitherL_
54+
specEither @String @(Maybe Integer) @(Int, Either Integer Int) "eitherL" eitherL
5755
H.describe "Either [Maybe (Int, String)] Int -> (Int, [Either (Maybe ()) String])" $ do
58-
specEither @[Maybe (Int, String)] @Int @(Int, [Either (Maybe ()) String]) "eitherR" eitherR
59-
specEither @(Maybe (Int, String)) @Int @(Int, [Either (Maybe ()) String]) "eitherL" eitherL_
56+
specEither @(Maybe (Int, String)) @Int @(Int, [Either (Maybe ()) String]) "eitherL" eitherL

‎test/Generics/Case/MaybeSpec.hs‎

Lines changed: 12 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,16 @@ import qualified Test.QuickCheck as Q
77
import Test.QuickCheck.Function
88
import Util
99

10-
type MaybeFn a r = r -> (a -> r) -> Maybe a -> r
10+
type MaybeFn a r = Maybe a -> r -> (a -> r) -> r
1111

12-
type FunArgs a r = '[r, Fun a r, Maybe a]
12+
type FunArgs a r = '[Maybe a, r, Fun a r]
1313

1414
type MaybeFun a r = Chain (FunArgs a r) r
1515

16+
manual :: MaybeFn a r
17+
manual Nothing r _ = r
18+
manual (Just a) _ f = f a
19+
1620
specMaybe ::
1721
forall a r.
1822
( Show a
@@ -28,28 +32,21 @@ specMaybe ::
2832
H.Spec
2933
specMaybe name f =
3034
specG @(FunArgs a r)
31-
("maybe", mkFn maybe)
35+
("maybe", mkFn manual)
3236
(name, mkFn f)
3337

3438
mkFn ::
3539
MaybeFn a r ->
3640
MaybeFun a r
37-
mkFn f r fn = f r (applyFun fn)
38-
39-
maybeL_ :: MaybeFn a r
40-
maybeL_ x y b = maybeL b x y
41+
mkFn f m r fn = f m r (applyFun fn)
4142

4243
spec :: H.Spec
4344
spec = do
4445
H.describe "Maybe () -> Char" $ do
45-
specMaybe @() @Char "maybeR" maybeR
46-
specMaybe @() @Char "maybeL" maybeL_
46+
specMaybe @() @Char "maybeL" maybeL
4747
H.describe "Maybe Char -> Either String ()" $ do
48-
specMaybe @Char @(Either String ()) "maybeR" maybeR
49-
specMaybe @Char @(Either String ()) "maybeL" maybeL_
48+
specMaybe @Char @(Either String ()) "maybeL" maybeL
5049
H.describe "Maybe String -> (Int, Either Integer Int)" $ do
51-
specMaybe @String @(Int, Either Integer Int) "maybeR" maybeR
52-
specMaybe @String @(Int, Either Integer Int) "maybeL" maybeL_
50+
specMaybe @String @(Int, Either Integer Int) "maybeL" maybeL
5351
H.describe "Maybe [Maybe (Int, String)] -> (Int, [Either (Maybe ()) String])" $ do
54-
specMaybe @[Maybe (Int, String)] @(Int, [Either (Maybe ()) String]) "maybeR" maybeR
55-
specMaybe @(Maybe (Int, String)) @(Int, [Either (Maybe ()) String]) "maybeL" maybeL_
52+
specMaybe @(Maybe (Int, String)) @(Int, [Either (Maybe ()) String]) "maybeL" maybeL

‎test/Util.hs‎

Lines changed: 13 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -9,29 +9,31 @@ import qualified Test.Hspec as H
99
import qualified Test.Hspec.QuickCheck as H
1010
import qualified Test.QuickCheck as Q
1111

12+
newtype ChainF r xs = ChainF (NP I xs -> r)
13+
1214
propG ::
1315
forall args r.
1416
(SListI args, All Show args, Eq r, Show r) =>
1517
(String, Chain args r) ->
1618
(String, Chain args r) ->
17-
Chain args Q.Property
18-
propG (refName, refF) (name, f) =
19-
toChain @args @Q.Property $ ChainF $ \args ->
20-
let expected = applyChain (fromChain @args @r refF) args
21-
actual = applyChain (fromChain f) args
22-
argsS = unwords $ fmap ($ "") $ collapse_NP $ cmap_NP (Proxy @Show) (K . showsPrec 11 . unI) args
23-
expS = unwords [refName, argsS, "=", show expected]
24-
actS = unwords [name, argsS, "=", show actual]
25-
s = unlines [expS, actS]
26-
in Q.counterexample s $ expected == actual
19+
NP I args ->
20+
Q.Property
21+
propG (refName, refF) (name, f) args =
22+
let expected = fromChain @args @r refF args
23+
actual = fromChain @args @r f args
24+
argsS = unwords $ fmap ($ "") $ collapse_NP $ cmap_NP (Proxy @Show) (K . showsPrec 11 . unI) args
25+
expS = unwords [refName, argsS, "=", show expected]
26+
actS = unwords [name, argsS, "=", show actual]
27+
s = unlines [expS, actS]
28+
in Q.counterexample s $ expected == actual
2729

2830
testG ::
2931
forall args r.
3032
(SListI args, All Show args, Eq r, Show r, Q.Arbitrary r, All Q.Arbitrary args) =>
3133
(String, Chain args r) ->
3234
(String, Chain args r) ->
3335
Q.Property
34-
testG ref f = Q.property $ fromChain @args @Q.Property $ propG @args @r ref f
36+
testG ref f = Q.property @(ChainF Q.Property args) $ ChainF $ propG @args @r ref f
3537

3638
specG ::
3739
forall args r.

0 commit comments

Comments
 (0)