{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE CPP #-}

#if __GLASGOW_HASKELL__ >= 800
-- a) THQ works on cross-compilers and unregisterised GHCs
-- b) may make compilation faster as no dynamic loading is ever needed (not sure about this)
-- c) removes one hindrance to have code inferred as SafeHaskell safe
{-# LANGUAGE TemplateHaskellQuotes #-}
#else
{-# LANGUAGE TemplateHaskell #-}
#endif

module Data.Ron.Value
    ( Value (..)
    ) where

import Control.Applicative (liftA2)
import Control.DeepSeq (NFData (rnf))
import Data.Hashable (Hashable, hashWithSalt)
import Data.Foldable (foldl')
import Data.Map.Strict (Map)
import Data.Text (Text)
import Data.Scientific (Scientific, fromFloatDigits)
import Data.Vector (Vector)
import Test.QuickCheck (sized, Arbitrary, arbitrary, Gen, oneof, shuffle, choose, elements, listOf)

import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified Data.Vector as Vector
import qualified Language.Haskell.TH.Syntax as TH


-- Alternatives:
-- Integer -> Int, Int64
-- Scientific -> Double
-- Map -> HashMap, List of tuples, Vector of tuples (especially for record)
-- Vector -> List (for tuples)
-- NonEmpty for tuple and record? Or unify unit with both of them
--
-- | A RON value represented in haskell. This is the intermediate
-- representation between string and your own type.
--
-- @()@ is represented as @Unit ""@. Anonymous records and tuples are
-- similarily represented by having an empty name.
--
-- 'Tuple' and 'Record' contents are guaranteed to be not empty when parsed,
-- since the empty contents denote a 'Unit'. Attempting to dump an empty tuple
-- or record may produce unexpected results, so don't do that, use 'Unit's instead.
data Value
    = Integral !Integer
    | Floating !Scientific
    | Char     !Char
    | String   !Text
    | List     !(Vector Value)
    | Map      !(Map Value Value)
    | Unit     !Text
    | Tuple    !Text !(Vector Value)
    | Record   !Text !(Map Text Value)
    deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show, Eq Value
Eq Value =>
(Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Value -> Value -> Ordering
compare :: Value -> Value -> Ordering
$c< :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
>= :: Value -> Value -> Bool
$cmax :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
min :: Value -> Value -> Value
Ord)

--- Hashable ---

hashValue :: Int -> Value -> Int
hashValue :: Int -> Value -> Int
hashValue Int
s (Integral Integer
x)  = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0::Int) Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
x
hashValue Int
s (Floating Scientific
x)  = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1::Int) Int -> Scientific -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Scientific
x
hashValue Int
s (Char Char
x)      = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2::Int) Int -> Char -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Char
x
hashValue Int
s (String Text
x)    = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
3::Int) Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
x
hashValue Int
s (List Vector Value
xs)     = (Int -> Value -> Int) -> Int -> Vector Value -> Int
forall b a. (b -> a -> b) -> b -> Vector a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Value -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
                            (Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
4::Int))
                            Vector Value
xs
hashValue Int
s (Map Map Value Value
xs)      = (Int -> Value -> Value -> Int) -> Int -> Map Value Value -> Int
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
                            (\Int
acc Value
k Value
v -> Int
acc Int -> Value -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Value
k Int -> Value -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Value
v)
                            (Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
5::Int))
                            Map Value Value
xs
hashValue Int
s (Unit Text
n)      = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
6::Int) Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
n
hashValue Int
s (Tuple Text
n Vector Value
xs)  = (Int -> Value -> Int) -> Int -> Vector Value -> Int
forall b a. (b -> a -> b) -> b -> Vector a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Value -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt
                            (Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
7::Int) Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
n)
                            Vector Value
xs
hashValue Int
s (Record Text
n Map Text Value
xs) = (Int -> Text -> Value -> Int) -> Int -> Map Text Value -> Int
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
                            (\Int
acc Text
k Value
v -> Int
acc Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
k Int -> Value -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Value
v)
                            (Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
8::Int) Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
n)
                            Map Text Value
xs

instance Hashable Value where
    hashWithSalt :: Int -> Value -> Int
hashWithSalt = Int -> Value -> Int
hashValue

--- Template Haskell ---

instance TH.Lift Value where
    lift :: forall (m :: * -> *). Quote m => Value -> m Exp
lift (Integral Integer
x) = [| Integral x |]
    lift (Floating Scientific
x) = [| Floating x |]
    lift (Char Char
x) = [| Char x |]
    lift (String Text
x) = [| String (Text.pack s) |]
        where s :: String
s = Text -> String
Text.unpack Text
x
    lift (List Vector Value
x) = [| List (Vector.fromList a) |]
        where a :: [Value]
a = Vector Value -> [Value]
forall a. Vector a -> [a]
Vector.toList Vector Value
x
    lift (Map Map Value Value
x) = [| Map (Map.fromAscList m) |]
        where m :: [(Value, Value)]
m = Map Value Value -> [(Value, Value)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Value Value
x
    lift (Unit Text
x) = [| Unit (Text.pack s) |]
        where s :: String
s = Text -> String
Text.unpack Text
x
    lift (Tuple Text
n Vector Value
x) = [| Tuple (Text.pack s) (Vector.fromList a)|]
        where s :: String
s = Text -> String
Text.unpack Text
n
              a :: [Value]
a = Vector Value -> [Value]
forall a. Vector a -> [a]
Vector.toList Vector Value
x
    lift (Record Text
n Map Text Value
x) = [| Record (Text.pack s) (Map.fromAscList m) |]
        where s :: String
s = Text -> String
Text.unpack Text
n
              m :: [(Text, Value)]
m = Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Text Value
x

#if MIN_VERSION_template_haskell(2,17,0)
    liftTyped :: forall (m :: * -> *). Quote m => Value -> Code m Value
liftTyped = m Exp -> Code m Value
forall a (m :: * -> *). Quote m => m Exp -> Code m a
TH.unsafeCodeCoerce (m Exp -> Code m Value)
-> (Value -> m Exp) -> Value -> Code m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Value -> m Exp
TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
    liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif

--- QuickCheck

instance Arbitrary Value where
    arbitrary :: Gen Value
arbitrary = (Int -> Gen Value) -> Gen Value
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen Value
arbValue
    -- what the hell is 'shrink'?

arbValue :: Int -> Gen Value
arbValue :: Int -> Gen Value
arbValue = Bool -> Int -> Gen Value
arbValue' Bool
True

arbValue' :: Bool -> Int -> Gen Value
arbValue' :: Bool -> Int -> Gen Value
arbValue' Bool
allowFloat Int
size
    | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Gen Value] -> Gen Value
forall a. HasCallStack => [Gen a] -> Gen a
oneof ([Gen Value] -> Gen Value) -> [Gen Value] -> Gen Value
forall a b. (a -> b) -> a -> b
$
        [ Integer -> Value
Integral (Integer -> Value) -> Gen Integer -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
        , Char -> Value
Char (Char -> Value) -> Gen Char -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char
forall a. Arbitrary a => Gen a
arbitrary
        , Text -> Value
String (Text -> Value) -> Gen Text -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbText
        , Text -> Value
Unit (Text -> Value) -> Gen Text -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbIdentifier
        ] [Gen Value] -> [Gen Value] -> [Gen Value]
forall a. Semigroup a => a -> a -> a
<> if Bool
allowFloat then [Scientific -> Value
Floating (Scientific -> Value) -> (Double -> Scientific) -> Double -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scientific
forall a. RealFloat a => a -> Scientific
fromFloatDigits (Double -> Value) -> Gen Double -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Double] else []
    | Bool
otherwise = [Gen Value] -> Gen Value
forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ Vector Value -> Value
List (Vector Value -> Value) -> Gen (Vector Value) -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Vector Value)
arbList Int
size
        , Map Value Value -> Value
Map (Map Value Value -> Value) -> Gen (Map Value Value) -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Map Value Value)
arbMap Int
size
        , Text -> Vector Value -> Value
Tuple Text
"" (Vector Value -> Value) -> Gen (Vector Value) -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Vector Value)
arbTuple Int
size
        , Text -> Map Text Value -> Value
Record Text
"" (Map Text Value -> Value) -> Gen (Map Text Value) -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Map Text Value)
arbRecord Int
size
        , (Text -> Vector Value -> Value)
-> Gen Text -> Gen (Vector Value) -> Gen Value
forall a b c. (a -> b -> c) -> Gen a -> Gen b -> Gen c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Text -> Vector Value -> Value
Tuple Gen Text
arbIdentifier (Int -> Gen (Vector Value)
arbTuple Int
size)
        , (Text -> Map Text Value -> Value)
-> Gen Text -> Gen (Map Text Value) -> Gen Value
forall a b c. (a -> b -> c) -> Gen a -> Gen b -> Gen c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Text -> Map Text Value -> Value
Record Gen Text
arbIdentifier (Int -> Gen (Map Text Value)
arbRecord Int
size)
        ]

arbText :: Gen Text
arbText :: Gen Text
arbText = String -> Text
Text.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary

arbIdentifier :: Gen Text
arbIdentifier :: Gen Text
arbIdentifier = do
    Char
h <- Gen Char
arbStartIdentifier
    String
t <- Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf Gen Char
arbKeyword
    Text -> Gen Text
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Gen Text) -> (String -> Text) -> String -> Gen Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Gen Text) -> String -> Gen Text
forall a b. (a -> b) -> a -> b
$ Char
hChar -> ShowS
forall a. a -> [a] -> [a]
:String
t
    where
        starts :: String
starts = [Char
'a'..Char
'z'] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'A'..Char
'Z'] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'_']
        keyword :: String
keyword = String
starts String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'0'..Char
'9'] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'\'']
        arbStartIdentifier :: Gen Char
arbStartIdentifier = String -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements String
starts
        arbKeyword :: Gen Char
arbKeyword = String -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements String
keyword

arbList :: Int -> Gen (Vector Value)
arbList :: Int -> Gen (Vector Value)
arbList Int
size = do
    [Int]
sizes <- Int -> Gen [Int]
arbPartition (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    [Value] -> Vector Value
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Vector Value) -> Gen [Value] -> Gen (Vector Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen Value) -> [Int] -> Gen [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Int -> Gen Value
arbValue [Int]
sizes

arbMap :: Int -> Gen (Map Value Value)
arbMap :: Int -> Gen (Map Value Value)
arbMap Int
size = do
    [Int]
sizes <- Int -> Gen [Int]
arbPartition (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    let makeElem :: Int -> Gen (Value, Value)
makeElem Int
s = (Value -> Value -> (Value, Value))
-> Gen Value -> Gen Value -> Gen (Value, Value)
forall a b c. (a -> b -> c) -> Gen a -> Gen b -> Gen c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Bool -> Int -> Gen Value
arbValue' Bool
False Int
0) (Int -> Gen Value
arbValue Int
s)
    [(Value, Value)] -> Map Value Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Value, Value)] -> Map Value Value)
-> Gen [(Value, Value)] -> Gen (Map Value Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen (Value, Value)) -> [Int] -> Gen [(Value, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Int -> Gen (Value, Value)
makeElem [Int]
sizes

arbTuple :: Int -> Gen (Vector Value)
arbTuple :: Int -> Gen (Vector Value)
arbTuple Int
size = do
    [Int]
sizes <- Int -> Gen [Int]
arbPartition (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    Int
firstSize <- if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0 else (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    Value
first <- Int -> Gen Value
arbValue Int
firstSize
    [Value] -> Vector Value
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Vector Value)
-> ([Value] -> [Value]) -> [Value] -> Vector Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value
firstValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:) ([Value] -> Vector Value) -> Gen [Value] -> Gen (Vector Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen Value) -> [Int] -> Gen [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Int -> Gen Value
arbValue [Int]
sizes

arbRecord :: Int -> Gen (Map Text Value)
arbRecord :: Int -> Gen (Map Text Value)
arbRecord Int
size = do
    [Int]
sizes <- Int -> Gen [Int]
arbPartition (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    let makeElem :: Int -> Gen (Text, Value)
makeElem Int
s = (Text -> Value -> (Text, Value))
-> Gen Text -> Gen Value -> Gen (Text, Value)
forall a b c. (a -> b -> c) -> Gen a -> Gen b -> Gen c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) Gen Text
arbIdentifier (Int -> Gen Value
arbValue Int
s)
    Int
firstSize <- if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0 else (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    (Text, Value)
first <- Int -> Gen (Text, Value)
makeElem Int
firstSize
    [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Value)] -> Map Text Value)
-> ([(Text, Value)] -> [(Text, Value)])
-> [(Text, Value)]
-> Map Text Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value)
first(Text, Value) -> [(Text, Value)] -> [(Text, Value)]
forall a. a -> [a] -> [a]
:) ([(Text, Value)] -> Map Text Value)
-> Gen [(Text, Value)] -> Gen (Map Text Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen (Text, Value)) -> [Int] -> Gen [(Text, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Int -> Gen (Text, Value)
makeElem [Int]
sizes

-- | Produces new sizes for recursion
arbPartition :: Int -> Gen [Int]
arbPartition :: Int -> Gen [Int]
arbPartition Int
size = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
size Int
1 of
    Ordering
LT -> [Int] -> Gen [Int]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Ordering
EQ -> [Int] -> Gen [Int]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Int
1]
    Ordering
GT -> [Int] -> Gen [Int]
forall a. [a] -> Gen [a]
shuffle ([Int] -> Gen [Int]) -> Gen [Int] -> Gen [Int]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> [Int] -> Gen [Int]
forall {a}. (Eq a, Num a, Random a) => a -> [a] -> Gen [a]
go Int
size []
        where
            go :: a -> [a] -> Gen [a]
go a
0 [a]
xs = [a] -> Gen [a]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
xs
            go !a
s [a]
xs = do
                a
x <- (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
choose (a
1, a
s)
                a -> [a] -> Gen [a]
go (a
s a -> a -> a
forall a. Num a => a -> a -> a
- a
1) (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

--- Deepseq

instance NFData Value where
    rnf :: Value -> ()
rnf (Integral Integer
x) = Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
x
    rnf (Floating Scientific
x) = Scientific -> ()
forall a. NFData a => a -> ()
rnf Scientific
x
    rnf (Char Char
x) = Char -> ()
forall a. NFData a => a -> ()
rnf Char
x
    rnf (String Text
x) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
x
    rnf (List Vector Value
x) = Vector Value -> ()
forall a. NFData a => a -> ()
rnf Vector Value
x
    rnf (Map Map Value Value
x) = Map Value Value -> ()
forall a. NFData a => a -> ()
rnf Map Value Value
x
    rnf (Unit Text
n) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
n
    rnf (Tuple Text
n Vector Value
x) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
n () -> () -> ()
forall a b. a -> b -> b
`seq` Vector Value -> ()
forall a. NFData a => a -> ()
rnf Vector Value
x
    rnf (Record Text
n Map Text Value
x) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
n () -> () -> ()
forall a b. a -> b -> b
`seq` Map Text Value -> ()
forall a. NFData a => a -> ()
rnf Map Text Value
x