test: Testing caught me doing stupid stuff
This commit is contained in:
parent
cff27337e7
commit
c78d261a1b
7 changed files with 87 additions and 6 deletions
|
@ -3,7 +3,8 @@
|
|||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
module Language.Json (Value(..), null, true, false, boolean, buildInteger, number, document) where
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
module Language.Json (Value(..), null, true, false, boolean, buildInteger, number, document, PrintableValue(..)) where
|
||||
import Data.Text (Text)
|
||||
import Data.Array.IArray (Array)
|
||||
import Numeric.Natural (Natural)
|
||||
|
@ -25,6 +26,10 @@ import qualified Data.Array.IArray as Array
|
|||
import qualified Data.Map.Strict as Map
|
||||
import GHC.Generics ( Generic, Generically(..) )
|
||||
import Pretty.Serialize (PrettySerialize)
|
||||
import Test.QuickCheck (Arbitrary (arbitrary), Gen, UnicodeString (getUnicodeString), PrintableString (getPrintableString))
|
||||
import qualified Test.QuickCheck.Gen as Gen
|
||||
import Test.QuickCheck.Instances.Array ()
|
||||
import Test.QuickCheck.Instances.Natural ()
|
||||
|
||||
|
||||
data Value
|
||||
|
@ -34,9 +39,35 @@ data Value
|
|||
| Number Rational
|
||||
| Array (Array Natural Value)
|
||||
| Object (Map Text Value)
|
||||
deriving (Show, Generic)
|
||||
deriving (Show, Generic, Eq, Ord)
|
||||
deriving PrettySerialize via Generically Value
|
||||
|
||||
-- generaty arbitrary values, for testing
|
||||
instance Arbitrary Value where
|
||||
arbitrary :: Gen Value
|
||||
arbitrary = Gen.oneof
|
||||
[ pure Null
|
||||
, String . Text.pack . getUnicodeString <$> arbitrary
|
||||
, Boolean <$> arbitrary
|
||||
, Number <$> arbitrary
|
||||
, Array <$> Gen.scale (`div` 2) arbitrary
|
||||
, Object . Map.mapKeys (Text.pack . getUnicodeString) <$> Gen.scale (`div` 2) arbitrary
|
||||
]
|
||||
|
||||
newtype PrintableValue = PrintableValue Value
|
||||
deriving stock Show
|
||||
|
||||
instance Arbitrary PrintableValue where
|
||||
arbitrary :: Gen PrintableValue
|
||||
arbitrary = PrintableValue <$> Gen.oneof
|
||||
[ pure Null
|
||||
, String . Text.pack . getPrintableString <$> arbitrary
|
||||
, Boolean <$> arbitrary
|
||||
, Number <$> arbitrary
|
||||
, Array <$> Gen.scale (`div` 2) arbitrary
|
||||
, Object . Map.mapKeys (Text.pack . getPrintableString) <$> Gen.scale (`div` 2) arbitrary
|
||||
]
|
||||
|
||||
null :: Parser Value
|
||||
null = do
|
||||
Parser.exact "null"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue