File: InstanceSpec.hs

package info (click to toggle)
haskell-genvalidity 1.1.1.0-1
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 128 kB
  • sloc: haskell: 942; makefile: 9
file content (146 lines) | stat: -rw-r--r-- 4,945 bytes parent folder | download
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.InstanceSpec
  ( spec,
  )
where

import Control.Monad
import Data.Data
import Data.Fixed
import Data.GenValidity
import Data.Int
import Data.List.NonEmpty (NonEmpty)
import Data.Ratio
import Data.Word
import Numeric.Natural
import Test.Hspec
import Test.Hspec.Core.QuickCheck (modifyMaxSize, modifyMaxSuccess)
import Test.QuickCheck

spec :: Spec
spec = do
  genValidTest (Proxy :: Proxy ())
  genValidTest (Proxy :: Proxy Bool)
  genValidTest (Proxy :: Proxy Ordering)
  genValidTest (Proxy :: Proxy Char)
  genValidTest (Proxy :: Proxy Word)
  genValidTest (Proxy :: Proxy Word8)
  genValidTest (Proxy :: Proxy Word16)
  genValidTest (Proxy :: Proxy Word32)
  genValidTest (Proxy :: Proxy Word64)
  genValidTest (Proxy :: Proxy Int)
  genValidTest (Proxy :: Proxy Int8)
  genValidTest (Proxy :: Proxy Int16)
  genValidTest (Proxy :: Proxy Int32)
  genValidTest (Proxy :: Proxy Int64)
  genValidTest (Proxy :: Proxy Integer)
  genValidTest (Proxy :: Proxy Float)
  tupleTest (Proxy :: Proxy Float)
  -- Regression tests
  describe "shrinkValid Float" $ do
    let sf :: Float -> Spec
        sf f = it (unwords ["Does not shrink", show f, "to itself"]) $ f `shouldNotSatisfy` (`elem` shrinkValid f)

    sf (-2.1393704e20)
    sf 1.2223988e-12
    sf 2.7896812e10
  describe "shrinkValid Double" $ do
    let sd :: Double -> Spec
        sd d = it (unwords ["Does not shrink", show d, "to itself"]) $ d `shouldNotSatisfy` (`elem` shrinkValid d)
    sd (-1.032730679986007e18)
  genValidTest (Proxy :: Proxy Double)
  tupleTest (Proxy :: Proxy Double)
  genValidTest (Proxy :: Proxy (Ratio Int))
  modifyMaxSuccess (`quot` 2) $
    modifyMaxSize (`quot` 2) $
      genValidTest (Proxy :: Proxy (Either Bool Ordering))
  genValidTest (Proxy :: Proxy (Maybe Ordering))
  genValidTest (Proxy :: Proxy (Maybe (Maybe (Ordering))))
  genValidTest (Proxy :: Proxy (Ratio Integer))
  -- threeTupleTests (Proxy :: Proxy (Ratio Integer))
  genValidTest (Proxy :: Proxy (Ratio Int))
  -- threeTupleTests (Proxy :: Proxy (Ratio Int))
  genValidTest (Proxy :: Proxy (Ratio Int8))
  describe "shrinking (Ratio Int)" $
    it "can shrink this example" $
      let v = ((-9223372036854775808) % 9223372036854775761) :: Ratio Int
       in v `notElem` shrinkValid v
  describe "shrinking (Ratio Int8)" $
    it "can shrink this example" $
      let v = ((-128) % 113) :: Ratio Int8
       in v `notElem` shrinkValid v
  genValidTest (Proxy :: Proxy Uni)
  tupleTest (Proxy :: Proxy Uni)
  genValidTest (Proxy :: Proxy Deci)
  tupleTest (Proxy :: Proxy Deci)
  genValidTest (Proxy :: Proxy Centi)
  tupleTest (Proxy :: Proxy Centi)
  genValidTest (Proxy :: Proxy Milli)
  tupleTest (Proxy :: Proxy Milli)
  genValidTest (Proxy :: Proxy Micro)
  tupleTest (Proxy :: Proxy Micro)
  genValidTest (Proxy :: Proxy Nano)
  tupleTest (Proxy :: Proxy Nano)
  genValidTest (Proxy :: Proxy Pico)
  tupleTest (Proxy :: Proxy Pico)
  genValidTest (Proxy :: Proxy Natural)
  tupleTest (Proxy :: Proxy Natural)
  genValidTest (Proxy :: Proxy (NonEmpty Ordering))

tupleTest ::
  forall a.
  (Show a, Eq a, Typeable a, GenValid a) =>
  Proxy a ->
  Spec
tupleTest proxy = do
  modifyMaxSuccess (`quot` 2) $ modifyMaxSize (`quot` 2) $ genValidTest $ (,) <$> proxy <*> proxy

genValidTest ::
  forall a.
  (Show a, Eq a, Typeable a, GenValid a) =>
  Proxy a ->
  Spec
genValidTest proxy = do
  it (unwords ["genValid of", nameOf proxy, "generates only valid values"]) $
    forAll genValid $ \a ->
      case prettyValidate (a :: a) of
        Right v -> seq v $ pure ()
        Left err ->
          expectationFailure $
            unlines ["'validate' reported this value to be invalid:", show a, err, ""]
  modifyMaxSuccess (`quot` 5) $
    it (unwords ["shrinkValid of", nameOf proxy, "shrinks to only valid values"]) $
      forAll genValid $ \a ->
        forM_ (shrinkValid a) $ \v ->
          case prettyValidate (v :: a) of
            Right v_ -> seq v_ $ pure ()
            Left err ->
              expectationFailure $
                unlines ["'validate' reported this value to be invalid:", show v, err, ""]
  modifyMaxSuccess (`quot` 5)
    $ it
      ( unwords
          ["shrinkValid of", nameOf proxy, "only produces values that do not crash while validating"]
      )
    $ forAll genValid
    $ \a ->
      forM_ (shrinkValid a) $ \v ->
        case prettyValidate (v :: a) of
          Right v_ -> seq v_ $ pure () :: IO ()
          Left err -> seq err $ pure ()
  modifyMaxSuccess (`quot` 5) $
    it (unwords ["shrinkValid of", nameOf proxy, "does not shrink to itself"]) $
      forAll genValid $ \a ->
        forM_ (shrinkValid a) $ \a' ->
          unless (a /= a') $
            expectationFailure $
              unlines ["The value", show (a :: a), "was shrunk to itself"]

nameOf ::
  forall a.
  (Typeable a) =>
  Proxy a ->
  String
nameOf = show . typeRep