jsonlogic-aeson (empty) → 0.1.0.0
raw patch · 8 files changed
+338/−0 lines, 8 filesdep +aesondep +aeson-prettydep +base
Dependencies added: aeson, aeson-pretty, base, bytestring, containers, hedgehog, jsonlogic, jsonlogic-aeson, scientific, tasty, tasty-hedgehog, tasty-hunit, text, utf8-string, vector
Files
- CHANGELOG.md +5/−0
- LICENSE +21/−0
- README.md +0/−0
- jsonlogic-aeson.cabal +77/−0
- src/JsonLogic/Aeson.hs +54/−0
- test/Generator.hs +89/−0
- test/Test.hs +84/−0
- test/Utils.hs +8/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for jsonlogic-aeson++## 0.1.0.0 -- 2022-04-06++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2022 Marien Matser, Gerard van Schie, Jelle Teeuwissen++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
+ jsonlogic-aeson.cabal view
@@ -0,0 +1,77 @@+cabal-version: 2.4+name: jsonlogic-aeson+version: 0.1.0.0++synopsis: JsonLogic Aeson Support+description: JsonLogic Aeson allows for the translation+ of JsonLogic json to Aeson json.and vice versa.+category: JSON++bug-reports: https://github.com/JTeeuwissen/json-logic-haskell++license: MIT+license-file: LICENSE+author: Marien Matser, Gerard van Schie, Jelle Teeuwissen+maintainer: jelleteeuwissen@hotmail.nl++extra-source-files:+ CHANGELOG.md+ README.md++flag error+ description: Error on ghc warnings+ manual: True+ default: False++library+ exposed-modules:+ JsonLogic.Aeson+ default-language:+ Haskell2010+ ghc-options:+ -Wall -Wno-orphans+ hs-source-dirs:+ src+ build-depends:+ base >= 4.14.3 && < 5,+ jsonlogic >= 0.1.0 && < 0.2,+ aeson >= 2.0.3 && < 2.1,+ bytestring >= 0.11.3 && < 0.12,+ containers >= 0.6.5 && < 0.7,+ text >= 2.0 && < 2.1,+ scientific >= 0.3.7 && < 0.4,+ vector >= 0.12.3 && < 0.13,+ aeson-pretty >= 0.8.9 && < 0.9,+ utf8-string >= 1.0.2 && < 1.1++ if flag(error)+ ghc-options:+ -Werror++Test-Suite jsonlogic-aeson-tests+ main-is:+ Test.hs+ default-language:+ Haskell2010+ ghc-options:+ -Wall+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ test+ other-modules:+ Generator,+ Utils+ build-depends:+ base >= 4.14.3.0,+ jsonlogic,+ jsonlogic-aeson,+ tasty,+ tasty-hunit >= 0.10.0.3,+ tasty-hedgehog >= 1.2.0.0,+ hedgehog >= 1.1.1,+ containers++ if flag(error)+ ghc-options:+ -Werror
+ src/JsonLogic/Aeson.hs view
@@ -0,0 +1,54 @@+-- |+-- Module : JsonLogic.Aeson+-- Description : Json Logic Aeson conversion functions+-- Copyright : (c) Marien Matser, Gerard van Schie, Jelle Teeuwissen, 2022+-- License : MIT+-- Maintainer : jelleteeuwissen@hotmail.nl+-- Stability : experimental+module JsonLogic.Aeson (readJson, prettyPrintJson) where++import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (..), decode)+import Data.Aeson.Encode.Pretty+ ( Config (Config),+ Indent (Spaces),+ NumberFormat (Generic),+ encodePretty',+ )+import Data.Aeson.Key (toString)+import Data.Aeson.KeyMap (toMap)+import qualified Data.ByteString.Lazy as DBL (toStrict)+import qualified Data.ByteString.Lazy.UTF8 as BLU+import qualified Data.Map as M (mapKeys)+import Data.Scientific (toRealFloat)+import qualified Data.Text as DT (unpack)+import qualified Data.Text.Encoding as DTE (decodeUtf8)+import Data.Text.IO as TIO (putStrLn)+import Data.Vector (toList)+import JsonLogic.Json (Json (..))++-- Convert to aeson Json format+instance ToJSON Json where+ toJSON JsonNull = Null+ toJSON (JsonBool b) = toJSON b+ toJSON (JsonNumber n) = toJSON n+ toJSON (JsonString s) = toJSON s+ toJSON (JsonArray js) = toJSON js+ toJSON (JsonObject o) = toJSON o++instance FromJSON Json where+ parseJSON Null = return JsonNull+ parseJSON (Bool b) = return $ JsonBool b+ parseJSON (Number n) = return $ JsonNumber $ toRealFloat n+ parseJSON (String s) = return $ JsonString $ DT.unpack s+ parseJSON (Array xs) = JsonArray <$> mapM parseJSON (toList xs)+ parseJSON (Object o) = JsonObject . M.mapKeys toString <$> mapM parseJSON (toMap o)++-- | Read json from string and decode it into a Json object+readJson :: String -> Maybe Json+readJson s = decode $ BLU.fromString s++-- | Pretty print the Json+prettyPrintJson :: Json -> IO ()+prettyPrintJson = TIO.putStrLn . DTE.decodeUtf8 . DBL.toStrict . encodePretty' config+ where+ config = Config (Spaces 2) mempty Generic False
+ test/Generator.hs view
@@ -0,0 +1,89 @@+module Generator where++import Data.List (intercalate, nubBy)+import qualified Data.Map as M (fromList)+import Hedgehog+import Hedgehog.Gen (alphaNum, bool, choice, double, int, string)+import Hedgehog.Range as Range (constant)+import JsonLogic.Json (Json (..))++genNull :: Gen (Json, String)+genNull = return (JsonNull, "null")++genBool :: Gen (Json, String)+genBool = do+ b <- bool+ return $+ if b+ then (JsonBool b, "true")+ else (JsonBool b, "false")++genNumber :: Gen (Json, String)+genNumber = do+ d <- double $ Range.constant 0 100+ return (JsonNumber d, show d)++genString :: Gen (Json, String)+genString = do+ s <- string (Range.constant 0 10) alphaNum+ return (JsonString s, show s)++genArray :: Size -> Gen (Json, String)+genArray size = do+ sizes <- genUnbalancedSizeList size+ js <- mapM genJson sizes+ return (JsonArray $ map fst js, "[" <> intercalate "," (map snd js) <> "]")++genEntry :: Size -> Gen ((String, Json), String)+genEntry size = do+ key <- string (Range.constant 1 10) alphaNum+ (json, str) <- genJson size+ return ((key, json), show key <> ":" <> str)++genObject :: Size -> Gen (Json, String)+genObject size = do+ sizes <- genUnbalancedSizeList size+ js <- mapM genEntry sizes+ -- Only keep the unique key values to prevent unexpected behavior+ let js' = nubBy (\j1 j2 -> fst (fst j1) == fst (fst j2)) js+ return (JsonObject $ M.fromList $ map fst js', "{" <> intercalate "," (map snd js') <> "}")++genJson :: Size -> Gen (Json, String)+genJson s@(Size size)+ -- If size less or equal to 0 a final item is closed+ | size <= 0 =+ choice+ [ genNull,+ genBool,+ genNumber,+ genString+ ]+ -- If size is greater than 0 we expand with an array or object+ | otherwise =+ choice+ [ genArray s,+ genObject s+ ]++-- | Generates a list of uneven sizes+genUnbalancedSizeList :: Size -> Gen [Size]+genUnbalancedSizeList (Size size) = do+ -- On average contain ~5 items+ arrayLength <- int $ Range.constant 1 10+ let elementSize = size `div` arrayLength+ (Size <$>) <$> genUnbalancedIntList size elementSize++-- | Create an unequal list of integers+genUnbalancedIntList ::+ -- | How many items are still remaining to get divided+ Int ->+ -- | The maximum size of a single entry in the list+ Int ->+ -- | A randomly generated list of integers+ Gen [Int]+genUnbalancedIntList remaining maxInt+ | remaining <= 0 = return []+ | otherwise = do+ chunkSize <- int $ Range.constant 0 $ min remaining maxInt+ -- Important! -1 so the size of each element will converge to 0 eventually+ (:) chunkSize <$> genUnbalancedIntList (remaining - chunkSize - 1) maxInt
+ test/Test.hs view
@@ -0,0 +1,84 @@+module Main where++import qualified Data.Map as M+import Generator (genJson)+import Hedgehog (forAll, property, withTests, (===))+import qualified Hedgehog.Gen as Gen+import JsonLogic.Aeson (readJson)+import JsonLogic.Json (Json (..))+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit as U (assertEqual, testCase)+import Utils++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Parse tests" [unitTests, generatorTests]++unitTests :: TestTree+unitTests =+ testGroup+ "Unit tests for parsing"+ [ U.testCase "test for null" $+ U.assertEqual+ "JsonNull == null"+ (Just JsonNull)+ (readJson "null"),+ U.testCase "test for bool" $+ U.assertEqual+ "JsonBool True == true"+ (Just $ JsonBool True)+ (readJson "true"),+ U.testCase "test for bool" $+ U.assertEqual+ "JsonBool False == false"+ (Just $ JsonBool False)+ (readJson "false"),+ U.testCase "test for number" $+ U.assertEqual+ "JsonNumber 3.0 == 3"+ (Just $ JsonNumber 3.0)+ (readJson "3"),+ U.testCase "test for string" $+ U.assertEqual+ "JsonString \"\" == \"\""+ (Just $ JsonString "")+ (readJson "\"\""),+ U.testCase "test for string" $+ U.assertEqual+ "JsonString \"hello world\" == \"hello world\""+ (Just $ JsonString "hello world")+ (readJson "\"hello world\""),+ U.testCase "test for array" $+ U.assertEqual+ "JsonArray [] == []"+ (Just $ JsonArray [])+ (readJson "[]"),+ U.testCase "test for array" $+ U.assertEqual+ "JsonArray [JsonNumber 1, JsonNumber 2] == [1,2]"+ (Just $ JsonArray [JsonNumber 1, JsonNumber 2])+ (readJson "[1,2]"),+ U.testCase "test for object" $+ U.assertEqual+ "JsonObject {} == {}"+ (Just $ JsonObject M.empty)+ (readJson "{}"),+ U.testCase "test for object" $+ U.assertEqual+ "JsonObject == {\"n1\":null, \"n2\":1.0}"+ (Just $ JsonObject $ M.fromList [("n1", JsonNull), ("n2", JsonNumber 1.0)])+ (readJson "{\"n1\":null, \"n2\":1.0}")+ ]++generatorTests :: TestTree+generatorTests =+ testGroup+ "Generator tests"+ [ hTestProperty "Json parsed correctly" $+ withTests 500 $+ property $ do+ (json, jsonString) <- forAll $ Gen.sized genJson+ Just json === readJson jsonString+ ]
+ test/Utils.hs view
@@ -0,0 +1,8 @@+module Utils where++import Hedgehog.Internal.Property+import Test.Tasty+import qualified Test.Tasty.Hedgehog as H++hTestProperty :: TestName -> Property -> TestTree+hTestProperty name = H.testPropertyNamed name (PropertyName name)