aeson-value-parser 0.12.4 → 0.13
raw patch · 3 files changed
+189/−142 lines, 3 filesdep +basedep +mtldep −base-preludedep −mtl-preludePVP ok
version bump matches the API change (PVP)
Dependencies added: base, mtl
Dependencies removed: base-prelude, mtl-prelude
API changes (from Hackage documentation)
Files
- aeson-value-parser.cabal +26/−45
- library/Aeson/ValueParser.hs +56/−97
- library/Aeson/ValueParser/Prelude.hs +107/−0
aeson-value-parser.cabal view
@@ -1,59 +1,40 @@-name:- aeson-value-parser-version:- 0.12.4-synopsis:- An API for parsing "aeson" JSON tree into Haskell types+name: aeson-value-parser+version: 0.13+synopsis: An API for parsing "aeson" JSON tree into Haskell types description:-category:- Data, JSON, Parsing-homepage:- https://github.com/sannsyn/aeson-value-parser-bug-reports:- https://github.com/sannsyn/aeson-value-parser/issues-author:- Nikita Volkov <nikita.y.volkov@mail.ru>-maintainer:- Nikita Volkov <nikita.y.volkov@mail.ru>-copyright:- (c) 2015, Sannsyn AS-license:- MIT-license-file:- LICENSE-build-type:- Simple-cabal-version:- >=1.10+category: Data, JSON, Parsing+homepage: https://github.com/sannsyn/aeson-value-parser+bug-reports: https://github.com/sannsyn/aeson-value-parser/issues+author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2015, Sannsyn AS+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >=1.10 source-repository head- type:- git- location:- git://github.com/sannsyn/aeson-value-parser.git+ type: git+ location: git://github.com/sannsyn/aeson-value-parser.git library- hs-source-dirs:- library- default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples- default-language:- Haskell2010+ hs-source-dirs: library+ default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language: Haskell2010 exposed-modules: Aeson.ValueParser+ other-modules:+ Aeson.ValueParser.Prelude build-depends:- -- aeson ==1.*,+ base >=4.9 && <5,+ bytestring >=0.10 && <0.12,+ foldl >=1.3 && <2, json-pointer ==0.1.*, json-pointer-aeson ==0.1.*,- --- unordered-containers ==0.2.*,- vector >=0.10 && <0.13,+ mtl >=2.2 && <3, scientific ==0.3.*, text ==1.*,- bytestring >=0.10 && <0.12,- --- foldl >=1.3 && <2, transformers >=0.5 && <0.7,- mtl-prelude <3,- base-prelude >=0.1.19 && <2+ unordered-containers ==0.2.*,+ vector >=0.10 && <0.13
library/Aeson/ValueParser.hs view
@@ -33,18 +33,14 @@ ) where -import BasePrelude hiding (bool, null)-import MTLPrelude-import Data.Text (Text)-import Data.Scientific (Scientific)-import Data.ByteString (ByteString)-import Control.Foldl (Fold(..))+import Aeson.ValueParser.Prelude hiding (bool, null) import qualified Data.Aeson as A import qualified Data.HashMap.Strict as B import qualified Data.Vector as C import qualified Data.Text.Encoding as F import qualified JSONPointer.Model as D import qualified JSONPointer.Aeson.Interpreter as E+import qualified Data.Scientific as Scientific -- |@@ -55,107 +51,85 @@ {-# INLINE run #-} run :: Value a -> A.Value -> Either Text a-run (Value effect) =- runExcept . runReaderT effect+run (Value effect) = runExcept . runReaderT effect -- * Value parsers ------------------------- {-# INLINE aesonMatcher #-} aesonMatcher :: (A.Value -> Either Text a) -> Value a-aesonMatcher matcher =- Value $ ReaderT $ either (except . Left) pure . matcher+aesonMatcher matcher = Value $ ReaderT $ either (except . Left) pure . matcher {-# INLINE array #-} array :: Array a -> Value a-array (Array effect) =- Value $ ReaderT $ \case- A.Array x ->- runReaderT effect x- _ ->- (except . Left) "Not an array"+array (Array effect) = Value $ ReaderT $ \ case+ A.Array x -> runReaderT effect x+ _ -> (except . Left) "Not an array" {-# INLINE object #-} object :: Object a -> Value a-object (Object effect) =- Value $ ReaderT $ \case- A.Object x ->- runReaderT effect x- _ ->- (except . Left) "Not an object"+object (Object effect) = Value $ ReaderT $ \ case+ A.Object x -> runReaderT effect x+ _ -> (except . Left) "Not an object" {-# INLINE null #-} null :: Value ()-null =- aesonMatcher $ \case- A.Null ->- pure ()- _ ->- Left "Not null"+null = aesonMatcher $ \ case+ A.Null -> pure ()+ _ -> Left "Not null" {-# INLINE nullable #-} nullable :: Value a -> Value (Maybe a)-nullable (Value impl) =- Value $ ReaderT $ \case- A.Null ->- pure Nothing- x ->- fmap Just (runReaderT impl x)+nullable (Value impl) = Value $ ReaderT $ \ case+ A.Null -> pure Nothing+ x -> fmap Just (runReaderT impl x) {-# INLINE string #-} string :: Value Text-string =- aesonMatcher $ \case- A.String t ->- pure t- _ ->- Left "Not a string"+string = aesonMatcher $ \ case+ A.String t -> pure t+ _ -> Left "Not a string" {-# INLINE stringAsBytes #-} stringAsBytes :: Value ByteString-stringAsBytes =- F.encodeUtf8 <$> string+stringAsBytes = F.encodeUtf8 <$> string {-# INLINE number #-} number :: Value Scientific-number =- aesonMatcher $ \case- A.Number x ->- pure x- _ ->- Left "Not a number"+number = aesonMatcher $ \ case+ A.Number x -> pure x+ _ -> Left "Not a number" {-# INLINE numberAsInt #-} numberAsInt :: Value Int-numberAsInt =- round <$> number+numberAsInt = aesonMatcher $ \case+ A.Number x -> if Scientific.isInteger x+ then case Scientific.toBoundedInteger x of+ Just int -> Right int+ Nothing -> Left ("Number " <> showText x <> " is out of integer range")+ else Left ("Number " <> showText x <> " is not an integer")+ _ -> Left "Not a number" {-# INLINE bool #-} bool :: Value Bool-bool =- aesonMatcher $ \case- A.Bool x -> - pure x- _ -> - Left "Not a bool"+bool = aesonMatcher $ \ case+ A.Bool x -> pure x+ _ -> Left "Not a bool" {-# INLINE fromJSON #-} fromJSON :: A.FromJSON a => Value a-fromJSON =- Value $ ReaderT $ A.fromJSON >>> \case- A.Error m -> (except . Left) (fromString m)- A.Success r -> pure r+fromJSON = Value $ ReaderT $ A.fromJSON >>> \ case+ A.Error m -> (except . Left) (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+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@@ -169,28 +143,22 @@ {-# INLINE field #-} field :: Text -> Value a -> Object a-field key (Value effect) =- Object $ ReaderT $- maybe ((except . Left) $ "Object contains no field '" <> key <> "'") (runReaderT effect) .- B.lookup key+field key (Value effect) = Object $ ReaderT $+ maybe ((except . Left) $ "Object contains no field '" <> key <> "'") (runReaderT effect) .+ B.lookup key {-# INLINE fieldsMap #-} fieldsMap :: Value a -> Object (B.HashMap Text a)-fieldsMap (Value effect) =- Object $ ReaderT $ mapM (runReaderT effect)+fieldsMap (Value effect) = Object $ ReaderT $ mapM (runReaderT effect) {-# INLINE foldFields #-} foldFields :: Fold (Text, field) object -> Value field -> Object object-foldFields (Fold foldStep foldInit foldEnd) value =- fmap foldEnd (foldlFields foldStep foldInit value)+foldFields (Fold foldStep foldInit foldEnd) value = fmap foldEnd (foldlFields foldStep foldInit value) {-# INLINE foldlFields #-} foldlFields :: (a -> (Text, b) -> a) -> a -> Value b -> Object a-foldlFields step init (Value impl) =- Object $ ReaderT $ B.foldlWithKey' step' (pure init)- where- step' acc' key value =- acc' >>= \acc -> fmap (step acc . (,) key) (runReaderT impl value)+foldlFields step init (Value impl) = Object $ ReaderT $ B.foldlWithKey' step' (pure init) where+ step' acc' key value = acc' >>= \acc -> fmap (step acc . (,) key) (runReaderT impl value) -- * Array parsers@@ -204,40 +172,31 @@ {-# INLINE element #-} element :: Int -> Value a -> Array a-element element (Value effect) =- Array $ ReaderT $ - maybe ((except . Left) $ "Array has no element '" <> (fromString . show) element <> "'") (runReaderT effect) .- flip (C.!?) element+element element (Value effect) = Array $ ReaderT $+ maybe ((except . Left) $ "Array has no element '" <> (fromString . show) element <> "'") (runReaderT effect) .+ flip (C.!?) element {-# INLINE elementsVector #-} elementsVector :: Value a -> Array (C.Vector a)-elementsVector (Value effect) =- Array $ ReaderT $ mapM (runReaderT effect)+elementsVector (Value effect) = Array $ ReaderT $ mapM (runReaderT effect) {-# INLINE foldElements #-} foldElements :: Fold element array -> Value element -> Array array-foldElements (Fold foldStep foldInit foldEnd) value =- fmap foldEnd (foldlElements foldStep foldInit value)+foldElements (Fold foldStep foldInit foldEnd) value = fmap foldEnd (foldlElements foldStep foldInit value) {-# INLINE foldlElements #-} foldlElements :: (a -> b -> a) -> a -> Value b -> Array a-foldlElements step init (Value impl) =- Array $ ReaderT $ foldlM step' init- where- step' acc element =- fmap (step acc) (runReaderT impl element)+foldlElements step init (Value impl) = Array $ ReaderT $ foldlM step' init where+ step' acc element = fmap (step acc) (runReaderT impl element) {-# INLINE foldrElements #-} foldrElements :: (b -> a -> a) -> a -> Value b -> Array a-foldrElements step init (Value impl) =- Array $ ReaderT $ foldrM step' init- where- step' element acc =- fmap (flip step acc) (runReaderT impl element)+foldrElements step init (Value impl) = Array $ ReaderT $ foldrM step' init where+ step' element acc = fmap (flip step acc) (runReaderT impl element) {-# INLINE foldlElements1 #-} 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+ foldlElements (\acc input -> maybe (Just input) (Just . flip step input) acc) Nothing value >>= \ case Nothing -> Array $ lift $ (except . Left) "Empty array" Just x -> pure x
+ library/Aeson/ValueParser/Prelude.hs view
@@ -0,0 +1,107 @@+module Aeson.ValueParser.Prelude+(+ module Exports,+ showText,+)+where+++-- base+-------------------------+import Control.Applicative as Exports+import Control.Arrow as Exports+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.IO.Class as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.ST as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports hiding (toList)+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports+import Data.Functor.Identity as Exports+import Data.Int as Exports+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.Maybe as Exports+import Data.Monoid as Exports hiding (Last(..), First(..), (<>))+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.Semigroup as Exports+import Data.STRef as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports hiding (sizeOf, alignment)+import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)+import GHC.Exts as Exports (lazy, inline, sortWith, groupWith, IsList(..))+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import Numeric as Exports+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (printf, hPrintf)+import Text.Read as Exports (Read(..), readMaybe, readEither)+import Unsafe.Coerce as Exports++-- foldl+-------------------------+import Control.Foldl as Exports (Fold(..), FoldM(..))++-- transformers+-------------------------+import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Except as Exports hiding (liftCatch, liftCallCC)+import Control.Monad.Trans.Reader as Exports hiding (liftCatch, liftCallCC)++-- mtl+-------------------------+import Control.Monad.Error.Class as Exports++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)++-- text+-------------------------+import Data.Text as Exports (Text)++-- unordered-containers+-------------------------+import Data.HashMap.Strict as Exports (HashMap)++-- scientific+-------------------------+import Data.Scientific as Exports (Scientific)+++showText :: Show a => a -> Text+showText = fromString . show