aeson-decode 0.1.0.0 → 0.1.0.1

raw patch · 9 files changed

+464/−325 lines, 9 filesdep +data-default-classdep +hspecdep +quaaludedep −data-defaultdep −hedgehogdep ~aesondep ~aeson-qqdep ~basesetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: data-default-class, hspec, quaalude

Dependencies removed: data-default, hedgehog

Dependency ranges changed: aeson, aeson-qq, base, containers, text, time, unordered-containers, vector

API changes (from Hackage documentation)

Files

• Setup.hs +0/−2
• aeson-decode.cabal +52/−44
• changelog.md +13/−0
• license.txt +1/−1
• src/AesonDecode.hs +131/−111
• test/Examples/Asset.hs +55/−0
• test/Examples/Policy.hs +73/−0
• test/Main.hs +139/−0
• test/hedgehog.hs +0/−167

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,64 +1,72 @@+cabal-version: 3.0+ name: aeson-decode-version: 0.1.0.0+version: 0.1.0.1 category: JSON  synopsis: Easy functions for converting from Aeson.Value -description: A small and simple library for interpreting JSON after it has-             been parsed by @aeson@ into the @Value@ type.-             .-             Decoding failures do not come with any error messages; results-             are all @Maybe@.+description:+    A small and simple library for interpreting JSON after it has+    been parsed by @aeson@ into the @Value@ type. +    Decoding failures do not come with any error messages; results+    are all @Maybe@.+ homepage:    https://github.com/typeclasses/aeson-decode bug-reports: https://github.com/typeclasses/aeson-decode/issues  author:     Chris Martin maintainer: Chris Martin, Julie Moronuki -copyright: 2018 Typeclass Consulting, LLC+copyright: 2018 Mission Valley Software LLC license: Apache-2.0 license-file: license.txt -build-type: Simple-cabal-version: >= 1.10--extra-source-files:-    readme.md+extra-source-files: *.md  source-repository head-  type: git-  location: https://github.com/typeclasses/aeson-decode--library-  default-language: Haskell2010-  ghc-options: -Wall-  hs-source-dirs: src--  exposed-modules:-      AesonDecode+    type: git+    location: https://github.com/typeclasses/aeson-decode -  build-depends:-      aeson-    , base >=4.7 && <5-    , containers-    , data-default-    , text-    , unordered-containers-    , vector+common base+    default-language: GHC2021+    default-extensions:+        BlockArguments+        LambdaCase+        NoImplicitPrelude+        ViewPatterns+    ghc-options: -Wall+    build-depends:+      , aeson ^>= 2.0 || ^>= 2.1+      , base ^>= 4.16 || ^>= 4.17+      , containers ^>= 0.6.5+      , data-default-class ^>= 0.1.2+      , quaalude ^>= 0.0+      , text ^>= 1.2.5 || ^>= 2.0+      , unordered-containers ^>= 0.2.17+      , vector ^>= 0.12.3 -test-suite hedgehog-  default-language: Haskell2010-  type: exitcode-stdio-1.0-  main-is: hedgehog.hs-  hs-source-dirs: test-  ghc-options: -Wall -threaded+library+    import: base+    hs-source-dirs: src+    exposed-modules: AesonDecode -  build-depends:-      aeson-decode-    , aeson-qq-    , base >=4.9 && <4.12-    , containers-    , hedgehog-    , text-    , time+test-suite test-aeson-decode+    import: base+    type: exitcode-stdio-1.0+    hs-source-dirs: test+    ghc-options: -threaded+    default-extensions:+        OverloadedLists+        OverloadedStrings+        QuasiQuotes+    main-is: Main.hs+    other-modules:+        Examples.Asset+        Examples.Policy+    build-depends:+      , aeson-decode+      , aeson-qq ^>= 0.8.4+      , hspec ^>= 2.8.5 || ^>= 2.9 || ^>= 2.10+      , time ^>= 1.11.1 || ^>= 1.12

@@ -0,0 +1,13 @@+## 0.1.0.1 (2023-03-01)++Support aeson 2++Support GHC 9.2 and 9.4++Test framework changed from hedgehog to hspec.++Examples have moved from doctest comments to the test.++## 0.1.0.0 (2018-05-11)++Initial release

@@ -1,4 +1,4 @@-Copyright 2018 Typeclass Consulting, LLC+Copyright 2018 Mission Valley Software LLC  Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.

@@ -1,99 +1,121 @@-{-# LANGUAGE LambdaCase   #-}-{-# LANGUAGE ViewPatterns #-}- module AesonDecode   (-  -- * Decoder-    Decoder (..), defaultDecoder, is-  -- * Path-  , Path (..), here, at, only-  -- * Text-  , text, textIs-  -- * Integer-  , integer, integerIs-  -- * Boolean-  , bool, boolIs, true, false-  -- * List-  , listOf-  -- * Vector-  , vectorOf-  -- * Ord map-  , ordMapOf-  -- * Hash map-  , hashMapOf-  -- * Null-  , null--  ) where+      {- * Decoder -}+          Decoder (..), constDecoder, constSuccessDecoder, failDecoder,+          mapDecoder, apDecoder, composeDecoderFunctions, orElse,+          defaultDecoder, is, (^?),+      {- * Path -} Path (..), here, stringPath, textPath, at, only,+      {- * Text -} text, textIs,+      {- * Integer -} integer, integerIs,+      {- * Boolean -} bool, boolIs, true, false,+      {- * List -} listOf,+      {- * Vector -} vectorOf,+      {- * Ord map -} ordMapOf,+      {- * Hash map -} hashMapOf,+      {- * Null -} null, nullable,+  )+   where --- aeson-import           Data.Aeson       (FromJSON, Value (..))-import qualified Data.Aeson       as Aeson-import qualified Data.Aeson.Types as Aeson+import Essentials --- base-import Control.Applicative (Alternative (..))-import Control.Monad       (guard, (>=>))-import Data.Foldable       (toList)-import Data.Semigroup      (Semigroup (..))-import Data.String         (IsString (..))-import Prelude             hiding (null)+import Control.Applicative (Alternative ((<|>), empty))+import Control.Monad (guard)+import Data.Aeson (FromJSON, Value (Object, Array, Null))+import Data.Default.Class (Default (def))+import Data.Foldable (toList)+import Data.HashMap.Lazy (HashMap)+import Data.Map (Map)+import Data.String (IsString (fromString), String)+import Data.Text (Text)+import Data.Vector (Vector)+import Prelude (Integer) --- containers-import           Data.Map (Map)+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KeyMap+import qualified Data.Aeson.Types as Aeson+import qualified Data.HashMap.Lazy as HashMap import qualified Data.Map as Map---- data-default-import qualified Data.Default as Def---- text-import           Data.Text (Text) import qualified Data.Text as Text --- unordered-containers-import           Data.HashMap.Lazy (HashMap)-import qualified Data.HashMap.Lazy as HashMap---- vector-import Data.Vector (Vector)+(^?) :: Value -> Decoder a -> Maybe a+val ^? Decoder f = f val+infixl 8 ^?   -------------------------------------------------------------------------------- --  Decoder -------------------------------------------------------------------------------- +{-| Some way of interpreting a JSON value, with the+    possibility of failure for some values -} newtype Decoder a = Decoder { decodeMaybe :: Value -> Maybe a } -instance Functor Decoder-  where-    fmap f (Decoder d) = Decoder $ (fmap . fmap) f d+{-| @'fmap' = 'mapDecoder'@ -}+instance Functor Decoder where+    fmap = mapDecoder -instance Applicative Decoder-  where-    pure x = Decoder $ (pure . pure) x-    Decoder ff <*> Decoder fx = Decoder $ \v ->-      ff v >>= \f -> fx v >>= \x -> Just (f x)+{-| @'pure' = 'constSuccessDecoder'@, @'<*>' = 'apDecoder'@ -}+instance Applicative Decoder where+    pure = constSuccessDecoder+    (<*>) = apDecoder -instance Monad Decoder-  where-    Decoder f >>= df = Decoder $ \v ->-      f v >>= \x -> let Decoder g = df x in g v+{-| @'>=>' = 'composeDecoderFunctions'@ -}+instance Monad Decoder where+    d >>= f = composeDecoderFunctions f (\_ -> d) () -instance Alternative Decoder-  where-    empty = Decoder $ const Nothing-    Decoder a <|> Decoder b = Decoder $ \v -> a v <|> b v+{-| @'empty' = 'failDecoder'@, @'<|>' = 'orElse'@ -}+instance Alternative Decoder where+    empty = failDecoder+    (<|>) = orElse -instance FromJSON a => Def.Default (Decoder a)-  where+{-| @'def' = 'defaultDecoder'@ -}+instance FromJSON a => Default (Decoder a) where     def = defaultDecoder +{- | Always produces the same result -}+constDecoder+  :: Maybe a    -- ^ The result that the decoder always produces+  -> Decoder a  -- ^ A decoder that always produces the given result+constDecoder x = Decoder (\_ -> x)++{-| Always succeeds and produces the same result -}+constSuccessDecoder :: a -> Decoder a+constSuccessDecoder x = constDecoder (Just x)++{-| Always fails++This is the identity of the 'Alternative' for 'Decoder'. -}+failDecoder :: Decoder a+failDecoder = constDecoder Nothing++mapDecoder :: (a -> b) -> Decoder a -> Decoder b+mapDecoder f (Decoder d) = Decoder ((fmap . fmap) f d)++apDecoder :: Decoder (a -> b) -> Decoder a -> Decoder b+apDecoder (Decoder ff) (Decoder fx) = Decoder $ \v ->+  ff v >>= \f -> fx v >>= \x -> Just (f x)++{-| Compose two decoder-producing functions -}+composeDecoderFunctions+  :: (b -> Decoder c)+  -> (a -> Decoder b)+  -> (a -> Decoder c)+composeDecoderFunctions f g a =+  Decoder $ \v ->+    case decodeMaybe (g a) v of+      Nothing -> Nothing+      Just b -> decodeMaybe (f b) v++orElse :: Decoder a -> Decoder a -> Decoder a+orElse (Decoder a) (Decoder b) = Decoder $ \v ->+  a v <|> b v+ defaultDecoder :: FromJSON a => Decoder a defaultDecoder = Decoder $ \v -> Aeson.parseMaybe Aeson.parseJSON v --- | @'is' x@ produces @'Just' ()@ if the JSON value decodes to @x@,--- or 'Nothing' otherwise.-+{-| @'is' x@ produces @'Just' ()@ if the JSON value decodes to @x@,+    or 'Nothing' otherwise -} is :: (Eq a, FromJSON a) => a -> Decoder () is x = defaultDecoder >>= \y -> guard (x == y) @@ -104,31 +126,39 @@  newtype Path = Path { getAt :: Value -> Maybe Value } -instance Semigroup Path-  where-    Path a <> Path b = Path (a >=> b)+{-| '<>' = 'pathConcat'@ -}+instance Semigroup Path where+    (<>) = pathConcat -instance Monoid Path-  where-    mappend = (<>)+{-| @'mempty' = 'here'@ -}+instance Monoid Path where     mempty = here -instance IsString Path-  where-    fromString x = Path $ \case-      Object m -> HashMap.lookup (Text.pack x) m-      _ -> Nothing+{-| @'fromString' = 'stringPath'@ -}+instance IsString Path where+    fromString = stringPath --- | The empty path.+{-| The empty path +This is the identity of the 'Monoid' for 'Path'. -} here :: Path here = Path Just +stringPath :: String -> Path+stringPath x = textPath (Text.pack x)++textPath :: Text -> Path+textPath x = Path $ \case+    Object m -> KeyMap.lookup (Key.fromText x) m+    _ -> Nothing++pathConcat :: Path -> Path -> Path+pathConcat (Path a) (Path b) = Path (a >=> b)+ at :: Path -> Decoder a -> Decoder a at (Path f1) (Decoder f2) = Decoder (f1 >=> f2) --- | Selects the only element from an array of length 1.-+{-| Selects the only element from an array of length 1 -} only :: Path only = Path $ \case   Array (toList -> [x]) -> Just x@@ -139,27 +169,27 @@ --  Text -------------------------------------------------------------------------------- --- | @'is' x@ produces @'Just' ()@ if the JSON value is the value @null@,--- or 'Nothing' otherwise.-+{-| @'Just' ()@ if the JSON value is the value @null@, 'Nothing' otherwise -} null :: Decoder () null = Decoder $ \case   Null -> Just ()   _ -> Nothing +{- | Succeeds with @'Just' x@ if the decoder @d@ succeeds with value @x@,+     succeeds with 'Nothing' if the JSON value is null, fails otherwise -}+nullable :: Decoder a -> Decoder (Maybe a)+nullable d = (Just <$> d) <|> (Nothing <$ null) + -------------------------------------------------------------------------------- --  Text -------------------------------------------------------------------------------- --- | Decodes a JSON string as 'Text'.-+{-| Decodes a JSON string as 'Text' -} text :: Decoder Text text = defaultDecoder --- | @'is' x@ produces @'Just' ()@ if the JSON value is the string @x@,--- or 'Nothing' otherwise.-+{-| @'Just' ()@ if the JSON value is the given string, 'Nothing' otherwise -} textIs :: Text -> Decoder () textIs = is @@ -168,14 +198,11 @@ --  Integer -------------------------------------------------------------------------------- --- | Decodes a JSON number as an 'Integer'.-+{-| Decodes a JSON number as an 'Integer' -} integer :: Decoder Integer integer = defaultDecoder --- | @'is' x@ produces @'Just' ()@ if the JSON value is the integer @x@,--- or 'Nothing' otherwise.-+{- | @'Just' ()@ if the JSON value is the given integer, 'Nothing' otherwise -} integerIs :: Integer -> Decoder () integerIs = is @@ -184,26 +211,19 @@ --  Boolean -------------------------------------------------------------------------------- --- | Decodes a JSON boolean as a 'Bool'.-+{-| Decodes a JSON boolean as a 'Bool' -} bool :: Decoder Bool bool = defaultDecoder --- | @'is' x@ produces @'Just' ()@ if the JSON value is the boolean @x@,--- or 'Nothing' otherwise.-+{-| @'Just' ()@ if the JSON value is the given boolean, 'Nothing' otherwise -} boolIs :: Bool -> Decoder () boolIs = is --- | @'is' x@ produces @'Just' ()@ if the JSON value is the value @true@,--- or 'Nothing' otherwise.-+{-| @'Just' ()@ if the JSON value is @true@, 'Nothing' otherwise -} true :: Decoder () true = is True --- | @'is' x@ produces @'Just' ()@ if the JSON value is the value @false@,--- or 'Nothing' otherwise.-+{-| @'Just' ()@ if the JSON value is @false@, 'Nothing' otherwise -} false :: Decoder () false = is False @@ -232,8 +252,8 @@  hashMapOf :: Decoder a -> Decoder (HashMap Text a) hashMapOf d = Decoder $ \case-  Object xs -> traverse (decodeMaybe d) xs-  _ -> Nothing+    Object xs -> traverse (decodeMaybe d) xs <&> KeyMap.toHashMapText+    _ -> Nothing   --------------------------------------------------------------------------------

@@ -0,0 +1,55 @@+module Examples.Asset (spec) where++import AesonDecode+import Essentials++import Control.Applicative (Alternative (..))+import Data.Aeson (Value)+import Data.Aeson.QQ (aesonQQ)+import Data.Text (Text)+import Test.Hspec (it, shouldBe, Spec)++data Asset+  = Asset'Image Text+  | Asset'Video Text Text+  deriving (Eq, Show)++spec :: Spec+spec = it "asset example" $+    (json ^? d) `shouldBe` Just+        [ Asset'Video "https://subscriber.typeclasses.com/video/js-operators-2/dash/manifest.mpd"+                      "/_/static/operators-video.jpg"+        , Asset'Image "/_/static/acme.jpg"+        ]++d'image, d'video :: Decoder Asset+d :: Decoder [Asset]++d'image = do+    at "type" (textIs "image")+    Asset'Image <$> at "url" text++d'video = do+    at "type" (textIs "video")+    Asset'Video <$> at "url" text+                <*> at "poster" text++d = at "assets" $ listOf (d'image <|> d'video)++json :: Value+json =+    [aesonQQ|+      {+        "assets": [+          {+            "type": "video",+            "url": "https://subscriber.typeclasses.com/video/js-operators-2/dash/manifest.mpd",+            "poster": "/_/static/operators-video.jpg"+          },+          {+            "type": "image",+            "url": "/_/static/acme.jpg"+          }+        ]+      }+    |]

@@ -0,0 +1,73 @@+module Examples.Policy (spec) where++import AesonDecode+import Essentials++import Control.Applicative (optional)+import Data.Aeson (Value)+import Data.Aeson.QQ (aesonQQ)+import Data.Text (Text)+import Data.Time.Clock.POSIX (POSIXTime)+import Prelude (fromInteger)+import Test.Hspec (it, shouldBe, Spec)++newtype Resource = Resource Text deriving (Eq, Show)++data StartTime = StartImmediately | StartTime POSIXTime deriving (Eq, Show)++newtype EndTime = EndTime POSIXTime deriving (Eq, Show)++data IpAddress = AnyIp | IpAddress Text deriving (Eq, Show)++data Policy = Policy+    { policyResource  :: Resource+    , policyStart     :: StartTime+    , policyEnd       :: EndTime+    , policyIpAddress :: IpAddress+    }+    deriving (Eq, Show)++spec :: Spec+spec = it "policy example" $ (json ^? d) `shouldBe` Just p++json :: Value+json =+    [aesonQQ|+      {+        "Statement": [+            {+              "Resource": "http://d111111abcdef8.cloudfront.net/game_download.zip",+              "Condition": {+                  "IpAddress": {"AWS:SourceIp": "192.0.2.0/24"},+                  "DateLessThan": {"AWS:EpochTime": 1357034400}+              }+            }+        ]+      }+    |]++d'time :: Decoder POSIXTime+d'time :: Decoder POSIXTime = at "AWS:EpochTime" integer <&> fromInteger++d :: Decoder Policy+d :: Decoder Policy = at ("Statement" <> only) $ do++    res   <- Resource <$> at "Resource" text++    start <- maybe StartImmediately StartTime <$>+            (optional $ at ("Condition" <> "DateGreaterThan") d'time)++    end   <- EndTime <$> at ("Condition" <> "DateLessThan") d'time++    ip    <- maybe AnyIp IpAddress <$>+            (optional $ at ("Condition" <> "IpAddress")+                            (at "AWS:SourceIp" text))++    pure $ Policy res start end ip++p :: Policy+p = Policy+    (Resource "http://d111111abcdef8.cloudfront.net/game_download.zip")+    StartImmediately+    (EndTime 1357034400)+    (IpAddress "192.0.2.0/24")

@@ -0,0 +1,139 @@+module Main (main) where++import AesonDecode+import Essentials++import Control.Applicative (Alternative (..))+import Data.Aeson.QQ (aesonQQ)+import Data.Text (Text)+import Prelude (Integer, (+))+import System.IO (IO)+import Test.Hspec (describe, it, hspec, shouldBe)+import Data.Either (Either (..))+import Data.String (String)++import qualified Examples.Asset+import qualified Examples.Policy++main :: IO ()+main = hspec do++    describe "either" do+        let d :: Decoder (Either Text Integer) = (text <&> Left) <|> (integer <&> Right)+        it "Just Left"  $ ([aesonQQ| "x"  |] ^? d) `shouldBe` Just (Left "x")+        it "Just Right" $ ([aesonQQ| 5    |] ^? d) `shouldBe` Just (Right 5)+        it "Nothing"    $ ([aesonQQ| null |] ^? d) `shouldBe` Nothing++    describe "eitherTagged" do+        let d :: Decoder (Either Integer Integer) =+                (at "type" (textIs "x") *> at "value" integer <&> Left) <|>+                (at "type" (textIs "y") *> at "value" integer <&> Right)+        it "Just Left"  $ ([aesonQQ| {"type": "x", "value": 1} |] ^? d) `shouldBe` Just (Left 1)+        it "Just Right" $ ([aesonQQ| {"type": "y", "value": 2} |] ^? d) `shouldBe` Just (Right 2)+        it "Nothing"    $ ([aesonQQ| {"type": "z", "value": 3} |] ^? d) `shouldBe` Nothing++    describe "constSuccessDecoder" do+        it "is lazy" $ (undefined ^? constSuccessDecoder @Integer 6) `shouldBe` Just 6++    describe "failDecoder" do+        it "returns Nothing" $ (undefined ^? failDecoder @Integer) `shouldBe` Nothing++    describe "mapDecoder" do+        let d = mapDecoder (+ 1) integer+        it "Just" $ ([aesonQQ| 4 |] ^? d) `shouldBe` Just 5+        it "Nothing" $ ([aesonQQ| "x" |] ^? d) `shouldBe` Nothing++    describe "apDecoder" do+        let d = (,) `mapDecoder` (at "x" integer) `apDecoder` (at "y" text)+        it "works" $ ([aesonQQ| {"x": 4, "y": "abc"} |] ^? d) `shouldBe` Just (4, "abc")++    describe "composeDecoderFunctions" do+        let f x = at (textPath x) text+            d = composeDecoderFunctions f f "a"+        it "works" $ ([aesonQQ| {"a": "b", "b": "c"} |] ^? d) `shouldBe` Just "c"++    describe "orElse" do+        let d = orElse (Left <$> text) (Right <$> integer)+        it "Just Right" $ ([aesonQQ| 4 |] ^? d) `shouldBe` Just (Right 4)+        it "Just Left" $ ([aesonQQ| "x" |] ^? d) `shouldBe` Just (Left "x")+        it "Nothing" $ ([aesonQQ| null |] ^? d) `shouldBe` Nothing++    describe "defaultDecoder" do+        it "Integer" $ ([aesonQQ| 4 |] ^? defaultDecoder :: Maybe Integer) `shouldBe` Just 4+        it "String" $ ([aesonQQ| "x" |] ^? defaultDecoder :: Maybe String) `shouldBe` Just "x"+        it "[Integer]" $ ([aesonQQ| [4,5,6] |] ^? defaultDecoder :: Maybe [Integer]) `shouldBe` Just [4, 5, 6]++    describe "is" do+        it "Just" $ ([aesonQQ| 4 |] ^? is @Integer 4) `shouldBe` Just ()+        it "Nothing" $ ([aesonQQ| 5 |] ^? is @Integer 4) `shouldBe` Nothing++    describe "only" do+        it "0" $ ([aesonQQ| [] |] ^? at only integer) `shouldBe` Nothing+        it "1" $ ([aesonQQ| [4] |] ^? at only integer) `shouldBe` Just 4+        it "2" $ ([aesonQQ| [4,5] |] ^? at only integer) `shouldBe` Nothing++    describe "null" do+        it "null -> Just" $ ([aesonQQ| null |] ^? null) `shouldBe` Just ()+        it "[] -> Nothing" $ ([aesonQQ| [] |] ^? null) `shouldBe` Nothing+        it "number -> Nothing" $ ([aesonQQ| 4 |] ^? null) `shouldBe` Nothing++    describe "nullable" do+        it "Just Just" $ ([aesonQQ| 4 |] ^? nullable integer) `shouldBe` Just (Just 4)+        it "Just Nothing" $ ([aesonQQ| null |] ^? nullable integer) `shouldBe` Just Nothing+        it "Nothing" $ ([aesonQQ| "x" |] ^? nullable integer) `shouldBe` Nothing++    describe "text" do+        it "Just" $ ([aesonQQ| "x" |] ^? text) `shouldBe` Just "x"+        it "Nothing" $ ([aesonQQ| 4 |] ^? text) `shouldBe` Nothing++    describe "textIs" do+        it "Just" $ ([aesonQQ| "x" |] ^? textIs "x") `shouldBe` Just ()+        it "Nothing" $ ([aesonQQ| "a" |] ^? textIs "x") `shouldBe` Nothing++    describe "integer" do+        it "Just" $ ([aesonQQ| 4 |] ^? integer) `shouldBe` Just 4+        it "Nothing" $ ([aesonQQ| "x" |] ^? integer) `shouldBe` Nothing++    describe "integerIs" do+        it "Just" $ ([aesonQQ| 4 |] ^? integerIs 4) `shouldBe` Just ()+        it "Nothing" $ ([aesonQQ| 5 |] ^? integerIs 4) `shouldBe` Nothing++    describe "bool" do+        it "Just True" $ ([aesonQQ| true |] ^? bool) `shouldBe` Just True+        it "Just False" $ ([aesonQQ| false |] ^? bool) `shouldBe` Just False+        it "Nothing" $ ([aesonQQ| "x" |] ^? bool) `shouldBe` Nothing++    describe "boolIs" do+        it "Just" $ ([aesonQQ| true |] ^? boolIs True) `shouldBe` Just ()+        it "Nothing" $ ([aesonQQ| false |] ^? boolIs True) `shouldBe` Nothing++    describe "true" do+        it "Just" $ ([aesonQQ| true |] ^? true) `shouldBe` Just ()+        it "Nothing" $ ([aesonQQ| false |] ^? true) `shouldBe` Nothing++    describe "false" do+        it "Just" $ ([aesonQQ| false |] ^? false) `shouldBe` Just ()+        it "Nothing" $ ([aesonQQ| true |] ^? false) `shouldBe` Nothing++    describe "vectorOf" do+        it "Just empty" $ ([aesonQQ| [] |] ^? vectorOf integer) `shouldBe` Just []+        it "Just nonempty" $ ([aesonQQ| [4,5,6] |] ^? vectorOf integer) `shouldBe` Just [4, 5, 6]+        it "Nothing" $ ([aesonQQ| ["4","5","6"] |] ^? vectorOf integer) `shouldBe` Nothing++    describe "listOf" do+        it "Just empty" $ ([aesonQQ| [] |] ^? listOf integer) `shouldBe` Just []+        it "Just nonempty" $ ([aesonQQ| [4,5,6] |] ^? listOf integer) `shouldBe` Just [4, 5, 6]+        it "Nothing" $ ([aesonQQ| ["4","5","6"] |] ^? listOf integer) `shouldBe` Nothing++    describe "hashMapOf" do+        it "Just empty" $ ([aesonQQ| {} |] ^? hashMapOf integer) `shouldBe` Just []+        it "Just nonempty" $ ([aesonQQ| {"a": 4, "b": 5} |] ^? hashMapOf integer) `shouldBe` Just [("a", 4), ("b", 5)]+        it "Nothing" $ ([aesonQQ| 4 |] ^? hashMapOf integer) `shouldBe` Nothing++    describe "ordMapOf" do+        it "Just empty" $ ([aesonQQ| {} |] ^? ordMapOf integer) `shouldBe` Just []+        it "Just nonempty" $ ([aesonQQ| {"a": 4, "b": 5} |] ^? ordMapOf integer) `shouldBe` Just [("a", 4), ("b", 5)]+        it "Nothing" $ ([aesonQQ| 4 |] ^? ordMapOf integer) `shouldBe` Nothing++    Examples.Asset.spec+    Examples.Policy.spec

@@ -1,167 +0,0 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE QuasiQuotes         #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell     #-}--import AesonDecode---- aeson-qq-import Data.Aeson.QQ (aesonQQ)---- base-import Control.Applicative (Alternative (..), optional)-import Control.Monad       (when)-import Data.Semigroup      ((<>))-import System.Exit         (exitFailure)-import System.IO           (hSetEncoding, stderr, stdout, utf8)---- hedgehog-import Hedgehog---- text-import Data.Text (Text)---- time-import Data.Time.Clock.POSIX (POSIXTime)--(<&>) :: Functor f => f a -> (a -> b) -> f b-as <&> f = f <$> as-infixl 1 <&>--main :: IO ()-main = do-  hSetEncoding stdout utf8-  hSetEncoding stderr utf8-  ok <- checkParallel $$(discover)-  when (not ok) exitFailure--prop_either :: Property-prop_either = withTests 1 $ property $ do-  let-    d :: Decoder (Either Text Integer) = (text <&> Left) <|> (integer <&> Right)--  decodeMaybe d [aesonQQ|"x"|]  === Just (Left "x")-  decodeMaybe d [aesonQQ|5|]    === Just (Right 5)-  decodeMaybe d [aesonQQ|null|] === Nothing--prop_eitherTagged :: Property-prop_eitherTagged = withTests 1 $ property $ do-  let-    d :: Decoder (Either Integer Integer) =-      (at "type" (textIs "x") *> at "value" integer <&> Left) <|>-      (at "type" (textIs "y") *> at "value" integer <&> Right)--  decodeMaybe d [aesonQQ|{"type": "x", "value": 1}|] === Just (Left 1)-  decodeMaybe d [aesonQQ|{"type": "y", "value": 2}|] === Just (Right 2)-  decodeMaybe d [aesonQQ|{"type": "z", "value": 3}|] === Nothing--data Asset-  = Asset'Image Text-  | Asset'Video Text Text-  deriving (Eq, Show)--prop_asset :: Property-prop_asset = withTests 1 $ property $ do-  let-    d'image, d'video :: Decoder Asset-    d :: Decoder [Asset]--    d'image = do-      at "type" (textIs "image")-      Asset'Image <$> at "url" text--    d'video = do-      at "type" (textIs "video")-      Asset'Video <$> at "url" text-                  <*> at "poster" text--    d = at "assets" $ listOf (d'image <|> d'video)--    json =-      [aesonQQ|-        {-          "assets": [-            {-              "type": "video",-              "url": "https://subscriber.typeclasses.com/video/js-operators-2/dash/manifest.mpd",-              "poster": "/_/static/operators-video.jpg"-            },-            {-              "type": "image",-              "url": "/_/static/acme.jpg"-            }-          ]-        }-        |]--  decodeMaybe d json === Just-    [ Asset'Video "https://subscriber.typeclasses.com/video/js-operators-2/dash/manifest.mpd"-                  "/_/static/operators-video.jpg"-    , Asset'Image "/_/static/acme.jpg"-    ]--newtype Resource = Resource Text-  deriving (Eq, Show)--data StartTime = StartImmediately | StartTime POSIXTime-  deriving (Eq, Show)--newtype EndTime = EndTime POSIXTime-  deriving (Eq, Show)--data IpAddress = AnyIp | IpAddress Text-  deriving (Eq, Show)--data Policy =-  Policy-    { policyResource  :: Resource-    , policyStart     :: StartTime-    , policyEnd       :: EndTime-    , policyIpAddress :: IpAddress-    }-    deriving (Eq, Show)--prop_cloudFrontPolicy :: Property-prop_cloudFrontPolicy = withTests 1 $ property $ do-  let-    json =-      [aesonQQ|-        {-          "Statement": [-              {-                 "Resource": "http://d111111abcdef8.cloudfront.net/game_download.zip",-                 "Condition": {-                    "IpAddress": {"AWS:SourceIp": "192.0.2.0/24"},-                    "DateLessThan": {"AWS:EpochTime": 1357034400}-                 }-              }-           ]-        }-        |]--    d'time :: Decoder POSIXTime = at "AWS:EpochTime" integer <&> fromInteger--    d :: Decoder Policy =-      at ("Statement" <> only) $ do--        res   <- Resource <$> at "Resource" text--        start <- maybe StartImmediately StartTime <$>-                 (optional $ at ("Condition" <> "DateGreaterThan") d'time)--        end   <- EndTime <$> at ("Condition" <> "DateLessThan") d'time--        ip    <- maybe AnyIp IpAddress <$>-                 (optional $ at ("Condition" <> "IpAddress")-                                (at "AWS:SourceIp" text))--        pure $ Policy res start end ip--    p =-      Policy-        (Resource "http://d111111abcdef8.cloudfront.net/game_download.zip")-        StartImmediately-        (EndTime 1357034400)-        (IpAddress "192.0.2.0/24")--  decodeMaybe d json === Just p