aeson-value-parser 0.11.4 → 0.12

raw patch · 2 files changed

+48/−26 lines, 2 filesdep +json-pointerdep +json-pointer-aesondep +transformersdep −successdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: json-pointer, json-pointer-aeson, transformers

Dependencies removed: success

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• aeson-value-parser.cabal +6/−3
• library/Aeson/ValueParser.hs +42/−23

@@ -1,7 +1,7 @@ name:   aeson-value-parser version:-  0.11.4+  0.12 synopsis:   An API for parsing "aeson" JSON tree into Haskell types description:@@ -46,12 +46,15 @@     Aeson.ValueParser   build-depends:     ---    aeson >= 0.8 && < 2,+    aeson == 1.*,+    json-pointer == 0.1.*,+    json-pointer-aeson == 0.1.*,+    --      unordered-containers == 0.2.*,     vector >= 0.10 && < 0.12,     scientific == 0.3.*,     text == 1.*,     ---    success >= 0.2 && < 0.3,+    transformers >= 0.5 && < 0.7,     mtl-prelude < 3,     base-prelude >= 0.1.19 && < 2

@@ -7,11 +7,13 @@   -- * Value parsers   object,   array,+  null,   nullable,   string,   number,   bool,   fromJSON,+  pointed,   -- * Object parsers   Object,   field,@@ -27,30 +29,36 @@ ) where -import BasePrelude hiding (bool)+import BasePrelude hiding (bool, null) import MTLPrelude import Data.Text (Text) import Data.Scientific (Scientific) import qualified Data.Aeson as A import qualified Data.HashMap.Strict as B import qualified Data.Vector as C-import qualified Success.Pure as D+import qualified JSONPointer.Model as D+import qualified JSONPointer.Aeson.Interpreter as E   -- | -- A JSON 'A.Value' parser. newtype Value a =-  Value (ReaderT A.Value (D.Success Text) a)+  Value (ReaderT A.Value (Except (First Text)) a)   deriving (Functor, Applicative, Alternative, Monad, MonadPlus)  {-# INLINE run #-}-run :: Value a -> A.Value -> Either (Maybe Text) a+run :: Value a -> A.Value -> Either Text a run (Value effect) =-  D.asEither . runReaderT effect+  either (Left . fromMaybe "Unspecified failure" . getFirst) Right . runExcept . runReaderT effect --- -- * Value parsers--- -------------------------+-- * Value parsers+------------------------- +{-# INLINE aesonMatcher #-}+aesonMatcher :: (A.Value -> Either Text a) -> Value a+aesonMatcher matcher =+  Value $ ReaderT $ either (except . Left . First . Just) pure . matcher+ {-# INLINE array #-} array :: Array a -> Value a array (Array effect) =@@ -58,7 +66,7 @@     A.Array x ->       runReaderT effect x     _ ->-      D.failure "Not an array"+      (except . Left . First . Just) "Not an array"  {-# INLINE object #-} object :: Object a -> Value a@@ -67,16 +75,16 @@     A.Object x ->       runReaderT effect x     _ ->-      D.failure "Not an object"+      (except . Left . First . Just) "Not an object"  {-# INLINE null #-} null :: Value () null =-  Value $ ReaderT $ \case+  aesonMatcher $ \case     A.Null ->       pure ()     _ ->-      D.failure "Not null"+      Left "Not null"  {-# INLINE nullable #-} nullable :: Value a -> Value (Maybe a)@@ -90,52 +98,63 @@ {-# INLINE string #-} string :: Value Text string =-  Value $ ReaderT $ \case+  aesonMatcher $ \case     A.String t ->       pure t     _ ->-      D.failure "Not a string"+      Left "Not a string"  {-# INLINE number #-} number :: Value Scientific number =-  Value $ ReaderT $ \case+  aesonMatcher $ \case     A.Number x ->       pure x     _ ->-      D.failure "Not a number"+      Left "Not a number"  {-# INLINE bool #-} bool :: Value Bool bool =-  Value $ ReaderT $ \case+  aesonMatcher $ \case     A.Bool x ->        pure x     _ -> -      D.failure "Not a bool"+      Left "Not a bool"  {-# INLINE fromJSON #-} fromJSON :: A.FromJSON a => Value a fromJSON =   Value $ ReaderT $ A.fromJSON >>> \case-    A.Error m -> D.failure (fromString m)+    A.Error m -> (except . Left . First . Just) (fromString m)     A.Success r -> pure r +{-|+Lifts JSON Pointer.+-}+{-# INLINE pointed #-}+pointed :: D.JSONPointer -> Value a -> Value a+pointed pointer parser =+  aesonMatcher $ \value ->+  case E.value pointer value of+    Nothing -> Left (fromString (showString "Pointer \"" $ shows pointer "\" points to nothing"))+    Just pointedValue -> run parser pointedValue + -- * Object parsers -------------------------  -- | -- A JSON 'A.Object' parser. newtype Object a =-  Object (ReaderT A.Object (D.Success Text) a)+  Object (ReaderT A.Object (Except (First Text)) a)   deriving (Functor, Applicative, Alternative, Monad, MonadPlus)  {-# INLINE field #-} field :: Text -> Value a -> Object a field key (Value effect) =   Object $ ReaderT $-    maybe (D.failure $ "Object contains no field '" <> key <> "'") (runReaderT effect) .+    maybe ((except . Left . First . Just) $ "Object contains no field '" <> key <> "'") (runReaderT effect) .     B.lookup key  {-# INLINE fieldsMap #-}@@ -158,14 +177,14 @@ -- | -- A JSON 'A.Array' parser. newtype Array a =-  Array (ReaderT A.Array (D.Success Text) a)+  Array (ReaderT A.Array (Except (First Text)) a)   deriving (Functor, Applicative, Alternative, Monad, MonadPlus)  {-# INLINE element #-} element :: Int -> Value a -> Array a element element (Value effect) =   Array $ ReaderT $ -    maybe (D.failure $ "Array has no element '" <> (fromString . show) element <> "'") (runReaderT effect) .+    maybe ((except . Left . First . Just) $ "Array has no element '" <> (fromString . show) element <> "'") (runReaderT effect) .     flip (C.!?) element  {-# INLINE elementsVector #-}@@ -193,5 +212,5 @@ foldlElements1 :: (a -> a -> a) -> Value a -> Array a foldlElements1 step value =   foldlElements (\acc input -> maybe (Just input) (Just . flip step input) acc) Nothing value >>= \case-    Nothing -> Array $ lift $ D.failure "Empty array"+    Nothing -> Array $ lift $ (except . Left . First . Just) "Empty array"     Just x -> pure x