packages feed

aeson-combinators (empty) → 0.0.1.0

raw patch · 7 files changed

+980/−0 lines, 7 filesdep +aesondep +aeson-combinatorsdep +basesetup-changed

Dependencies added: aeson, aeson-combinators, base, bytestring, containers, fail, hspec, scientific, text, time, time-compat, unordered-containers, utf8-string, uuid-types, vector, void

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for aeson-combinators++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,11 @@+Copyright 2020 Marek Fajkus++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ aeson-combinators.cabal view
@@ -0,0 +1,61 @@+cabal-version:       >=1.10+name:                aeson-combinators+version:             0.0.1.0+synopsis:            Aeson combinators for dead simple JSON decoding+description:+    This library defines low overhead value space `Decoder`+    on top of Aeson's Parser for combinator style decoding.++bug-reports:         https://github.com/turboMaCk/aeson-combinators/issues+license:             BSD3+license-file:        LICENSE+author:              Marek Fajkus <marek.faj@gmail.com>+maintainer:          Marek Fajkus <marek.faj@gmail.com>+copyright:           (c) 2020 Marek Fajkus+stability:           experimental+category:            Text, Web, JSON+build-type:          Simple+extra-source-files:  CHANGELOG.md+homepage:            https://github.com/turboMaCk/aeson-combinators+tested-with:         GHC == 7.10.3+                   , GHC == 7.8.4+                   , GHC == 7.6.3+                   , GHC == 8.4.4+                   , GHC == 8.6.5++library+  exposed-modules:     Data.Aeson.Combinators.Decode+  -- other-modules:+  -- other-extensions:+  build-depends:       base >= 4 && < 5+                     , bytestring+                     , text+                     , aeson+                     , scientific+                     , vector+                     , unordered-containers+                     , fail+                     , time+                     , time-compat+                     , uuid-types+                     , containers+                     , unordered-containers+                     , void+                     , scientific+  hs-source-dirs:      lib+  default-language:    Haskell2010++test-suite spec+    type:              exitcode-stdio-1.0+    hs-source-dirs:    test+    main-is:           Spec.hs+    other-modules:     JSONDecodeSpec+    build-depends:     base+                     , hspec+                     , aeson-combinators+                     , bytestring+                     , text+                     , aeson+                     , utf8-string+    ghc-options:       -Wall+    default-language:  Haskell2010
+ lib/Data/Aeson/Combinators/Decode.hs view
@@ -0,0 +1,747 @@+{-# LANGUAGE CPP        #-}+{-# LANGUAGE LambdaCase #-}++-- |+-- Module      : Data.Aeson.Cominators.Decode+-- Copyright   : (c) Marek Fajkus+-- License     : BSD3+--+-- Maintainer  : marek.faj@gmail.com+--+-- 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+-- users of Aeson library to define proxy types and+-- data wrappers just for sake of implementing instance+-- of 'FromJSON'.+-- This module provides value level 'Decoder' which can be used+-- instead of instance implementation.+--+module Data.Aeson.Combinators.Decode (+  -- * Example Usage+  -- $usage++  -- ** Applicative "Elm Style" Decoders+  -- $applicative+    Decoder(..)+  , auto+-- * Decoding Primitive Values+--+-- *** Void, Unit, Bool+  , void+  , unit, bool+-- *** Integers (and Natural)+  , int, integer, int8, int16, int32, int64+  , word, word8, word16, word32, word64+#if (MIN_VERSION_base(4,8,0))+  , natural+#endif+-- *** Floating Points+  , float, double+  , scientific+-- *** Strings+  , char, text, string+  , uuid, version+-- * Decoding Time+  , zonedTime, localTime, timeOfDay+  , utcTime+  , day, dayOfWeek+-- * Decodeing Containers+-- *** Maybe+  , nullable+-- *** Sequences+  , list, vector+-- *** Hasmap+  , hashMapLazy, hashMapStrict+-- *** Map+  , mapLazy, mapStrict+-- * Combinators+  , jsonNull+-- *** Objects:+  , key+  , at+-- *** Arrays+  , index+  , indexes+-- *** Path+-- $jsonpath+  , element+  , path+-- * Running Decoders+-- $running+-- *** Decoding From Byte Strings+  , decode, decode'+  , eitherDecode, eitherDecode'+  , decodeStrict, decodeStrict'+  , eitherDecodeStrict, eitherDecodeStrict'+-- *** Decoding Files+  , decodeFileStrict, decodeFileStrict'+  , eitherDecodeFileStrict, eitherDecodeFileStrict'+  ) where++import           Control.Applicative+import           Control.Monad              hiding (void)+import           Control.Monad.Fail         (MonadFail (..))+import qualified Control.Monad.Fail         as Fail+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 qualified Data.ByteString            as B+import qualified Data.ByteString.Lazy       as LB+import           Data.Int                   (Int16, Int32, Int64, Int8)+import           Data.Text                  (Text)+import           Data.Time.Calendar         (Day)+import           Data.Time.Calendar.Compat  (DayOfWeek)+import           Data.Time.Clock            (UTCTime)+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,+                                             Word8)+#if (MIN_VERSION_base(4,8,0))+import           GHC.Natural                (Natural)+#endif+import qualified Data.HashMap.Lazy          as HL+import qualified Data.HashMap.Strict        as HS+import qualified Data.Map.Lazy              as ML+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.+--+-- __Decode type nested in json__+--+-- > {-# LANGUAGE DeriveGeneric #-}+-- > import Data.Text+-- > import Data.ByteString.Lazy (ByteString)+-- > import Data.Aeson.Types+-- > import qualified Data.Aeson.Combinators.Decode as ACD+-- > import GHC.Generics+-- >+-- > data Person = Person+-- >     { name :: Text+-- >     , age  :: Int+-- >     } deriving (Generic, Show)+-- >+-- > instance FromJSON Person+-- >+-- > 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.+--+-- > >>> decodeEmbededPerson ["data", "person"] "{\"data\": {\"person\":{\"name\":\"Joe\",\"age\":12}}}"+-- > Just (Person {name = "Joe", age = 12})+--+-- __Easily decode multiple data from single json:__+--+-- > -- data Person defined above ^+-- >+-- >  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+--+-- Which can be used as following+--+-- > >>> decodePersonWithToken "{\"person\":{\"name\":\"Joe\",\"age\":12}, \"token\": \"foo\"}"+-- > Just ("foo",Person {name = "Joe", age = 12})++-- $applicative+--+-- If you like elm style decoding you can avoid using 'FromJSON' type class all togher.+--+-- > import Data.Text+-- > import qualified Data.Aeson.Combinators.Decode as ACD+-- >+-- > data Person = Person+-- >     { name :: Text+-- >     , age  :: Int+-- >     } deriving (Show)+-- >+-- > personDecoder :: ACD.Decoder Person+-- > personDecoder = Person+-- >         <$> ACD.key "name" ACD.text+-- >         <*> ACD.key "age" ACD.int+--+-- And use it directly as:+--+-- > >>> decode personDecoder "{\"name\":\"Joe\",\"age\":12}"+-- > Just (Person {name = "Joe", age = 12})+++-- | === JSON Decoder+--+-- A value that describes how values are decoded from JSON.+-- This type is an alternative to Aeson's 'FromJSON' instance implementation.+--+-- Use 'decode', 'decode', 'eitherDecode', 'eitherDecode''+-- 'decodeStrict', 'decodeStrict'', 'eitherDecodeStrict' or 'eitherDecodeStrict''+-- alternatives provided by this module for decoding from 'BytString'.+--+-- For decoding files use+-- 'decodeFileStrict', 'decodeFileStrict''+-- 'eitherDecodeFileStrict', 'eitherDecodeFileStrict''+-- also provided by this module.+--+-- ==== Using Instances of Decoder+-- __Functor to map function over 'Decoder'__+--+-- > intToString :: Decoder String+-- > intToString = show <$> Decode.int+--+-- > >>> decode intToString "2"+-- > Just "2"+--+-- __Applicateve to construct products__+--+-- > stringIntPair :: Decoder (String, Int)+-- > stringIntPair = (,) <$> index 0 string+-- >                     <*> index 1 int+--+-- > >>> decode stringIntPair "[\"hello\", 42]"+-- > Just ("hello", 42)+--+-- __Alternative to construct sums__+--+-- > eitherTextOrInt :: Decoder (Either Text Int)+-- > eitherTextOrInt = Left  <$> Decode.text+-- >               <|> Right <$> Decode.int+--+-- > >>> decode eitherTextOrInt "\"Lorem Ipsum\""+-- > Just (Left "Lorem Ipsum")+-- > >>> decode eitherTextOrInt "42"+-- > Just (Right 42)+--+-- __Monad for 'Decoder' chaining__+--+-- > odd :: Decoder Int+-- > odd = do+-- >   val <- int+-- >   if val `mod` 2 == 1+-- >   then $ return val+-- >   else fail $ "Expected odd value, got " <> show val+--+-- > >>> eitherDecode odd "3"+-- > Left 3+-- > >>> eitherDecode odd "4"+-- > Right "Error in $: Expected odd value, got 4"+newtype Decoder a =+  Decoder (Value -> Parser a)++instance Functor Decoder where+  fmap f (Decoder d) = Decoder $ fmap f . d+  {-# INLINE fmap #-}++instance Applicative Decoder where+  pure val = Decoder $ \_ -> pure val+  {-# INLINE pure #-}+  (Decoder f') <*> (Decoder d) = Decoder $+    \val ->+        (\f -> fmap f (d val)) =<< f' val+  {-# INLINE (<*>) #-}++instance Monad Decoder where+  (Decoder a) >>= f = Decoder $+    \val -> case parse a val of+      Success v -> let (Decoder res) = f v+                   in res val+      _ -> unexpected val+  {-# INLINE (>>=) #-}+#if !(MIN_VERSION_base(4,13,0))+  fail = Fail.fail+#endif++instance Alternative Decoder where+  empty = Decoder unexpected+  {-# INLINE empty #-}+  Decoder a <|> Decoder b = Decoder $ \v -> a v <|> b v+  {-# INLINE (<|>) #-}++instance MonadFail Decoder where+  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.+-- Any type that is an instance of this class is automatically compatible.+--+-- While 'auto' is universally usable for all primitive values,+-- this library provides individual type constraint functions+-- for decoding those values.+auto :: FromJSON a => Decoder a+auto = Decoder parseJSON+{-# INLINE auto #-}++-- | Decode any JSON value to 'Void' value+-- which is impossible to construct.+--+-- __This Decoder is guarenteed to fail.__+void :: Decoder Void+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)+--+-- This function requires 'base' >= 4.8.0+natural :: Decoder Natural+natural = auto+{-# 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+{-# INLINE word64 #-}+++-- | Decode JSON number to 'Float'+float :: Decoder Float+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.+--+-- Supported string formats:+--+-- YYYY-MM-DD HH:MM Z YYYY-MM-DD HH:MM:SS Z YYYY-MM-DD HH:MM:SS.SSS Z+--+-- The first space may instead be a T, and the second space is optional. The Z represents UTC. The Z may be replaced with a time zone offset of the form +0000 or -08:00, where the first two digits are hours, the : is optional and the second two digits (also optional) are minutes.+zonedTime :: Decoder ZonedTime+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 #-}++-- | Decode JSON string to 'Data.Time.Calendar.Compat.DayOfWeek'+-- using Aesons's instance implementation+dayOfWeek :: Decoder DayOfWeek+dayOfWeek = auto+{-# INLINE dayOfWeek #-}+++-- 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 usefull if you have custom+-- constructor which represented by null in JSONs.+--+-- > 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 mix 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+--+-- Following functions are evivalent to the one provided by Aeson.+-- The only difference is versions provided by Aeson+-- for with 'FromJSON' instances while these use 'Decoder' type+-- instead.++-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.+-- If this fails due to incomplete or invalid input, 'Nothing' is+-- returned.+--+-- The input must consist solely of a JSON document, with no trailing+-- data except for whitespace.+--+-- This function parses immediately, but defers conversion. See+-- 'Data.Aeson.json' for details.+decode :: Decoder a -> LB.ByteString -> Maybe a+decode (Decoder d) =+  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.+--+-- The input must consist solely of a JSON document, with no trailing+-- data except for whitespace.+--+-- This function parses and performs conversion immediately. See+-- 'Data.Aeson.json'' for details.+decode' :: Decoder a -> LB.ByteString -> Maybe a+decode' (Decoder d) =+  Parser.decodeWith ParserI.jsonEOF' (parse d)+{-# INLINE decode' #-}++-- | Like 'decode' but returns an error message when decoding fails.+eitherDecode :: Decoder a -> LB.ByteString -> Either String a+eitherDecode (Decoder d) =+  eitherFormatError . Parser.eitherDecodeWith ParserI.jsonEOF (AI.iparse d)+{-# INLINE eitherDecode #-}++-- | Like 'decode'' but returns an error message when decoding fails.+eitherDecode' :: Decoder a -> LB.ByteString -> Either String a+eitherDecode' (Decoder d) =+  eitherFormatError . Parser.eitherDecodeWith ParserI.jsonEOF' (AI.iparse d)+{-# INLINE eitherDecode' #-}+++-- Strict Decoding++-- | Efficiently deserialize a JSON value from a strict 'B.ByteString'.+-- If this fails due to incomplete or invalid input, 'Nothing' is+-- returned.+--+-- The input must consist solely of a JSON document, with no trailing+-- data except for whitespace.+--+-- This function parses immediately, but defers conversion. See+-- 'Data.Aeson.json' for details.+decodeStrict :: Decoder a -> B.ByteString -> Maybe a+decodeStrict (Decoder d) =+  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.+--+-- The input must consist solely of a JSON document, with no trailing+-- data except for whitespace.+--+-- This function parses and performs conversion immediately.  See+-- 'Data.Aeson.json'' for details.+decodeStrict' :: Decoder a -> B.ByteString -> Maybe a+decodeStrict' (Decoder d) =+  Parser.decodeStrictWith ParserI.jsonEOF' (parse d)+{-# INLINE decodeStrict' #-}++-- | Like 'decodeStrict' but returns an error message when decoding fails.+eitherDecodeStrict :: Decoder a -> B.ByteString -> Either String a+eitherDecodeStrict (Decoder d) =+  eitherFormatError . Parser.eitherDecodeStrictWith ParserI.jsonEOF (AI.iparse d)+{-# INLINE eitherDecodeStrict #-}++-- | Like 'decodeStrict'' but returns an error message when decoding fails.+eitherDecodeStrict' :: Decoder a -> B.ByteString -> Either String a+eitherDecodeStrict' (Decoder d) =+  eitherFormatError . Parser.eitherDecodeStrictWith ParserI.jsonEOF' (AI.iparse d)+{-# INLINE eitherDecodeStrict' #-}+++-- File Decoding++-- | Efficiently deserialize a JSON value from a file.+-- If this fails due to incomplete or invalid input, 'Nothing' is+-- returned.+--+-- The input file's content must consist solely of a JSON document,+-- with no trailing data except for whitespace.+--+-- This function parses immediately, but defers conversion. See+-- 'Data.Aeson.json' for details.+decodeFileStrict :: Decoder a -> FilePath -> IO (Maybe a)+decodeFileStrict dec =+  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.+--+-- The input file's content must consist solely of a JSON document,+-- with no trailing data except for whitespace.+--+-- This function parses and performs conversion immediately.  See+-- 'Data.Aeson.json'' for details.+decodeFileStrict' :: Decoder a -> FilePath -> IO (Maybe a)+decodeFileStrict' dec =+  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 =+  fmap (eitherDecodeStrict' dec) . B.readFile+{-# INLINE eitherDecodeFileStrict' #-}+++-- Private functions Aeson doesn't expose++-- | Annotate an error message with a+-- <http://goessner.net/articles/JsonPath/ JSONPath> error location.+formatError :: JSONPath -> String -> String+formatError pth msg =+  "Error in " ++ formatPath pth ++ ": " ++ msg+{-# INLINE formatError #-}++eitherFormatError :: Either (JSONPath, String) a -> Either String a+eitherFormatError = either (Left . uncurry formatError) Right+{-# INLINE eitherFormatError #-}
+ test/JSONDecodeSpec.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE DeriveGeneric       #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module JSONDecodeSpec where++import           Control.Applicative+import qualified Data.Aeson.Combinators.Decode as JD+import           Data.Aeson.Types              (FromJSON (..))+import           Data.ByteString.Lazy+import           Data.ByteString.Lazy.UTF8     (fromString)+import           Data.Monoid                   ((<>))+import           Data.Text+import           GHC.Generics+import           Test.Hspec++data Object = Object+    { name :: Text+    , nick :: Text+    }+    deriving (Show, Eq, Generic)++data FooBar = Foo | Bar+    deriving (Show, Eq)++instance FromJSON Object++decoder :: JD.Decoder Object+decoder =+  Object+    <$> JD.key "name" JD.text+    <*> JD.key "nick" JD.text++json :: ByteString+json = "{\"name\":\"Jany Doe\",\"nick\": \"jany\"}"++jsonNested :: ByteString+jsonNested = "{\"data\":" <> json <> "}"++objectSpec :: Spec+objectSpec = do+  describe "field" $ do+    let res = Just $ Object "Jany Doe" "jany"++    it "should decode object" $ do+      JD.decode decoder json `shouldBe` res++    it "should decode nested object" $ do+      JD.decode (JD.key "data" decoder) jsonNested+        `shouldBe` res++    it "should be possible to use default decoder" $ do+      JD.decode JD.auto json `shouldBe` res++  describe "at" $ do+    let+      nest' :: Int -> ByteString -> ByteString+      nest' n inner =+          if n <= 0 then+            inner+          else+            nest' (n - 1) ("{\"level-" <> fromString (show n) <> "\":" <> inner <> "}")+    let nest n = nest' n json+    let res = Just $ Object "Jany Doe" "jany"++    it "should decode object directly for empty list" $ do+      JD.decode (JD.at [] decoder) json+       `shouldBe` res++    it "should decode 2 level json" $ do+      let jdata = nest 2++      JD.decode (JD.at ["level-1", "level-2"] decoder) jdata+       `shouldBe` res++    it "should decode 10 level json" $ do+      let jdata = nest 10+      let path = ["level-1", "level-2", "level-3", "level-4", "level-5"+             , "level-6", "level-7", "level-8", "level-9", "level-10"+             ]++      JD.decode (JD.at path decoder) jdata `shouldBe` res++arraySpec :: Spec+arraySpec = do+  describe "index" $ do+    it "decode singleton by index" $ do+      JD.decode (JD.index 0 decoder) "[{\"name\": \"Sanders\", \"nick\": \"bern\"}]"+        `shouldBe` (Just $ Object "Sanders" "bern")++    it "should decode nth index" $ do+      JD.decode (JD.index 1 decoder) "[false, {\"name\": \"Sanders\", \"nick\": \"bern\"}, true]"+        `shouldBe` (Just $ Object "Sanders" "bern")++monadSpec :: Spec+monadSpec =+  describe "monadic decoding" $ do+    let fromText v =+          case v of+            "foo" -> pure Foo+            "bar" -> pure Bar+            _     -> fail "unknown"++    it "should work as a dummy value" $ do+      JD.decode (JD.string >>= pure) "\"foo\""+        `shouldBe` (Just "foo")++    it "should turn string to sum" $ do+      JD.decode (JD.string >>= fromText) "\"foo\""+        `shouldBe` (Just Foo)++    it "should fail with right error" $ do+      JD.eitherDecode (JD.string >>= fromText) "\"foobar\""+        `shouldBe` (Left "Error in $: unknown")++alternativeSpec :: Spec+alternativeSpec =+  describe "alternative (<|>)" $ do+    let (dec :: JD.Decoder (Either Bool Object)) =+          Left <$> JD.bool <|> Right <$> decoder++    it "should decode first alternative" $ do+      JD.decode dec "false" `shouldBe` (Just $ Left False)++    it "should decode second alternative" $ do+      JD.decode dec "{\"name\": \"Joe\",\"nick\": \"jd\"}"+        `shouldBe` (Just $ Right $ Object "Joe" "jd")++jsonNullSpec :: Spec+jsonNullSpec =+  describe "jsonNull" $ do+    let barDec txt =+          case txt of+            "bar" -> pure Bar+            _     -> fail $ "Unknown value" <> show txt++    let (dec :: JD.Decoder FooBar) =+          JD.jsonNull Foo <|> (barDec =<< JD.text)++    it "should decode Foo from null" $ do+      JD.decode dec "null" `shouldBe` (Just Foo)++    it "should decode Bar from string" $ do+      JD.decode dec "\"bar\"" `shouldBe` (Just Bar)++spec :: Spec+spec = do+  objectSpec+  arraySpec+  monadSpec+  alternativeSpec+  jsonNullSpec
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}