{-# LANGUAGE OverloadedLists #-} module Generator.Data where import Data.Map as M (fromList, insert) import Generator.Generic ( genGenericJsonBool, genGenericJsonNumber, genGenericJsonString, genGenericNonEmptyJsonString, ) import Generator.Utils (genUnbalancedSizeList) import Hedgehog (Gen, Size (Size)) import Hedgehog.Gen (choice) import JsonLogic.Json (Json (..), JsonObject) import Text.Read (readMaybe) -- | Inserts Json into a specific path and returns it -- If it is arrived at the end of the path then it gives the value back insertAtPath :: -- | The path at which to store the json [String] -> -- | Json data that needs to get inserted Json -> -- | Json object that needs to get updated Json -> -- | Updated Json object with inserted Json Json -- End of path reached insertAtPath [] value _ = value -- Insert value to the map insertAtPath (p : ps) value (JsonObject o) = case readMaybe p of Nothing -> JsonObject $ insert p (insertAtPath ps value JsonNull) o Just i -> JsonArray $ replicate (i :: Int) JsonNull ++ [insertAtPath ps value JsonNull] -- Insert value into an array insertAtPath (p : ps) value (JsonArray js) = case readMaybe p of Nothing -> JsonObject [(p, insertAtPath ps value JsonNull)] -- Insert it into array if it already has the length Just i | i < length js -> let (xs, ys) = splitAt i js in -- Replacing the index with the new item, for this we need to drop 1 element at the end JsonArray $ xs ++ [insertAtPath ps value JsonNull] ++ drop 1 ys -- Otherwise append items to the list and put it at the end | otherwise -> JsonArray $ js ++ replicate ((i :: Int) - length js) JsonNull ++ [insertAtPath ps value JsonNull] -- It is inserting along a new path, denoted with JsonNull insertAtPath (p : ps) value JsonNull = case readMaybe p of Nothing -> JsonObject [(p, insertAtPath ps value JsonNull)] Just i -> JsonArray $ replicate (i :: Int) JsonNull ++ [insertAtPath ps value JsonNull] -- Data is always an array or an object in the top layer, everything else is wrong insertAtPath _ _ _ = error "Error invalid Json, your json data is not an array or object" -- | Generate random Json given a size genSizedRandomJson :: Size -> Gen Json genSizedRandomJson s@(Size size) -- If size less or equal to 0 a final item is closed | size <= 0 = choice [ return JsonNull, fst <$> genGenericJsonBool, fst <$> genGenericJsonNumber, fst <$> genGenericJsonString ] -- If size is greater than 0 we expand with an array or object | otherwise = choice [ genSizedRandomJsonArray s, JsonObject <$> genSizedRandomJsonObject s ] -- | Generate a Random sized Json array genSizedRandomJsonArray :: Size -> Gen Json genSizedRandomJsonArray size = do sizes <- genUnbalancedSizeList size JsonArray <$> mapM genSizedRandomJson sizes -- | Generate a Random size Json array that does not contain any objects genSizedNestedJsonArray :: Size -> Gen Json genSizedNestedJsonArray size | size <= 0 = choice [ return JsonNull, fst <$> genGenericJsonBool, fst <$> genGenericJsonNumber, fst <$> genGenericJsonString ] | otherwise = do sizes <- genUnbalancedSizeList size JsonArray <$> mapM genSizedNestedJsonArray sizes -- | Generate sized Jsonobject entry (pair) genSizedRandomJsonEntry :: Size -> Gen (String, Json) genSizedRandomJsonEntry size = do str <- snd <$> genGenericNonEmptyJsonString json <- genSizedRandomJson size return (str, json) -- | Generate random Json object with a given size genSizedRandomJsonObject :: Size -> Gen JsonObject genSizedRandomJsonObject size = do sizes <- genUnbalancedSizeList size M.fromList <$> mapM genSizedRandomJsonEntry sizes -- | Generate an array of given size that generates a range array genSizedJsonNumberArray :: Size -> Gen (Json, [Double]) genSizedJsonNumberArray (Size size) = do let arr = [1 .. (1.0 + fromIntegral size)] :: [Double] return (JsonArray $ map JsonNumber arr, arr) -- | Generate a flat array of a given size genSizedFlatArray :: Size -> Gen Json genSizedFlatArray (Size size) = JsonArray <$> mapM (\_ -> genSizedRandomJson $ Size 0) [0 .. size]