packages feed

aeson-combinators 0.0.2.1 → 0.0.3.0

raw patch · 6 files changed

+385/−206 lines, 6 filesdep +doctestdep +semigroupsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: doctest, semigroups

Dependency ranges changed: base

API changes (from Hackage documentation)

+ Data.Aeson.Combinators.Decode: either :: Decoder a -> Decoder (Either String a)
+ Data.Aeson.Combinators.Decode: maybe :: Decoder a -> Decoder (Maybe a)
+ Data.Aeson.Combinators.Decode: oneOf :: NonEmpty (Decoder a) -> Decoder a
+ Data.Aeson.Combinators.Decode: parseEither :: Decoder a -> Value -> Either String a
+ Data.Aeson.Combinators.Decode: parseMaybe :: Decoder a -> Value -> Maybe a

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # Revision history for aeson-combinators +## 0.0.3.0 -- 2020-10-11+* Combinators for dealing with failure+* `oneOf` function+* `parseMaybe` and `parseEither`+* Documentation improvements+ ## 0.0.2.1 -- 2020-03-08 * Add README to extra source files 
+ DocTest.hs view
@@ -0,0 +1,5 @@+import Test.DocTest+main = doctest [ "-isrc"+               , "-XOverloadedStrings"+               , "lib/Data/Aeson/Combinators/Decode.hs"+               ]
README.md view
@@ -1,8 +1,10 @@ # Aeson Combinators  [![Build Status](https://travis-ci.org/turboMaCk/aeson-combinators.svg?branch=master)](https://travis-ci.org/turboMaCk/aeson-combinators)+[![Build Status](https://img.shields.io/endpoint.svg?url=https%3A%2F%2Factions-badge.atrox.dev%2FturboMaCk%2Faeson-combinators%2Fbadge%3Fref%3Dmaster&style=flat)](https://actions-badge.atrox.dev/turboMaCk/aeson-combinators/goto?ref=master)+[![built with nix](https://builtwithnix.org/badge.svg)](https://builtwithnix.org) -This library defines [**low overhead**](#internals) value space `Decoder`+[**Low overhead**](#internals) value space `Decoder` on top of Aeson's Parser for combinator style decoding.  This library is compatible with GHC **7.6** and later as well as recent versions of **GHCJS**.@@ -14,9 +16,8 @@  ## Internals -This library introduces as low overhead over Aeson API as possible.-`Decoder a` type is a function `Value -> Parser a` same as `fromJSON`-function of `FromJSON` class. This means there should be near zero overhead.+`Decoder a` type is a function `Value -> Parser a` the same as `fromJSON`+member function of `FromJSON` class. This means there should be near zero overhead. Aeson types and functions are reused where possible.  ## TODO
aeson-combinators.cabal view
@@ -1,9 +1,9 @@ cabal-version:       >=1.10 name:                aeson-combinators-version:             0.0.2.1+version:             0.0.3.0 synopsis:            Aeson combinators for dead simple JSON decoding description:-    This library defines low overhead value space `Decoder`+    Low overhead value space `Decoder`     on top of Aeson's Parser for combinator style decoding.  bug-reports:         https://github.com/turboMaCk/aeson-combinators/issues@@ -23,8 +23,14 @@                    , GHC == 7.6.3                    , GHC == 8.4.4                    , GHC == 8.6.5+                   , GHC == 8.8.3+                   , GHC == 8.10.1                    , GHCJS == 8.6.0.1 +Flag doctest+  default: True+  manual: True+ library   exposed-modules:     Data.Aeson.Combinators.Decode   -- other-modules:@@ -46,7 +52,12 @@                      , scientific   hs-source-dirs:      lib   default-language:    Haskell2010+  hs-source-dirs:      lib +  if impl(ghc <= 8.0)+      build-depends:     semigroups++ test-suite spec     type:              exitcode-stdio-1.0     hs-source-dirs:    test@@ -61,6 +72,23 @@                      , utf8-string     ghc-options:       -Wall     default-language:  Haskell2010++test-suite doctest+    default-language:   Haskell2010+    type:               exitcode-stdio-1.0+    main-is:            DocTest.hs+    default-extensions: OverloadedStrings++    if !flag(doctest)+        buildable: False+    else+        build-depends:    base+                        , doctest++    if impl(ghc <= 8.0)+       -- Older version has problem with CPP macros+       buildable: False+  source-repository head   type:              git
lib/Data/Aeson/Combinators/Decode.hs view
@@ -10,13 +10,14 @@ -- -- Aeson decoding API is closed over the type class 'FromJSON'. -- Because of this there is one to one mapping between JSON--- format and data decoded from it.--- While this is handy in many situations it forces+-- format and data decoded from it (decoding is closed over types).+-- While this is handy in many situations, in others it forces -- users of Aeson library to define proxy types and--- data wrappers just for sake of implementing instance--- of 'FromJSON'.+-- data wrappers just for sake of implementing multiple instances+-- of 'FromJSON' class. -- This module provides value level 'Decoder' which can be used--- instead of instance implementation.+-- instead of instance implementation to define any number of JSON+-- decoders for the same data type. -- module Data.Aeson.Combinators.Decode (   -- * Example Usage@@ -26,8 +27,32 @@   -- $applicative     Decoder(..)   , auto+-- * Decoding Containers+-- *** Maybe+  , nullable+-- *** Sequences+  , list, vector+-- *** Hashmap+  , hashMapLazy, hashMapStrict+-- *** Map+  , mapLazy, mapStrict+-- * Combinators+  , jsonNull+-- *** Objects+  , key+  , at+-- *** Arrays+  , index+  , indexes+-- *** Path+-- $jsonpath+  , element+  , path+-- *** Dealing With Failure+  , maybe+  , either+  , oneOf -- * Decoding Primitive Values--- -- *** Void, Unit, Bool   , void   , unit, bool@@ -37,42 +62,21 @@ #if (MIN_VERSION_base(4,8,0))   , natural #endif--- *** Floating Points+-- *** Real Numbers   , float, double   , scientific -- *** Strings   , char, text, string   , uuid, version--- * Decoding Time+-- * Time   , zonedTime, localTime, timeOfDay   , utcTime   , day #if (MIN_VERSION_time_compat(1,9,2))   , dayOfWeek #endif--- * Decodeing Containers--- *** Maybe-  , nullable--- *** Sequences-  , list, vector--- *** Hashmap-  , hashMapLazy, hashMapStrict--- *** Map-  , mapLazy, mapStrict--- * Combinators-  , jsonNull--- *** Objects:-  , key-  , at--- *** Arrays-  , index-  , indexes--- *** Path--- $jsonpath-  , element-  , path--- * Running Decoders--- $running+-- * Decoding ByteStrings+-- $decoding -- *** Decoding From Byte Strings   , decode, decode'   , eitherDecode, eitherDecode'@@ -81,21 +85,34 @@ -- *** Decoding Files   , decodeFileStrict, decodeFileStrict'   , eitherDecodeFileStrict, eitherDecodeFileStrict'+-- * Parsing (Running Decoders)+  , parseMaybe+  , parseEither   ) where +import           Prelude                    hiding (either, fail, maybe)+import qualified Prelude                    (either)+ import           Control.Applicative import           Control.Monad              hiding (void) import           Control.Monad.Fail         (MonadFail (..)) import qualified Control.Monad.Fail         as Fail+ import           Data.Aeson.Internal        (JSONPath, JSONPathElement (..)) import qualified Data.Aeson.Internal        as AI import qualified Data.Aeson.Parser          as Parser import qualified Data.Aeson.Parser.Internal as ParserI-import           Data.Aeson.Types+import           Data.Aeson.Types           hiding (parseEither, parseMaybe)+import qualified Data.Aeson.Types           as ATypes+ import qualified Data.ByteString            as B import qualified Data.ByteString.Lazy       as LB-import           Data.Int                   (Int16, Int32, Int64, Int8)+import           Data.List.NonEmpty         (NonEmpty (..)) import           Data.Text                  (Text)+import qualified Data.Vector                as Vector++-- Data imports+import           Data.Int                   (Int16, Int32, Int64, Int8) import           Data.Time.Calendar         (Day) #if (MIN_VERSION_time_compat(1,9,2)) import           Data.Time.Calendar.Compat  (DayOfWeek)@@ -104,7 +121,6 @@ import           Data.Time.LocalTime        (LocalTime, TimeOfDay, ZonedTime) import           Data.UUID.Types            (UUID) import           Data.Vector                (Vector, (!?))-import qualified Data.Vector                as Vector import           Data.Version               (Version) import           Data.Void                  (Void) import           Data.Word                  (Word, Word16, Word32, Word64,@@ -118,14 +134,16 @@ import qualified Data.Map.Strict            as MS import           Data.Scientific            (Scientific) import           Data.Traversable           (traverse)-import           Prelude                    hiding (fail) + -- $usage--- As mentioned above, combinators and type classes can be used together.+-- Combinators and type classes can be used together. -- -- __Decode type nested in json__ ----- > {-# LANGUAGE DeriveGeneric #-}+-- >>> :set -XOverloadedStrings+-- >>> :set -XDeriveGeneric+-- -- > import Data.Text -- > import Data.ByteString.Lazy (ByteString) -- > import Data.Aeson.Types@@ -142,7 +160,6 @@ -- > decodeEmbededPerson :: [Text] -> ByteString -> Maybe Person -- > decodeEmbededPerson path json = -- >     ACD.decode (ACD.at path ACD.auto) json--- > -- -- Now we can extract Person from any key within the json. --@@ -153,13 +170,14 @@ -- -- > -- data Person defined above ^ -- >--- >  type Token = Text+-- > -- using alias for simplicity+-- > type Token = Text -- >--- >  decodePersonWithToken :: ByteString -> Maybe (Token, Person)--- >  decodePersonWithToken json = ACD.decode decoder json--- >      where decoder =--- >              (,) <$> ACD.key "token" ACD.text--- >                  <*> ACD.key "person" ACD.auto+-- > decodePersonWithToken :: ByteString -> Maybe (Token, Person)+-- > decodePersonWithToken json = ACD.decode decoder json+-- >     where decoder =+-- >             (,) <$> ACD.key "token" ACD.text+-- >                 <*> ACD.key "person" ACD.auto -- -- Which can be used as following --@@ -189,8 +207,7 @@ -- > Just (Person {name = "Joe", age = 12})  --- | === JSON Decoder---+-- | -- A value describing how other values are decoded from JSON. -- This type is an alternative to Aeson's 'FromJSON' instance implementation. --@@ -203,16 +220,17 @@ -- 'eitherDecodeFileStrict', 'eitherDecodeFileStrict'' -- also provided by this module. ----- ==== Using Instances of Decoder--- __Functor to map function over 'Decoder'__+-- When working with 'Value', use 'parseMaybe' or 'parseEither' function. --+-- === Functor to map function over 'Decoder'+-- -- > intToString :: Decoder String -- > intToString = show <$> Decode.int -- -- > >>> decode intToString "2" -- > Just "2" ----- __Applicative to construct products__+-- === Applicative to construct products -- -- > stringIntPair :: Decoder (String, Int) -- > stringIntPair = (,) <$> index 0 string@@ -221,7 +239,7 @@ -- > >>> decode stringIntPair "[\"hello\", 42]" -- > Just ("hello", 42) ----- __Alternative to construct sums__+-- === Alternative to construct sums -- -- > eitherTextOrInt :: Decoder (Either Text Int) -- > eitherTextOrInt = Left  <$> Decode.text@@ -232,7 +250,7 @@ -- > >>> decode eitherTextOrInt "42" -- > Just (Right 42) ----- __Monad for 'Decoder' chaining__+-- === Monad for 'Decoder' chaining -- -- > odd :: Decoder Int -- > odd = do@@ -261,6 +279,7 @@   {-# INLINE (<*>) #-}  instance Monad Decoder where+  return = pure   (Decoder a) >>= f = Decoder $     \val -> case parse a val of       Success v -> let (Decoder res) = f v@@ -281,7 +300,6 @@   fail s = Decoder $ \_ -> Fail.fail s   {-# INLINE fail #-} --- Basic Decoders  -- | 'Decoder' is compatible with Aeson's 'FromJSON' class. -- 'auto' decoder acts like a proxy to instance implementation.@@ -294,6 +312,213 @@ auto = Decoder parseJSON {-# INLINE auto #-} ++-- Continer Decoders++-- | Decode JSON null and other JSON value to 'Data.Maybe'.+-- JSON null will be decoded to 'Nothing'.+-- Other value decoded by provided 'Decoder' to 'Just'+nullable :: Decoder a -> Decoder (Maybe a)+nullable (Decoder d) = Decoder $ \case+  Null  -> pure Nothing+  other -> Just <$> d other+{-# INLINE nullable #-}+++-- | Decode JSON array of values to '[a]' of values+-- using provided 'Decoder'.+list :: Decoder a -> Decoder [a]+list (Decoder d) = Decoder $+  listParser d+{-# INLINE list #-}+++-- | Decode JSON array of values to 'Vector' of values+-- using provided 'Decoder'.+vector :: Decoder a -> Decoder (Vector a)+vector (Decoder d) = Decoder $ \case+  Array v -> Vector.mapM d v+  other   -> typeMismatch "Array" other+{-# INLINE vector #-}+++-- | Decode JSON object to 'HL.HashMap' with 'Data.Text' key+-- using provided 'Decoder'.+hashMapLazy :: Decoder a -> Decoder (HL.HashMap Text a)+hashMapLazy (Decoder d) = Decoder $ \case+  Object xs -> traverse d xs+  val       -> typeMismatch "Array" val+{-# INLINE hashMapLazy #-}+++-- | Decode JSON object to 'HS.HashMap' with 'Data.Text' key+-- using provided 'Decoder'.+hashMapStrict :: Decoder a -> Decoder (HS.HashMap Text a)+hashMapStrict (Decoder d) = Decoder $ \case+  Object xs -> traverse d xs+  val       -> typeMismatch "Array" val+{-# INLINE hashMapStrict #-}+++-- | Decode JSON object to 'ML.Map' with 'Data.Text' key+-- using provided 'Decoder'.+mapLazy :: Decoder a -> Decoder (ML.Map Text a)+mapLazy dec = ML.fromList . HL.toList <$> hashMapLazy dec+{-# INLINE mapLazy #-}+++-- | Decode JSON object to 'MS.Map' with 'Data.Text' key+-- using provided 'Decoder'.+mapStrict :: Decoder a -> Decoder (MS.Map Text a)+mapStrict dec = MS.fromList . HL.toList <$> hashMapLazy dec+{-# INLINE mapStrict #-}+++-- Combinators++-- | Decode JSON null to any value.+-- This function is useful for decoding+-- constructors which represented by null in JSON.+--+-- > data Codomain = NotSet | Foo | Bar+-- >+-- > myDomainDecoder :: Decoder Codomain+-- > myDomainDecoder = jsonNull NotSet+-- >               <|> (text >>= fooBar)+-- >    where fooBar "foo"   = return Foo+-- >          fooBar "bar"   = return Bar+-- >          fooBar unknown = fail $ "Unknown value " <> show unknown+jsonNull :: a -> Decoder a+jsonNull a = Decoder $ \case+  Null -> pure a+  val  -> typeMismatch "null" val+{-# INLINE jsonNull #-}+++-- | Extract JSON value from JSON object key+--+-- >>> decode (key "data" int) "{\"data\": 42}"+-- Just 42+key :: Text -> Decoder a -> Decoder a+key t (Decoder d) = Decoder $ \case+  Object v -> d =<< v .: t+  val      -> typeMismatch "Object" val+{-# INLINE key #-}+++-- | Extract JSON value from JSON object keys+--+-- >>> decode (at ["data", "value"] int) "{\"data\": {\"value\": 42}}"+-- Just 42+at :: [Text] -> Decoder a -> Decoder a+at pth d = foldr key d pth+{-# INLINE at #-}+++-- | Extract JSON value from JSON array index+--+-- >>> decode (index 2 int) "[0,1,2,3,4]"+-- Just 2+index :: Int -> Decoder a -> Decoder a+index i (Decoder d) = Decoder $ \val ->+  case val of+    Array vec -> case vec !? i of+                    Just v  -> d v+                    Nothing -> unexpected val+    _         -> typeMismatch "Array" val+{-# INLINE index #-}+++-- | Extract JSON value from JSON array indexes+--+-- > >>> decode (indexes [0,1,0] int) "[[true, [42]]]"+-- > Just 42+indexes :: [Int] -> Decoder a -> Decoder a+indexes pth d = foldr index d pth+{-# INLINE indexes #-}+++-- $jsonpath+-- Combinators using Aeson's 'JSONPathElement' and 'JSONPath' types.+-- This makes it possible to combine object keys and array index accessors.++-- | Decode value from JSON structure.+--+-- From object key:+--+-- >>> decode (element (Key "data") text) "{\"data\": \"foo\"}"+-- Just "foo"+--+-- From array index:+--+-- >>> decode (element (Index 1) int) "[0,1,2]"+-- Just 1+element :: JSONPathElement -> Decoder a -> Decoder a+element (Key txt) = key txt+element (Index i) = index i+{-# INLINE element #-}+++-- | Decode value from deep JSON structure.+--+-- >>> decode (path [Key "data", Index 0] bool) "{\"data\":[true, false, false]}"+-- Just True+path :: JSONPath -> Decoder a -> Decoder a+path pth d = foldr element d pth+{-# INLINE path #-}+++-- | Try a decoder and get back a 'Just a' if it succeeds and 'Nothing' if it fails.+-- In other words, this decoder always succeeds with a 'Maybe a' value.+--+-- >>> decode (maybe string) "42"+-- Just Nothing+-- >>> decode (maybe int) "42"+-- Just (Just 42)+maybe :: Decoder a -> Decoder (Maybe a)+maybe (Decoder d) =+  Decoder $ \val ->+    case parse d val of+      Success x -> pure (Just x)+      Error _   -> pure Nothing+{-# INLINE maybe #-}+++-- | Try a decoder and get back a 'Right a' if it succeeds and a 'Left String' if it fails.+-- In other words, this decoder always succeeds with an 'Either String a' value.+--+-- >>> decode (either string) "42"+-- Just (Left "expected String, but encountered Number")+-- >>> decode (either int) "42"+-- Just (Right 42)+either :: Decoder a -> Decoder (Either String a)+either (Decoder d) =+  Decoder $ \val ->+    case parse d val of+      Success x -> pure (Right x)+      Error err -> pure (Left err)+{-# INLINE either #-}+++-- | Try a number of decoders in order and return the first success.+--+-- >>> import Data.List.NonEmpty+-- >>> decode (oneOf $ (words <$> string) :| [ list string ]) "\"Hello world!\""+-- Just ["Hello","world!"]+-- >>> decode (oneOf $ (list string) :| [  words <$> string ] ) "[\"Hello world!\"]"+-- Just ["Hello world!"]+-- >>> decode (oneOf $ (Right <$> bool) :| [ return (Left "Not a boolean") ]) "false"+-- Just (Right False)+-- >>> decode (oneOf $ (Right <$> bool) :| [ return (Left "Not a boolean") ]) "42"+-- Just (Left "Not a boolean")+oneOf :: NonEmpty (Decoder a) -> Decoder a+oneOf (first :| rest) =+  foldl (<|>) first rest+{-# INLINE oneOf #-}+++-- Basic Decoders+ -- | Decode any JSON value to 'Void' value -- which is impossible to construct. --@@ -302,46 +527,55 @@ void = auto {-# INLINE void #-} + -- | Decode JSON null into '()' unit :: Decoder () unit = auto {-# INLINE unit #-} + -- | Decode JSON booleans to Haskell 'Data.Bool' bool :: Decoder Bool bool = auto {-# INLINE bool #-} + -- | Decode JSON number to 'Data.Int.Int' int :: Decoder Int int = auto {-# INLINE int #-} + -- | Decode JSON number to 'Data.Int.Int8' int8 :: Decoder Int8 int8 = auto {-# INLINE int8 #-} + -- | Decode JSON number to 'Data.Int.Int16' int16 :: Decoder Int16 int16 = auto {-# INLINE int16 #-} + -- | Decode JSON number to 'Data.Int.Int32' int32 :: Decoder Int32 int32 = auto {-# INLINE int32 #-} + -- | Decode JSON number to 'Data.Int.Int64' int64 :: Decoder Int64 int64 = auto {-# INLINE int64 #-} + -- | Decode JSON number to unbounded 'Integer' integer :: Decoder Integer integer = auto {-# INLINE integer #-} + #if (MIN_VERSION_base(4,8,0)) -- | Decode JSON number to GHC's 'GHC.Natural' (non negative) --@@ -351,26 +585,31 @@ {-# INLINE natural #-} #endif + -- | Decode JSON number to bounded 'Data.Word.Word' word :: Decoder Word word = auto {-# INLINE word #-} + -- | Decode JSON number to bounded 'Data.Word.Word8' word8 :: Decoder Word8 word8 = auto {-# INLINE word8 #-} + -- | Decode JSON number to bounded 'Data.Word.Word16' word16 :: Decoder Word16 word16 = auto {-# INLINE word16 #-} + -- | Decode JSON number to bounded 'Data.Word.Word32' word32 :: Decoder Word32 word32 = auto {-# INLINE word32 #-} + -- | Decode JSON number to bounded 'Data.Word.Word64' word64 :: Decoder Word64 word64 = auto@@ -382,41 +621,49 @@ float = auto {-# INLINE float #-} + -- | Decode JSON number to 'Double' double :: Decoder Double double = auto {-# INLINE double #-} + -- | Decode JSON number to arbitrary precision 'Scientific' scientific :: Decoder Scientific scientific = auto {-# INLINE scientific #-} + -- | Decode single character JSON string to 'Data.Char' char :: Decoder Char char = auto {-# INLINE char #-} + -- | Decode JSON string to 'Data.String' string :: Decoder String string = auto {-# INLINE string #-} + -- | Decode JSON string to 'Data.Text' text :: Decoder Text text = auto {-# INLINE text #-} + -- | Decode JSON string to 'Data.UUID.Types.UUID' uuid :: Decoder UUID uuid = auto {-# INLINE uuid #-} + -- | Decode JSON string to 'Data.Version' version :: Decoder Version version = auto {-# INLINE version #-} + -- | Decode JSON string to 'Data.Local.Time.ZonedTime' -- using Aeson's instance implementation. --@@ -429,30 +676,35 @@ zonedTime = auto {-# INLINE zonedTime #-} + -- | Decode JSON string to 'Data.Local.Time.LocalTime' -- using Aeson's instance implementation. localTime :: Decoder LocalTime localTime = auto {-# INLINE localTime #-} + -- | Decode JSON string to 'Data.Local.Time.TimeOfDay' -- using Aeson's instance implementation. timeOfDay :: Decoder TimeOfDay timeOfDay = auto {-# INLINE timeOfDay #-} + -- | Decode JSON string to 'Data.Time.Clock.UTCTime' -- using Aesons's instance implementation utcTime :: Decoder UTCTime utcTime = auto {-# INLINE utcTime #-} + -- | Decode JSON string to 'Data.Time.Calendar.Day' -- using Aesons's instance implementation day :: Decoder Day day = auto {-# INLINE day #-} + #if (MIN_VERSION_time_compat(1,9,2)) -- | Decode JSON string to 'Data.Time.Calendar.Compat.DayOfWeek' -- using Aesons's instance implementation@@ -464,152 +716,11 @@ #endif  --- Continer Decoders --- | Decode JSON null and other JSON value to 'Data.Maybe'.--- JSON null will be decoded to 'Nothing'.--- Other value decoded by provided 'Decoder' to 'Just'-nullable :: Decoder a -> Decoder (Maybe a)-nullable (Decoder d) = Decoder $ \case-  Null  -> pure Nothing-  other -> Just <$> d other-{-# INLINE nullable #-}---- | Decode JSON array of values to '[a]' of values--- using provided 'Decoder'.-list :: Decoder a -> Decoder [a]-list (Decoder d) = Decoder $-  listParser d-{-# INLINE list #-}---- | Decode JSON array of values to 'Vector' of values--- using provided 'Decoder'.-vector :: Decoder a -> Decoder (Vector a)-vector (Decoder d) = Decoder $ \case-  Array v -> Vector.mapM d v-  other   -> typeMismatch "Array" other-{-# INLINE vector #-}---- | Decode JSON object to 'HL.HashMap' with 'Data.Text' key--- using provided 'Decoder'.-hashMapLazy :: Decoder a -> Decoder (HL.HashMap Text a)-hashMapLazy (Decoder d) = Decoder $ \case-  Object xs -> traverse d xs-  val -> typeMismatch "Array" val-{-|# INLINE hashMapLazy #-}---- | Decode JSON object to 'HS.HashMap' with 'Data.Text' key--- using provided 'Decoder'.-hashMapStrict :: Decoder a -> Decoder (HS.HashMap Text a)-hashMapStrict (Decoder d) = Decoder $ \case-  Object xs -> traverse d xs-  val -> typeMismatch "Array" val-{-|# INLINE hashMapStrict #-}---- | Decode JSON object to 'ML.Map' with 'Data.Text' key--- using provided 'Decoder'.-mapLazy :: Decoder a -> Decoder (ML.Map Text a)-mapLazy dec = ML.fromList . HL.toList <$> hashMapLazy dec-{-|# INLINE mapStrict #-}---- | Decode JSON object to 'MS.Map' with 'Data.Text' key--- using provided 'Decoder'.-mapStrict :: Decoder a -> Decoder (MS.Map Text a)-mapStrict dec = MS.fromList . HL.toList <$> hashMapLazy dec-{-|# INLINE mapStrict #-}----- Combinators---- | Decode JSON null to any value.--- This function is useful for decoding--- constructors which represented by null in JSON.------ > data Codomain = NotSet | Foo | Bar--- >--- > myDomainDecoder :: Decoder Codomain--- > myDomainDecoder = jsonNull NotSet--- >               <|> (text >>= fooBar)--- >    where fooBar "foo"   = return Foo--- >          fooBar "bar"   = return Bar--- >          fooBar unknown = fail $ "Unknown value " <> show unknown-jsonNull :: a -> Decoder a-jsonNull a = Decoder $ \case-  Null -> pure a-  val    -> typeMismatch "null" val-{-# INLINE jsonNull #-}---- | Extract JSON value from JSON object key------ > >>> decode (key "data" int) "{\"data\": 42}"--- > Just 42-key :: Text -> Decoder a -> Decoder a-key t (Decoder d) = Decoder $ \case-  Object v -> d =<< v .: t-  val        -> typeMismatch "Object" val-{-# INLINE key #-}---- | Extract JSON value from JSON object keys------ > >>> decode (at ["data", "value"] int) "{\"data\": {\"value\": 42}}"--- > Just 42-at :: [Text] -> Decoder a -> Decoder a-at pth d = foldr key d pth-{-# INLINE at #-}---- | Extract JSON value from JSON array index------ > >>> decode (index 2 int) "[0,1,2,3,4]"--- > Just 2-index :: Int -> Decoder a -> Decoder a-index i (Decoder d) = Decoder $ \val ->-  case val of-    Array vec -> case vec !? i of-                    Just v  -> d v-                    Nothing -> unexpected val-    _         -> typeMismatch "Array" val-{-# INLINE index #-}---- | Extract JSON value from JSON array indexes------ > >>> decode (indexes [0,1,0] int) "[[true, [42]]]"--- > Just 42-indexes :: [Int] -> Decoder a -> Decoder a-indexes pth d = foldr index d pth-{-# INLINE indexes #-}---- $jsonpath--- Combinators using Aeson's 'JSONPathElement' and 'JSONPath' types.--- This makes it possible to combine object keys and array index accessors.---- | Decode value from JSON structure.------ From object key:------ > >>> decode (element (Key "data") text) "{\"data\": \"foo\"}"--- > Just "foo"------ From array index:------ > >>> decode (element (Index 1) int) "[0,1,2]"--- > Just 1-element :: JSONPathElement -> Decoder a -> Decoder a-element (Key txt) = key txt-element (Index i) = index i-{-# INLINE element #-}---- | Decode value from deep JSON structure.------ > >>> decode (path [Key "data", Index 0] bool) "{\"data\":[true, false, false]}"--- > Just True-path :: JSONPath -> Decoder a -> Decoder a-path pth d = foldr element d pth-{-# INLINE path #-}-- -- Decoding --- $running++-- $decoding -- -- Following functions are evivalent to ones provided by Aeson itself. -- The only difference is that versions implemented by Aeson@@ -631,6 +742,7 @@   Parser.decodeWith ParserI.jsonEOF (parse d) {-# INLINE decode #-} + -- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'. -- If this fails due to incomplete or invalid input, 'Nothing' is -- returned.@@ -660,6 +772,7 @@  -- Strict Decoding + -- | Efficiently deserialize a JSON value from a strict 'B.ByteString'. -- If this fails due to incomplete or invalid input, 'Nothing' is -- returned.@@ -674,6 +787,7 @@   Parser.decodeStrictWith ParserI.jsonEOF (parse d) {-# INLINE decodeStrict #-} + -- | Efficiently deserialize a JSON value from a strict 'B.ByteString'. -- If this fails due to incomplete or invalid input, 'Nothing' is -- returned.@@ -703,6 +817,7 @@  -- File Decoding + -- | Efficiently deserialize a JSON value from a file. -- If this fails due to incomplete or invalid input, 'Nothing' is -- returned.@@ -717,6 +832,7 @@   fmap (decodeStrict dec) . B.readFile {-# INLINE decodeFileStrict #-} + -- | Efficiently deserialize a JSON value from a file. -- If this fails due to incomplete or invalid input, 'Nothing' is -- returned.@@ -731,12 +847,14 @@   fmap (decodeStrict' dec) . B.readFile {-# INLINE decodeFileStrict' #-} + -- | Like 'decodeFileStrict' but returns an error message when decoding fails. eitherDecodeFileStrict :: Decoder a -> FilePath -> IO (Either String a) eitherDecodeFileStrict dec =   fmap (eitherDecodeStrict dec) . B.readFile {-# INLINE eitherDecodeFileStrict #-} + -- | Like 'decodeFileStrict'' but returns an error message when decoding fails. eitherDecodeFileStrict' :: Decoder a -> FilePath -> IO (Either String a) eitherDecodeFileStrict' dec =@@ -744,15 +862,32 @@ {-# INLINE eitherDecodeFileStrict' #-}  +-- Parsing+++-- | Run decoder over 'Value'.+-- Returns 'Nothing' in case of failure+parseMaybe :: Decoder a -> Value -> Maybe a+parseMaybe (Decoder f) = ATypes.parseMaybe f+{-# INLINE parseMaybe #-}+++-- | Run decoder over 'Value'.+-- Returns 'Left' with error message in case of failure+parseEither :: Decoder a -> Value -> Either String a+parseEither (Decoder f) = ATypes.parseEither f+{-# INLINE parseEither #-}++ -- Private functions Aeson doesn't expose + eitherFormatError :: Either (JSONPath, String) a -> Either String a-eitherFormatError = either (Left . uncurry AI.formatError) Right+eitherFormatError = Prelude.either (Left . uncurry AI.formatError) Right {-# INLINE eitherFormatError #-} -#if (MIN_VERSION_aeson(1,4,3))-#else +#if !(MIN_VERSION_aeson(1,4,3)) -- These functions are not exposed in aeson 1.4.2.0 -- implementation is copied from -- https://hackage.haskell.org/package/aeson-1.4.6.0/docs/src/Data.Aeson.Types.FromJSON.html#unexpected@@ -761,6 +896,7 @@ unexpected actual = Fail.fail $ "unexpected " ++ typeOf actual {-# INLINE unexpected #-} + typeOf :: Value -> String typeOf v = case v of     Object _ -> "Object"@@ -770,5 +906,4 @@     Bool _   -> "Boolean"     Null     -> "Null" {-# INLINE typeOf #-}- #endif
test/Spec.hs view
@@ -1,1 +1,5 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+import qualified JSONDecodeSpec as Decode+import           Test.Hspec     (hspec)++main :: IO ()+main = hspec Decode.spec