Arbitrary.hs

{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeSynonymInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Test.Arbitrary () where

import Control.Applicative ((<$>), (<*>))
import Data.Aeson
import Data.CaseInsensitive
import Data.Scientific
import Data.String.Conversions
import Test.QuickCheck

import qualified Data.HashMap.Strict as HashMap
import qualified Data.Vector as Vector


-- | 25 most common adjectives according to the Oxford English
-- Dictionary.
readableStrings :: [String]
readableStrings =
    "good" : "new" : "first" : "last" : "long" : "great" : "little" :
    "own" : "other" : "old" : "right" : "big" : "high" : "different" :
    "small" : "large" : "next" : "early" : "young" : "important" :
    "few" : "public" : "bad" : "same" : "able" :
    []

instance Arbitrary ST where
    arbitrary = cs <$> elements readableStrings

instance Arbitrary (CI ST) where
    arbitrary = mk <$> arbitrary

instance Arbitrary Value where
    arbitrary = sized $ \ size -> let size' = size `div` 2 in oneof
        [ return Null
        , String . cs <$> elements readableStrings
        , Number <$> (scientific <$> arbitrary <*> oneof [return 0, (`mod` 12) <$> arbitrary])
        , Bool <$> arbitrary
        , Array . Vector.fromList <$> resize size' arbitrary
        , object <$> resize size' arbitrary
        ]

    shrink (Array v) = Array . Vector.fromList <$> shrink (Vector.toList v)
    shrink (Object m) = Object . HashMap.fromList <$> shrink (HashMap.toList m)
    shrink _ = []