waargonaut 0.5.0.0 → 0.5.1.0

raw patch · 6 files changed

+148/−24 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.md +6/−0
• src/Waargonaut/Decode.hs +80/−18
• src/Waargonaut/Decode/Error.hs +12/−0
• src/Waargonaut/Decode/Types.hs +4/−1
• test/Decoder.hs +45/−4
• waargonaut.cabal +1/−1

@@ -1,5 +1,11 @@ # Revision history for waargonaut +## 0.5.1.0  -- 2019-01-02++* Fix order of `either` decoder to match documentation, `Right` decoder was not being attempted first.+* Expose functionality to check the 'type' of the JSON at the current cursor position.+* Update list decoder to check that we're at an array before attempting to decode. It will now fail when attempting to decode a list and something of type list is not found. Previously it would return an empty list when a number was present.+ ## 0.5.0.0  -- 2018-12-18  * Changed internal builder from `ByteString` to `Text` builder.

@@ -20,6 +20,7 @@   , JCurs (..)   , ParseFn   , Err (..)+  , JsonType (..)      -- * Runners   , runDecode@@ -58,6 +59,10 @@   , fromKeyOptional   , atKeyOptional +    -- * Inspection+  , withType+  , jsonTypeAt+     -- * Provided Decoders   , leftwardCons   , rightwardSnoc@@ -81,6 +86,8 @@   , nonempty   , listAt   , list+  , objectAsKeyValuesAt+  , objectAsKeyValues   , withDefault   , maybeOrNull   , either@@ -97,6 +104,7 @@                                                             traverseOf, view,                                                             ( # ), (.~), (^.),                                                             _Left, _Wrapped)+import           Control.Monad.Error.Lens                  (throwing)  import           Prelude                                   (Bool, Bounded, Char,                                                             Eq, Int, Integral,@@ -111,8 +119,7 @@ import           Control.Monad.Morph                       (embed, generalize)  import           Control.Monad.Except                      (catchError, lift,-                                                            liftEither,-                                                            throwError)+                                                            liftEither) import           Control.Monad.Reader                      (ReaderT (..), ask,                                                             local, runReaderT) import           Control.Monad.State                       (MonadState)@@ -120,6 +127,7 @@ import           Control.Error.Util                        (note) import           Control.Monad.Error.Hoist                 ((<!?>), (<?>)) +import           Data.Bool                                 (Bool (..)) import           Data.Either                               (Either (..)) import qualified Data.Either                               as Either (either) import           Data.Foldable                             (Foldable, foldl,@@ -171,8 +179,11 @@ import           Waargonaut.Decode.Types                   (CursorHistory,                                                             DecodeResult (..),                                                             Decoder (..),-                                                            JCurs (..), ParseFn,-                                                            SuccinctCursor)+                                                            JCurs (..),+                                                            JsonType (..),+                                                            ParseFn,+                                                            SuccinctCursor,+                                                            jsonTypeAt)  -- | Function to define a 'Decoder' for a specific data type. --@@ -268,8 +279,17 @@ -- @ [*1,2,3] @ -- -- This function is essential when dealing with the inner elements of objects or--- arrays. As you must first move 'down' into the focus.+-- arrays. As you must first move 'down' into the focus. However, you cannot+-- move down into an empty list or empty object. The reason for this is that+-- there will be nothing in the index for the element at the first position.+-- Thus the movement will be considered invalid. --+-- These will fail if you attempt to move 'down':+--+-- @ *[] @+--+-- @ *{} @+-- down   :: Monad f   => JCurs@@ -308,7 +328,7 @@ moveToRankN newRank c =   if JC.balancedParens (c ^. _Wrapped) .?. Pos.lastPositionOf newRank   then pure $ c & _Wrapped . cursorRankL .~ newRank-  else throwError $ InputOutOfBounds newRank+  else throwing _InputOutOfBounds newRank  -- | Move the cursor rightwards 'n' times. --@@ -384,7 +404,7 @@    if JC.balancedParens c .?. Pos.lastPositionOf rnk     then liftEither (p cursorTxt)-    else throwError (InputOutOfBounds rnk)+    else throwing _InputOutOfBounds rnk  -- Internal function to record the current rank of the cursor into the zipper history recordRank@@ -506,7 +526,7 @@ fromKeyOptional k d c =   focus' =<< catchError (pure <$> moveToKey k c) (\de -> case de of     KeyNotFound _ -> pure Nothing-    _             -> throwError de)+    _             -> throwing _DecodeError de)   where     focus' = maybe (pure Nothing) (fmap Just . focus d) @@ -543,6 +563,28 @@   jsonAtCursor p curs >>=     liftEither . note (ConversionFailure m) . c +-- | Attempt to work with a 'JCurs' provided the type of 'Json' at the current+-- position matches your expectations.+--+-- Such as:+--+-- @+-- withType JsonTypeArray d+-- @+--+-- 'd' will only be entered if the cursor at the current position is a JSON+-- array: '[]'.+--+withType+  :: Monad f+  => JsonType+  -> (JCurs -> DecodeResult f a)+  -> JCurs+  -> DecodeResult f a+withType t d c =+  if maybe False (== t) $ jsonTypeAt (unJCurs c) then d c+  else throwing _TypeMismatch t+ -- | Higher order function for combining a folding function with repeated cursor -- movements. This lets you combine arbitrary cursor movements with an accumulating -- function.@@ -586,14 +628,14 @@ --   | C -- -- decodeMyEnum :: Monad f => Decoder f MyEnum--- decodeMyEnum = D.oneOf D.text "MyEnum"+-- decodeMyEnum = D.oneOf D.text \"MyEnum\" --   [ ("a", A) --   , ("b", B) --   , ("c", C) --   ] -- -- decodeMyEnumFromInt :: Monad f => Decoder f MyEnum--- decodeMyEnumFromInt = D.oneOf D.int "MyEnum"+-- decodeMyEnumFromInt = D.oneOf D.int \"MyEnum\" --   [ (1, A) --   , (2, B) --   , (3, C)@@ -613,7 +655,7 @@   foldr (\i x -> g i <!> x) err   where     g (a,b) = d >>= \t -> if t == a then pure b else err-    err = throwError (ConversionFailure l)+    err = throwing _ConversionFailure l  -- | From the current cursor position, move leftwards one position at a time and -- push each 'a' onto the front of some 'Cons' structure.@@ -779,7 +821,7 @@   -> Decoder f a   -> Decoder f b prismDOrFail' e p d = withCursor $-  focus d >=> Either.either (throwError . e) pure . matching p+  focus d >=> Either.either (throwing _DecodeError . e) pure . matching p  -- | Decode an 'Int'. int :: Monad f => Decoder f Int@@ -833,7 +875,7 @@   => Decoder f a   -> JCurs   -> DecodeResult f (NonEmpty a)-nonemptyAt elemD = down >=> \curs -> do+nonemptyAt elemD = withType JsonTypeArray $ down >=> \curs -> do   h <- focus elemD curs   DI.try (moveRight1 curs) >>= maybe     (pure $ h :| [])@@ -850,14 +892,34 @@   => Decoder f a   -> JCurs   -> DecodeResult f [a]-listAt elemD curs = DI.try (down curs) >>= maybe-  (pure mempty)-  (rightwardSnoc mempty elemD)+listAt elemD = withType JsonTypeArray $ \c ->+  DI.try (down c) >>= maybe (pure mempty) (rightwardSnoc mempty elemD)  -- | Helper function to simplify writing a '[]' decoder. list :: Monad f => Decoder f a -> Decoder f [a] list d = withCursor (listAt d) +-- | Try to decode an object using the given key and value 'Decoder's at the+-- given cursor.+objectAsKeyValuesAt+  :: Monad f+  => Decoder f k+  -> Decoder f v+  -> JCurs+  -> DecodeResult f [(k,v)]+objectAsKeyValuesAt keyD valueD = withType JsonTypeObject $ \curs ->+  DI.try (down curs) >>= maybe+    (pure mempty)+    (foldCursor snoc (moveRight1 >=> moveRight1) mempty (withCursor $ \c -> do+      k <- focus keyD c+      v <- moveRight1 c >>= focus valueD+      pure (k,v)+    ))++-- | Helper function to simplify writing a '{}' decoder.+objectAsKeyValues :: Monad f => Decoder f k -> Decoder f v -> Decoder f [(k,v)]+objectAsKeyValues k v = withCursor (objectAsKeyValuesAt k v)+ -- | Try to decode an optional value, returning the given default value if -- 'Nothing' is returned. withDefault@@ -875,7 +937,7 @@   => Decoder f a   -> Decoder f (Maybe a) maybeOrNull a =-  (Nothing <$ null) <!> (Just <$> a)+  (Just <$> a) <!> (Nothing <$ null)  -- | Decode either an 'a' or a 'b', failing if neither 'Decoder' succeeds. The -- 'Right' decoder is attempted first.@@ -885,4 +947,4 @@   -> Decoder f b   -> Decoder f (Either a b) either leftD rightD =-  (Left <$> leftD) <!> (Right <$> rightD)+  (Right <$> rightD) <!> (Left <$> leftD)

@@ -11,6 +11,8 @@  import           GHC.Word                     (Word64) +import           HaskellWorks.Data.Json.Type  (JsonType)+ import           Data.Text                    (Text)  import           Waargonaut.Decode.ZipperMove (ZipperMove)@@ -29,6 +31,7 @@ -- data DecodeError   = ConversionFailure Text+  | TypeMismatch JsonType   | KeyDecodeFailed   | KeyNotFound Text   | FailedToMove ZipperMove@@ -41,6 +44,7 @@ class AsDecodeError r where   _DecodeError       :: Prism' r DecodeError   _ConversionFailure :: Prism' r Text+  _TypeMismatch      :: Prism' r JsonType   _KeyDecodeFailed   :: Prism' r ()   _KeyNotFound       :: Prism' r Text   _FailedToMove      :: Prism' r ZipperMove@@ -49,6 +53,7 @@   _ParseFailed       :: Prism' r Text    _ConversionFailure = _DecodeError . _ConversionFailure+  _TypeMismatch      = _DecodeError . _TypeMismatch   _KeyDecodeFailed   = _DecodeError . _KeyDecodeFailed   _KeyNotFound       = _DecodeError . _KeyNotFound   _FailedToMove      = _DecodeError . _FailedToMove@@ -64,6 +69,13 @@         (\x -> case x of             ConversionFailure y -> Right y             _                   -> Left x+        )++  _TypeMismatch+    = L.prism TypeMismatch+        (\x -> case x of+            TypeMismatch y -> Right y+            _              -> Left x         )    _KeyDecodeFailed

@@ -14,6 +14,8 @@   , Decoder (..)   , DecodeResult (..)   , JCurs (..)+  , jsonTypeAt+  , JsonType(..)   ) where  import           Control.Lens                          (Rewrapped, Wrapped (..),@@ -36,6 +38,7 @@  import           HaskellWorks.Data.BalancedParens      (SimpleBalancedParens) import           HaskellWorks.Data.Json.Cursor         (JsonCursor (..))+import           HaskellWorks.Data.Json.Type           (JsonType (..), JsonTypeAt (..)) import           HaskellWorks.Data.Positioning         (Count) import           HaskellWorks.Data.RankSelect.Poppy512 (Poppy512) @@ -95,7 +98,7 @@ -- | Wrapper type for the 'SuccinctCursor' newtype JCurs = JCurs   { unJCurs :: SuccinctCursor-  }+  } deriving JsonTypeAt  instance JCurs ~ t => Rewrapped JCurs t 

@@ -20,7 +20,6 @@ import qualified Data.ByteString            as BS import qualified Data.Either                as Either import           Data.Function              (const, ($))-import           Data.Functor.Alt           ((<!>)) import           Data.Maybe                 (Maybe (Just, Nothing)) import           Data.Semigroup             (Semigroup ((<>))) import qualified Data.Sequence              as Seq@@ -53,7 +52,9 @@   , testCase "Using Alt (Error) - Records BranchFail" decodeAltError   , testCase "List Decoder" listDecoder   , testCase "NonEmpty List Decoder" nonEmptyDecoder+  , testCase "Object Decoder" objectAsKeyValuesDecoder   , testCase "Absent Key Decoder" absentKeyDecoder+  , testCase "Either decoding order - Right first" decodeEitherRightFirst   ]  nonEmptyDecoder :: Assertion@@ -64,11 +65,18 @@     ok = "[1]"     notOkay = "[]" +    badTypeObj = "{}"+    badTypeText = "\"test\""+    badTypeNum = "3"+     badElem = "[1, \"fred\"]"    assertBool "NonEmpty Decoder - fail! non-empty list decoder BROKEN. Start panicking" (Either.isRight (dec ok))   assertBool "NonEmpty Decoder - empty list shouldn't succeed" (Either.isLeft (dec notOkay))   assertBool "NonEmpty Decoder - invalid element decoder accepted" (Either.isLeft (dec badElem))+  assertBool "NonEmpty Decoder - invalid type accepted - object" (Either.isLeft (dec badTypeObj))+  assertBool "NonEmpty Decoder - invalid type accepted - text" (Either.isLeft (dec badTypeText))+  assertBool "NonEmpty Decoder - invalid type accepted - num" (Either.isLeft (dec badTypeNum))  listDecoder :: Assertion listDecoder = do@@ -78,14 +86,40 @@     ok = "[1,2,3]"     okE = "[]" -    badShape = "{}"+    badTypeObj = "{}"+    badTypeText = "\"test\""+    badTypeNum = "3"     badElem = "[\"fred\", \"susan\"]"    assertBool "List Decoder - fail! List Decoder BROKEN. Start panicking." (Either.isRight (dec ok))   assertBool "List Decoder - empty list fail" (Either.isRight (dec okE))-  assertBool "List Decoder - move down should return empty list" (Either.isRight (dec badShape))+  assertBool "List Decoder - invalid type accepted - object" (Either.isLeft (dec badTypeObj))+  assertBool "List Decoder - invalid type accepted - text" (Either.isLeft (dec badTypeText))+  assertBool "List Decoder - invalid type accepted - num" (Either.isLeft (dec badTypeNum))   assertBool "List Decoder - invalid element decoder accepted" (Either.isLeft (dec badElem)) +objectAsKeyValuesDecoder :: Assertion+objectAsKeyValuesDecoder = do+  let+    dec = D.runPureDecode (D.objectAsKeyValues D.text D.int) parseBS . D.mkCursor++    ok = "{\"1\":1,\"2\":2,\"3\":3}"+    okE = "{}"++    badTypeArray = "[]"+    badTypeText = "\"test\""+    badTypeNum = "3"+    badKey = "{1:1}"+    badValue = "{\"1\":\"fred\", \"2\":\"susan\"}"++  assertBool "Object Decoder - fail! Object Decoder BROKEN. Start panicking." (Either.isRight (dec ok))+  assertBool "Object Decoder - empty list fail" (Either.isRight (dec okE))+  assertBool "Object Decoder - invalid type accepted - object" (Either.isLeft (dec badTypeArray))+  assertBool "Object Decoder - invalid type accepted - text" (Either.isLeft (dec badTypeText))+  assertBool "Object Decoder - invalid type accepted - num" (Either.isLeft (dec badTypeNum))+  assertBool "Object Decoder - invalid key decoder accepted" (Either.isLeft (dec badKey))+  assertBool "Object Decoder - invalid value decoder accepted" (Either.isLeft (dec badValue))+ decodeTestMissingObjKey :: Assertion decodeTestMissingObjKey = do   let@@ -170,7 +204,14 @@     (const (assertFailure "Should not succeed"))  decodeEitherAlt :: Monad f => D.Decoder f (Either.Either Text Int)-decodeEitherAlt = (Either.Left <$> D.text) <!> (Either.Right <$> D.int)+decodeEitherAlt = D.either D.text D.int++decodeEitherRightFirst :: Assertion+decodeEitherRightFirst = do+  let d = D.runPureDecode (D.either D.scientific D.int) parseBS . D.mkCursor++  d "44e333" @?= Either.Right (Either.Left 44e333)+  d "33" @?= Either.Right (Either.Right 33)  decodeAlt :: Assertion decodeAlt = do

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.5.0.0+version:             0.5.1.0  -- A short (one-line) description of the package. synopsis:            JSON wrangling