hedgehog-gen-json (empty) → 0.0.0

raw patch · 5 files changed

+219/−0 lines, 5 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, hedgehog, hjsonschema, lens, protolude, scientific, tasty, tasty-hedgehog, vector

Files

LICENSE +21/−0
README.md +2/−0
hedgehog-gen-json.cabal +64/−0
src/Hedgehog/Gen/JSON.hs +97/−0
test/Spec.hs +35/−0

+ LICENSE view

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017 Amr Hassan++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

@@ -0,0 +1,2 @@+# haskell-hedgehog-gen-json+JSON Gen for Hedgehog

+ hedgehog-gen-json.cabal view

@@ -0,0 +1,64 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: aaf5869b8143146c3771604d497a1884654598a47bc908828bf2563742f29117++name:           hedgehog-gen-json+version:        0.0.0+synopsis:       JSON generators for Hedgehog+description:    Generate JSON values for Hedgehog tests+category:       Test+homepage:       https://github.com/githubuser/haskell-hedgehog-gen-json#readme+author:         Amr Hassan+maintainer:     amr.hassan@gmail.com+copyright:      2017 Amr Hassan+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md++library+  hs-source-dirs:+      src+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , hedgehog+    , hjsonschema+    , lens+    , protolude+    , scientific+    , vector+  exposed-modules:+      Hedgehog.Gen.JSON+  other-modules:+      Paths_hedgehog_gen_json+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      src+      test+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , hedgehog+    , hjsonschema+    , lens+    , protolude+    , scientific+    , tasty+    , tasty-hedgehog+    , vector+  other-modules:+      Hedgehog.Gen.JSON+      Paths_hedgehog_gen_json+  default-language: Haskell2010

+ src/Hedgehog/Gen/JSON.hs view

@@ -0,0 +1,97 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module Hedgehog.Gen.JSON+  ( genJSON+  , Ranges(..)+  , NumberRange(..)+  , StringRange(..)+  , ArrayRange(..)+  , ObjectRange(..)+  ) where++import           Control.Lens+import qualified Data.Aeson           as A+import qualified Data.ByteString      as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Scientific      as Scientific+import qualified Data.Vector          as Vector+import           Hedgehog+import qualified Hedgehog.Gen         as Gen+import qualified JSONSchema.Draft4    as D4+import           Protolude++newtype NumberRange = NumberRange+  { unNumberRange :: Range Double+  }++newtype StringRange = StringRange+  { unStringRange :: Range Int+  }++newtype ArrayRange = ArrayRange+  { unArrayRange :: Range Int+  }++newtype ObjectRange = ObjectRange+  { unObjectRange :: Range Int+  }++data Ranges = Ranges+  { _numberRange :: NumberRange+  , _stringRange :: StringRange+  , _arrayRange  :: ArrayRange+  , _objectRange :: ObjectRange+  }++makeLenses ''Ranges++readSchema :: FilePath -> IO (Either Text D4.Schema)+readSchema fp = do+  bytes <- BS.readFile fp+  pure $ maybeToEither "failed to decode JSON Schema" (A.decodeStrict bytes)++genNull :: Gen A.Value+genNull = pure A.Null++genString :: StringRange -> Gen A.Value+genString sr = A.String <$> Gen.text (unStringRange sr) Gen.unicode++genBool :: Gen A.Value+genBool = A.Bool <$> Gen.bool++genNumber :: NumberRange -> Gen A.Value+genNumber nr = (A.Number . Scientific.fromFloatDigits) <$> Gen.double (unNumberRange nr)++genArray :: Ranges -> Gen A.Value+genArray ranges = do+  let gen =+        Gen.recursive+          Gen.choice+          [genBool, genNumber (ranges ^. numberRange), genString (ranges ^. stringRange)]+          [genArray ranges, genObj ranges]+  (A.Array . Vector.fromList) <$> Gen.list (unArrayRange (ranges ^. arrayRange)) gen++genObj :: Ranges -> Gen A.Value+genObj ranges =+  A.object <$>+  Gen.list+    (unArrayRange (ranges ^. arrayRange))+    ((,) <$> Gen.text (unStringRange (ranges ^. stringRange)) Gen.unicode <*> genValue ranges)++genValue :: Ranges -> Gen A.Value+genValue ranges =+  Gen.choice+    [ genNull+    , genString (ranges ^. stringRange)+    , genBool+    , genNumber (ranges ^. numberRange)+    , genArray ranges+    , genObj ranges+    ]++genJSON :: Ranges -> Gen ByteString+genJSON ranges = (LBS.toStrict . A.encode) <$> genValue ranges+--genFakeJson :: D4.Schema -> Gen Value+--genFakeJson = undefined

+ test/Spec.hs view

@@ -0,0 +1,35 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++import qualified Data.Aeson          as Aeson+import           Hedgehog+import           Hedgehog.Gen.JSON+import qualified Hedgehog.Range      as Range+import           Protolude+import           Test.Tasty+import           Test.Tasty.Hedgehog++ranges :: Ranges+ranges =+  Ranges+  { _arrayRange = ArrayRange {unArrayRange = (Range.linear 0 5)}+  , _stringRange = StringRange {unStringRange = (Range.linear 0 100)}+  , _numberRange = NumberRange {unNumberRange = (Range.linearFrac 0 1000)}+  , _objectRange = ObjectRange {unObjectRange = (Range.linear 0 5)}+  }++prop_generatedUnconstrainedJSON :: Property+prop_generatedUnconstrainedJSON =+  property $ do+    v <- forAll $ genJSON ranges+    assert $ isJust ((Aeson.decodeStrict v) :: Maybe Aeson.Value)++tests :: TestTree+tests =+  testGroup+    "Hedgehog.Gen.JSON tests"+    [testProperty "Generated unconstrained values are valid JSON" prop_generatedUnconstrainedJSON]++main :: IO ()+main = defaultMain tests