1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-|
Module: ReadSpec
Copyright: (C) 2015-2017 Ryan Scott
License: BSD-style (see the file LICENSE)
Maintainer: Ryan Scott
Portability: Template Haskell
@hspec@ tests for derived 'Read', 'Read1', and 'Read2' instances.
-}
module ReadSpec where
import Data.Deriving
import Data.Functor.Classes (Read1, readsPrec1)
import Data.Proxy
import Prelude ()
import Prelude.Compat
import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck (Arbitrary(..))
import Text.Read (minPrec)
import Types.ReadShow ()
-------------------------------------------------------------------------------
-- Plain data types
data TyCon# a b = TyCon# {
tcA# :: a
, tcB# :: b
} deriving (Eq, Show)
data Empty a b
-- Data families
data family TyFamily# y z :: *
data instance TyFamily# a b = TyFamily# {
tfA# :: a
, tfB# :: b
} deriving (Eq, Show)
-------------------------------------------------------------------------------
-- Plain data types
$(deriveRead ''TyCon#)
$(deriveRead1 ''TyCon#)
#if defined(NEW_FUNCTOR_CLASSES)
$(deriveRead2 ''TyCon#)
#endif
instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon# a b) where
arbitrary = TyCon# <$> arbitrary <*> arbitrary
$(deriveRead ''Empty)
$(deriveRead1 ''Empty)
#if defined(NEW_FUNCTOR_CLASSES)
$(deriveRead2 ''Empty)
#endif
#if MIN_VERSION_template_haskell(2,7,0)
-- Data families
$(deriveRead 'TyFamily#)
$(deriveRead1 'TyFamily#)
# if defined(NEW_FUNCTOR_CLASSES)
$(deriveRead2 'TyFamily#)
# endif
instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily# a b) where
arbitrary = TyFamily# <$> arbitrary <*> arbitrary
#endif
-------------------------------------------------------------------------------
prop_Read :: forall f a. (Read a, Read (f a), Read1 f,
Eq (f a), Show (f a))
=> f a -> Expectation
prop_Read x = readArb readsPrec `shouldBe` readArb readsPrec1
where
readArb :: (Int -> ReadS (f a)) -> f a
readArb = read' (show x)
readSpec :: forall f a. (Arbitrary (f a), Eq (f a), Show (f a),
Read a, Read (f a), Read1 f)
=> Proxy (f a) -> Spec
readSpec _ = prop "has a valid Read1 instance" (prop_Read :: f a -> Expectation)
-- Adapted from the definition of readEither
readEither' :: String -> (Int -> ReadS a) -> Either String a
readEither' s rs =
case [ x | (x,"") <- rs minPrec s ] of
[x] -> Right x
[] -> Left "Prelude.read: no parse"
_ -> Left "Prelude.read: ambiguous parse"
read' :: String -> (Int -> ReadS a) -> a
read' s = either error id . readEither' s
-------------------------------------------------------------------------------
main :: IO ()
main = hspec spec
spec :: Spec
spec = parallel $ do
describe "TyCon#" $
readSpec (Proxy :: Proxy (TyCon# Char Int))
#if MIN_VERSION_template_haskell(2,7,0)
describe "TyFamily#" $
readSpec (Proxy :: Proxy (TyFamily# Char Int))
#endif
|
