aeson-value-parser 0.14.3 → 0.15

raw patch · 3 files changed

+40/−90 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• aeson-value-parser.cabal +1/−1
• library/Aeson/ValueParser.hs +38/−89
• library/Aeson/ValueParser/Prelude.hs +1/−0

@@ -1,5 +1,5 @@ name: aeson-value-parser-version: 0.14.3+version: 0.15 synopsis: An API for parsing "aeson" JSON tree into Haskell types description: category: Data, JSON, Parsing

@@ -20,17 +20,11 @@   Object,   field,   oneOfFields,-  fieldOr,-  oneOfFieldsOr,-  possibleField,-  oneOfPossibleFields,   fieldMap,   foldlFields,   -- * Array parsers   Array,   element,-  elementOr,-  possibleElement,   elementVector,   foldlElements,   foldrElements,@@ -41,19 +35,26 @@ import qualified Aeson.ValueParser.Error as Error import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict as HashMap+import qualified Data.HashSet as HashSet import qualified Data.Scientific as Scientific import qualified Data.Text.Encoding as Text import qualified Data.Vector as Vector import qualified Aeson.ValueParser.Vector as Vector  +-- * Shared+-------------------------++type Parse ast = ReaderT ast (ExceptT Error.Error (Except Error.Error))++ -- * Value -------------------------  -- | -- A JSON 'Aeson.Value' parser. newtype Value a =-  Value (ReaderT Aeson.Value (Except Error.Error) a)+  Value (Parse Aeson.Value a)   deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadError Error.Error)  instance MonadFail Value where@@ -61,14 +62,14 @@  {-# INLINE run #-} run :: Value a -> Aeson.Value -> Either Error.Error a-run (Value effect) = runExcept . runReaderT effect+run (Value effect) = join . runExcept . runExceptT . runReaderT effect  -- ** Definitions -------------------------  {-# INLINE astMatcher #-} astMatcher :: (Aeson.Value -> Either Text a) -> Value a-astMatcher matcher = Value $ ReaderT $ except . left Error.message . matcher+astMatcher matcher = Value $ ReaderT $ either (throwE . Error.message) return . matcher  {-# INLINE array #-} array :: Array a -> Value a@@ -153,8 +154,8 @@ {-# INLINE fromJSON #-} fromJSON :: Aeson.FromJSON a => Value a fromJSON = Value $ ReaderT $ Aeson.fromJSON >>> \ case-  Aeson.Error m -> (except . Left) (fromString m)-  Aeson.Success r -> pure r+  Aeson.Success r -> return r+  Aeson.Error m -> lift $ throwE $ fromString m   -- * Object parsers@@ -163,7 +164,7 @@ -- | -- A JSON 'Aeson.Object' parser. newtype Object a =-  Object (ReaderT (HashMap Text Aeson.Value) (Except Error.Error) a)+  Object (Parse (HashMap Text Aeson.Value) a)   deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadError Error.Error)  instance MonadFail Object where@@ -171,67 +172,31 @@  {-# INLINE field #-} field :: Text -> Value a -> Object a-field key (Value effect) = Object $ ReaderT $ \ object -> except $ case HashMap.lookup key object of-  Just value -> case runExcept (runReaderT effect value) of-    Right parsedValue -> Right parsedValue-    Left error -> Left (Error.named key error)-  Nothing -> Left (Error.Error (pure key) "Object contains no such key")+field name fieldParser = Object $ ReaderT $ \ object -> case HashMap.lookup name object of+  Just value -> case run fieldParser value of+    Right parsedValue -> return parsedValue+    Left error -> lift $ throwE $ Error.named name error+  Nothing -> throwE (Error.Error (pure name) "Object contains no field with this name")  {-# INLINE oneOfFields #-} oneOfFields :: [Text] -> Value a -> Object a oneOfFields keys valueParser = asum (fmap (flip field valueParser) keys) -{-| Applies the value parser to the existing field, propagating its errors accordingly.-    Only if the field does not exist, it executes /Alternative branch/.-    IOW, it won't execute /Alternative branch/ if /Field parser/ fails.-    This is what distinguishes @fieldOr name parser@ from the seemingly same @mplus (field name parser)@ -}-fieldOr :: Text {-^ Field name -} -> Value a {-^ Field parser -} -> Object a {-^ Alternative branch -} -> Object a-fieldOr name (Value fieldParser) alt = join $ Object $ ReaderT $ \ object -> except $ case HashMap.lookup name object of-  Just value -> case runExcept (runReaderT fieldParser value) of-    Right parsedValue -> Right (return parsedValue)-    Left error -> Left (Error.named name error)-  Nothing -> Right alt--{-| Same as `fieldOr`,-    with the only difference that it enumerates the provided list of field names-    parsing the first existing one. -}-oneOfFieldsOr :: [Text] -> Value a -> Object a -> Object a-oneOfFieldsOr names valueParser objectParser =-  foldr (\ name -> fieldOr name valueParser) objectParser names--{-| Applies the value parser to the existing field, propagating its errors accordingly, but-    unlike `field` it doesn't fail if the field does not exist.-    The `Maybe` wrapper is there to cover such a case. -}-{-# INLINE possibleField #-}-possibleField :: Text -> Value a -> Object (Maybe a)-possibleField key (Value effect) = Object $ ReaderT $ \ object -> except $ case HashMap.lookup key object of-  Just value -> case runExcept (runReaderT effect value) of-    Right parsedValue -> Right (Just parsedValue)-    Left error -> Left (Error.named key error)-  Nothing -> Right Nothing--{-| Same as `possibleField`,-    with the only difference that it enumerates the provided list of field names-    parsing the first existing one. -}-{-# INLINE oneOfPossibleFields #-}-oneOfPossibleFields :: [Text] -> Value a -> Object (Maybe a)-oneOfPossibleFields keys valueParser = oneOfFieldsOr keys (fmap Just valueParser) (pure Nothing)- {-# INLINE fieldMap #-} fieldMap :: Value a -> Object (HashMap Text a)-fieldMap fieldParser = Object $ ReaderT $ except . HashMap.traverseWithKey mapping where+fieldMap fieldParser = Object $ ReaderT $ HashMap.traverseWithKey mapping where   mapping key ast = case run fieldParser ast of     Right parsedField -> return parsedField-    Left error -> Left (Error.named key error)+    Left error -> lift (throwE (Error.named key error))  {-# INLINE foldlFields #-} foldlFields :: (state -> Text -> field -> state) -> state -> Value field -> Object state-foldlFields step state fieldParser = Object $ ReaderT $ \ object -> except $ HashMap.foldlWithKey' newStep (pure state) object where-  newStep stateEither key fieldAst = case run fieldParser fieldAst of+foldlFields step state fieldParser = Object $ ReaderT $ \ object -> HashMap.foldlWithKey' newStep (pure state) object where+  newStep stateE key fieldAst = case run fieldParser fieldAst of     Right !parsedField -> do-      !state <- stateEither+      !state <- stateE       return $ step state key parsedField-    Left error -> Left (Error.named key error)+    Left error -> lift (throwE (Error.named key error))   -- * Array parsers@@ -240,7 +205,7 @@ -- | -- A JSON 'Aeson.Array' parser. newtype Array a =-  Array (ReaderT (Vector Aeson.Value) (Except Error.Error) a)+  Array (Parse (Vector Aeson.Value) a)   deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadError Error.Error)  instance MonadFail Array where@@ -248,44 +213,28 @@  {-# INLINE element #-} element :: Int -> Value a -> Array a-element index elementParser = Array $ ReaderT $ \ array -> except $ case array Vector.!? index of-  Just element -> case run elementParser element of-    Right result -> Right result-    Left error -> Left (Error.indexed index error)-  Nothing -> Left (Error.Error (pure (fromString (show index))) "Array contains no element by this index")--{-# INLINE elementOr #-}-elementOr :: Int -> Value a -> Array a -> Array a-elementOr index elementParser alt = join $ Array $ ReaderT $ \ array -> except $ case array Vector.!? index of-  Just element -> case run elementParser element of-    Right result -> Right (return result)-    Left error -> Left (Error.indexed index error)-  Nothing -> Right alt--{-# INLINE possibleElement #-}-possibleElement :: Int -> Value a -> Array (Maybe a)-possibleElement index elementParser = Array $ ReaderT $ \ array -> except $ case array Vector.!? index of+element index elementParser = Array $ ReaderT $ \ array -> case array Vector.!? index of   Just element -> case run elementParser element of-    Right result -> Right (Just result)-    Left error -> Left (Error.indexed index error)-  Nothing -> Right Nothing+    Right result -> return result+    Left error -> lift $ throwE $ Error.indexed index error+  Nothing -> throwE $ Error.Error (pure (fromString (show index))) "Array contains no element by this index"  {-# INLINE elementVector #-} elementVector :: Value a -> Array (Vector a)-elementVector elementParser = Array $ ReaderT $ \ arrayAst -> except $ flip Vector.imapM arrayAst $ \ index ast -> case run elementParser ast of-  Right element -> Right element-  Left error -> Left (Error.indexed index error)+elementVector elementParser = Array $ ReaderT $ \ arrayAst -> flip Vector.imapM arrayAst $ \ index ast -> case run elementParser ast of+  Right element -> return element+  Left error -> lift $ throwE $ Error.indexed index error  {-# INLINE foldlElements #-} foldlElements :: (state -> Int -> element -> state) -> state -> Value element -> Array state-foldlElements step state elementParser = Array $ ReaderT $ except . Vector.ifoldM' newStep state where+foldlElements step state elementParser = Array $ ReaderT $ Vector.ifoldM' newStep state where   newStep state index ast = case run elementParser ast of-    Right !element -> Right $ step state index element-    Left error -> Left (Error.indexed index error)+    Right element -> return $ step state index element+    Left error -> lift $ throwE $ Error.indexed index error  {-# INLINE foldrElements #-} foldrElements :: (Int -> element -> state -> state) -> state -> Value element -> Array state-foldrElements step state elementParser = Array $ ReaderT $ except . Vector.ifoldrM newStep state where+foldrElements step state elementParser = Array $ ReaderT $ Vector.ifoldrM newStep state where   newStep index ast nextState = case run elementParser ast of-    Right !element -> Right $ step index element nextState-    Left error -> Left (Error.indexed index error)+    Right element -> return $ step index element nextState+    Left error -> lift $ throwE $ Error.indexed index error

@@ -35,6 +35,7 @@ import Data.IORef as Exports import Data.Ix as Exports import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.List.NonEmpty as Exports (NonEmpty(..)) import Data.Maybe as Exports import Data.Monoid as Exports hiding (Last(..), First(..), (<>)) import Data.Ord as Exports