test: Testing caught me doing stupid stuff

This commit is contained in:
vegowotenks 2025-08-22 10:04:23 +02:00
parent cff27337e7
commit c78d261a1b
7 changed files with 87 additions and 6 deletions

View file

@ -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"