├── .github └── workflows │ └── test.yml ├── .gitignore ├── CHANGELOG.md ├── DocTest.hs ├── LICENSE ├── README.md ├── Setup.hs ├── aeson-combinators.cabal ├── benchmarks └── Main.hs ├── default.nix ├── lib └── Data │ └── Aeson │ └── Combinators │ ├── Compat.hs │ ├── Decode.hs │ └── Encode.hs ├── shell.nix ├── stack.yaml ├── stack.yaml.lock └── test ├── JSONDecodeSpec.hs ├── JSONEncodeSpec.hs └── Spec.hs /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: "Test" 2 | 3 | on: 4 | pull_request: 5 | push: 6 | 7 | jobs: 8 | ghc: 9 | runs-on: ubuntu-latest 10 | steps: 11 | - uses: actions/checkout@v2.3.4 12 | - uses: cachix/install-nix-action@v20 13 | with: 14 | nix_path: nixpkgs=channel:nixos-unstable 15 | - uses: cachix/cachix-action@v12 16 | with: 17 | name: aeson-combinators 18 | signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}' 19 | - run: nix-build -A ghc 20 | 21 | ghc8107: 22 | runs-on: ubuntu-latest 23 | steps: 24 | - uses: actions/checkout@v2.3.4 25 | - uses: cachix/install-nix-action@v20 26 | with: 27 | nix_path: nixpkgs=channel:nixos-unstable 28 | - uses: cachix/cachix-action@v12 29 | with: 30 | name: aeson-combinators 31 | signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}' 32 | - run: nix-build -A ghc8107 33 | 34 | ghc902: 35 | runs-on: ubuntu-latest 36 | steps: 37 | - uses: actions/checkout@v2.3.4 38 | - uses: cachix/install-nix-action@v20 39 | with: 40 | nix_path: nixpkgs=channel:nixos-unstable 41 | - uses: cachix/cachix-action@v12 42 | with: 43 | name: aeson-combinators 44 | signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}' 45 | - run: nix-build -A ghc902 46 | 47 | ghc925: 48 | runs-on: ubuntu-latest 49 | steps: 50 | - uses: actions/checkout@v2.3.4 51 | - uses: cachix/install-nix-action@v20 52 | with: 53 | nix_path: nixpkgs=channel:nixos-unstable 54 | - uses: cachix/cachix-action@v12 55 | with: 56 | name: aeson-combinators 57 | signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}' 58 | - run: nix-build -A ghc925 59 | 60 | stack-aeson-2: 61 | runs-on: ubuntu-latest 62 | steps: 63 | - uses: actions/checkout@v2.3.4 64 | - uses: haskell/actions/setup@v1 65 | - uses: actions/cache@v2.1.6 66 | name: Cache ~/.stack 67 | with: 68 | path: ~/.stack 69 | key: linux-stack-nightly-aeson2 70 | - name: Test 71 | run: stack test 72 | 73 | ghcjs: 74 | runs-on: ubuntu-latest 75 | steps: 76 | - uses: actions/checkout@v2.3.4 77 | - uses: cachix/install-nix-action@v20 78 | with: 79 | nix_path: nixpkgs=channel:nixos-unstable 80 | - uses: cachix/cachix-action@v12 81 | with: 82 | name: aeson-combinators 83 | signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}' 84 | - run: cachix use miso-haskell 85 | - run: nix-build -A ghcjs 86 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist* 2 | /result* 3 | /build 4 | /cache 5 | packagedb/ 6 | .envrc 7 | /.stack-work/ 8 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for aeson-combinators 2 | 3 | ## 0.1.1.0 -- 2023-12-29 4 | * lower bound for aeson-parser dependecy to fix build of documentation in hackage 5 | 6 | ## 0.1.1.0 -- 2023-12-28 7 | * Aeson 2.2.x compatibility 8 | 9 | ## 0.1.1.0 -- 2023-09-03 10 | * `fromDecoder` utility to unwrap a `Decoder`'s function 11 | * `maybeKey` combinator 12 | 13 | ## 0.1.0.1 -- 2022-05-03 14 | * fix benchmark compatibility with ghc 9.2.2 15 | 16 | ## 0.1.0.0 -- 2022-03-21 17 | * Aeson 2 compatibility 18 | 19 | ## 0.0.5.0 -- 2021-03-13 20 | * make test suite compatible with hashable 1.3.1.0 21 | 22 | ## 0.0.4.1 -- 2021-02-14 23 | * Cleanup README 24 | * CI maintanance & GHC compatibility update 25 | 26 | ## 0.0.4.0 -- 2020-10-24 27 | * `Encode` module for encoding 28 | 29 | ## 0.0.3.0 -- 2020-10-11 30 | * Combinators for dealing with failure 31 | * `oneOf` function 32 | * `parseMaybe` and `parseEither` 33 | * Documentation improvements 34 | 35 | ## 0.0.2.1 -- 2020-03-08 36 | * Add README to extra source files 37 | 38 | ## 0.0.2.0 -- 2020-03-08 39 | * GHCJS compatibility 40 | 41 | ## 0.0.1.1 -- 2020-03-01 42 | * Fixes and improvements in documentation 43 | * Add source-repository to cabal file 44 | 45 | ## 0.0.1.0 -- 2020-02-29 46 | * First version. Released on an unsuspecting world. 47 | -------------------------------------------------------------------------------- /DocTest.hs: -------------------------------------------------------------------------------- 1 | import Test.DocTest 2 | main = doctest [ "-XOverloadedStrings" 3 | , "-XCPP" 4 | , "-XLambdaCase" 5 | , "lib/Data/Aeson/Combinators/Compat.hs" 6 | , "lib/Data/Aeson/Combinators/Decode.hs" 7 | , "lib/Data/Aeson/Combinators/Encode.hs" 8 | ] 9 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2020 Marek Fajkus 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 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. 8 | 9 | 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. 10 | 11 | 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. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Aeson Combinators 2 | 3 | [![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) 4 | [![built with nix](https://builtwithnix.org/badge.svg)](https://builtwithnix.org) 5 | 6 | [**Low overhead**](#performance) value space `Decoder` 7 | on top of Aeson's Parser for combinator style decoding. 8 | 9 | This library is compatible with GHC as well as recent versions of **GHCJS**. 10 | 11 | ## Performance 12 | 13 | `Decoder a` type is a function `Value -> Parser a` the same as `parseJSON` 14 | member function of `FromJSON` class. This means there should be near zero overhead. 15 | Aeson types and functions are reused where possible. Similarly `Encoder a` type 16 | follow `toJSON` from `ToJSON` type class. 17 | 18 | Simple benchmark shows that implementation using aeson-combinators performs better 19 | than equivalent derived instance and on par (actually even slightly better though with difference in noise range) 20 | with manually implemented instance. 21 | 22 | ## License 23 | 24 | (c) 2020 Marek Fajkus 25 | BSD-3-Clause 26 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /aeson-combinators.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >=1.10 2 | name: aeson-combinators 3 | version: 0.1.2.1 4 | synopsis: Aeson combinators for dead simple JSON decoding 5 | description: 6 | Low overhead value space `Decoder` 7 | on top of Aeson's Parser for combinator style decoding. 8 | 9 | bug-reports: https://github.com/turboMaCk/aeson-combinators/issues 10 | license: BSD3 11 | license-file: LICENSE 12 | author: Marek Fajkus 13 | maintainer: Marek Fajkus 14 | copyright: (c) 2020 Marek Fajkus 15 | stability: experimental 16 | category: Text, Web, JSON 17 | build-type: Simple 18 | extra-source-files: README.md 19 | , CHANGELOG.md 20 | homepage: https://github.com/turboMaCk/aeson-combinators 21 | tested-with: GHC == 8.10.7 22 | , GHC == 9.0.2 23 | , GHC == 9.2.5 24 | , GHC == 9.8.1 25 | , GHCJS == 8.6.0.1 26 | 27 | Flag doctest 28 | default: False 29 | manual: True 30 | 31 | library 32 | exposed-modules: Data.Aeson.Combinators.Decode 33 | , Data.Aeson.Combinators.Encode 34 | other-modules: Data.Aeson.Combinators.Compat 35 | -- other-extensions: 36 | build-depends: base >= 4 && < 5 37 | , bytestring 38 | , text 39 | , aeson 40 | , scientific 41 | , vector 42 | , unordered-containers 43 | , fail 44 | , time 45 | , time-compat 46 | , uuid-types 47 | , containers 48 | , unordered-containers 49 | , void 50 | , scientific 51 | 52 | if impl(ghc >= 9.2.0) 53 | build-depends: 54 | attoparsec-aeson 55 | hs-source-dirs: lib 56 | default-language: Haskell2010 57 | hs-source-dirs: lib 58 | 59 | benchmark benchmark 60 | type: exitcode-stdio-1.0 61 | main-is: Main.hs 62 | hs-source-dirs: benchmarks 63 | build-depends: base 64 | , aeson 65 | , aeson-combinators 66 | , bytestring 67 | , criterion 68 | , deepseq 69 | , text 70 | ghc-options: -Wall 71 | default-language: Haskell2010 72 | 73 | test-suite spec 74 | type: exitcode-stdio-1.0 75 | hs-source-dirs: test 76 | main-is: Spec.hs 77 | other-modules: JSONDecodeSpec 78 | , JSONEncodeSpec 79 | build-depends: base 80 | , hspec 81 | , aeson-combinators 82 | , bytestring 83 | , text 84 | , aeson 85 | , utf8-string 86 | ghc-options: -Wall 87 | default-language: Haskell2010 88 | 89 | test-suite doctest 90 | default-language: Haskell2010 91 | type: exitcode-stdio-1.0 92 | main-is: DocTest.hs 93 | default-extensions: OverloadedStrings 94 | 95 | if !flag(doctest) 96 | buildable: False 97 | else 98 | build-depends: base 99 | , doctest 100 | 101 | source-repository head 102 | type: git 103 | location: https://github.com/turboMaCk/aeson-combinators.git 104 | -------------------------------------------------------------------------------- /benchmarks/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE DerivingStrategies #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | 9 | import Control.DeepSeq (NFData) 10 | import Criterion (Benchmark, nf) 11 | import Data.Aeson.Combinators.Decode (Decoder) 12 | import Data.Aeson.Types (FromJSON, ToJSON, withObject, 13 | (.:)) 14 | import Data.ByteString.Lazy (ByteString) 15 | import GHC.Generics (Generic) 16 | 17 | import qualified Criterion.Main as Criterion 18 | import qualified Data.Aeson as Aeson 19 | import qualified Data.Aeson.Combinators.Decode as Decode 20 | 21 | 22 | bench :: NFData b => String -> (a -> b) -> (Int -> a) -> [Benchmark] 23 | bench name f gen = fmap (\i -> let !n = 10 ^ i 24 | !generated = gen n 25 | in Criterion.bench (name <> " " <> show n) $ (nf f) generated 26 | ) ([1..4] :: [Int]) 27 | {-# INLINE bench #-} 28 | 29 | 30 | main :: IO () 31 | main = 32 | Criterion.defaultMain 33 | [ Criterion.bgroup "Combinators decoder nested" $ 34 | bench "nested" (Decode.decode deeplyNestedDecoder) deeplyNestedValue 35 | , Criterion.bgroup "Derived (generic) decoder nested" $ 36 | bench "nested" (Aeson.decode @DeeplyNested) deeplyNestedValue 37 | , Criterion.bgroup "Implemented instance decoder nested" $ 38 | bench "nested" (Aeson.decode @DeeplyNested') deeplyNestedValue 39 | , Criterion.bgroup "Combinators decoder narrow" $ 40 | bench "narrow" (Decode.decode narrowDecoder) narrowValue 41 | , Criterion.bgroup "Derived (generic) decoder narrow" $ 42 | bench "narrow" (Aeson.decode @Narrow) narrowValue 43 | , Criterion.bgroup "Implemented instance decoder narrow" $ 44 | bench "narrow" (Aeson.decode @Narrow') narrowValue 45 | ] 46 | 47 | 48 | data DeeplyNested = DeeplyNested 49 | { nested :: ![DeeplyNested] 50 | } deriving stock (Show, Generic) 51 | deriving anyclass (FromJSON, NFData, ToJSON) 52 | 53 | 54 | deeplyNestedDecoder :: Decoder DeeplyNested 55 | deeplyNestedDecoder = DeeplyNested 56 | <$> Decode.key "nested" (Decode.list deeplyNestedDecoder) 57 | 58 | 59 | deeplyNestedValue :: Int -> ByteString 60 | deeplyNestedValue depth = Aeson.encode $ go depth (DeeplyNested []) 61 | where 62 | go :: Int -> DeeplyNested -> DeeplyNested 63 | go n dn 64 | | n <= 0 = dn 65 | | otherwise = go (n - 1) $ DeeplyNested [dn] 66 | 67 | 68 | data DeeplyNested' = DeeplyNested' 69 | { nested' :: ![DeeplyNested'] 70 | } deriving stock (Show, Generic) 71 | deriving anyclass (NFData) 72 | 73 | 74 | instance FromJSON DeeplyNested' where 75 | parseJSON = withObject "DeeplyNested'" $ \v -> 76 | DeeplyNested' <$> v .: "nested" 77 | 78 | 79 | data Narrow = Narrow 80 | { narrow :: ![Int] 81 | } deriving stock (Show, Generic) 82 | deriving anyclass (FromJSON, NFData, ToJSON) 83 | 84 | 85 | narrowDecoder :: Decoder Narrow 86 | narrowDecoder = Narrow 87 | <$> Decode.key "narrow" (Decode.list Decode.int) 88 | 89 | 90 | narrowValue :: Int -> ByteString 91 | narrowValue width = Aeson.encode $ Narrow [1..width] 92 | 93 | 94 | data Narrow' = Narrow' 95 | { narrow' :: ![Int] 96 | } deriving stock (Show, Generic) 97 | deriving anyclass (NFData) 98 | 99 | 100 | instance FromJSON Narrow' where 101 | parseJSON = withObject "narrow'" $ \v -> 102 | Narrow' <$> v .: "narrow" 103 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | let 2 | config = { 3 | packageOverrides = pkgs: rec { 4 | haskellPackages = 5 | pkgs.haskellPackages.override { 6 | overrides = self: super: { 7 | aeson-combinators = pkgs.haskell.lib.doBenchmark (self.callCabal2nix "aeson-combinators" ./. {}); 8 | }; 9 | }; 10 | }; 11 | }; 12 | pkgs = import { inherit config; }; 13 | 14 | # Using miso's ghcjs 15 | # cachix use miso-haskell 16 | # see https://github.com/dmjio/miso/blob/e222a66566c0377738791ab563054bbfbe6abd15/README.md#nix 17 | ghcjs = import (builtins.fetchTarball { 18 | url = "https://github.com/dmjio/miso/archive/843bdc3.tar.gz"; 19 | sha256 = "sha256:1fc15jza8i6xz9b32jphi3yb8mfbdb3nd9m1wmzr68saqizbfdc0"; 20 | }) {}; 21 | in with pkgs; { 22 | ghc = haskellPackages.aeson-combinators; 23 | ghcjs = ghcjs.pkgs.haskell.packages.ghcjs.callCabal2nix "aeson-combinators" ./. {}; 24 | ghc8107 = haskell.packages.ghc8107.aeson-combinators; 25 | ghc902 = haskell.packages.ghc902.aeson-combinators; 26 | ghc925 = haskell.packages.ghc925.aeson-combinators; 27 | } 28 | -------------------------------------------------------------------------------- /lib/Data/Aeson/Combinators/Compat.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | -- | 3 | -- Module : Data.Aeson.Combinators.Decode 4 | -- Copyright : (c) Marek Fajkus 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : marek.faj@gmail.com 8 | -- 9 | -- Aeson compatibility layer to support Aeson 2.0 and older versions. 10 | -- Re-exposes 'Key' and 'KeyMap', together with suitable conversion functions. 11 | -- For older aeson versions, we provide type definitions for 'Key' and 12 | -- 'KeyMap'. 13 | -- 14 | -- Users may use 'fromText' and 'toText' to write decoders/encoders for 15 | -- forwards and backwards compatibility. 16 | -- 17 | module Data.Aeson.Combinators.Compat ( 18 | -- * Aeson compatibility helpers 19 | -- 20 | -- $doc 21 | -- 22 | -- ** KeyMap 23 | KeyMap 24 | , toHashMapText 25 | -- ** Key 26 | , Key 27 | , toText, fromText 28 | ) where 29 | 30 | #if (MIN_VERSION_aeson(2,0,0)) 31 | import Data.Aeson.Key (Key, toText, fromText) 32 | import Data.Aeson.KeyMap (KeyMap) 33 | import Data.Aeson.KeyMap (toHashMapText) 34 | #else 35 | import qualified Data.HashMap.Lazy as HL 36 | import Data.Text (Text) 37 | 38 | -- | Forward compatible type-def for Aeson 2.0 'KeyMap' type. 39 | type KeyMap a = HL.HashMap Text a 40 | 41 | toHashMapText :: HL.HashMap Text a -> HL.HashMap Text a 42 | toHashMapText = id 43 | 44 | -- | Forward compatible type-def for Aeson 2.0 'Key' type. 45 | type Key = Text 46 | 47 | -- | Aeson 2.0 compatibility function for the 'Key' type. 48 | fromText :: Text -> Text 49 | fromText = id 50 | 51 | -- | Aeson 2.0 compatibility function for the 'Key' type. 52 | toText :: Text -> Text 53 | toText = id 54 | #endif 55 | 56 | -- $doc 57 | -- Aeson compatibility layer to support Aeson 2.0 and older versions. 58 | -- Re-exposes 'Key' and 'KeyMap', together with suitable conversion functions. 59 | -- For older aeson versions, we provide type definitions for 'Key' and 60 | -- 'KeyMap'. 61 | -- 62 | -- Users may use 'fromText' and 'toText' to write decoders/encoders for 63 | -- forwards and backwards compatibility. 64 | -- 65 | -- See [Key](https://hackage.haskell.org/package/aeson-2.0.3.0/docs/Data-Aeson-Key.html) 66 | -- and [KeyMap](https://hackage.haskell.org/package/aeson-2.0.3.0/docs/Data-Aeson-KeyMap.html) 67 | -- in [aeson >= 2.0](https://hackage.haskell.org/package/aeson) for more details. 68 | -------------------------------------------------------------------------------- /lib/Data/Aeson/Combinators/Decode.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | 4 | -- | 5 | -- Module : Data.Aeson.Combinators.Decode 6 | -- Copyright : (c) Marek Fajkus 7 | -- License : BSD3 8 | -- 9 | -- Maintainer : marek.faj@gmail.com 10 | -- 11 | -- Aeson decoding API is closed over the type class 'FromJSON'. 12 | -- Because of this there is one to one mapping between JSON 13 | -- format and data decoded from it (decoding is closed over types). 14 | -- While this is handy in many situations, in others it forces 15 | -- users of Aeson library to define proxy types and 16 | -- data wrappers just for sake of implementing multiple instances 17 | -- of 'FromJSON' class. 18 | -- This module provides value level 'Decoder' which can be used 19 | -- instead of instance implementation to define any number of JSON 20 | -- decoders for the same data type. 21 | -- 22 | module Data.Aeson.Combinators.Decode ( 23 | -- * Example Usage 24 | -- $usage 25 | 26 | -- ** Applicative "Elm Style" Decoders 27 | -- $applicative 28 | Decoder(..) 29 | , auto 30 | , fromDecoder 31 | -- * Decoding Containers 32 | -- *** Maybe 33 | , nullable 34 | -- *** Sequences 35 | , list, vector 36 | -- *** Hashmap and Map 37 | , hashMapLazy, hashMapStrict, keyMap 38 | -- *** Map 39 | , mapLazy, mapStrict 40 | -- * Combinators 41 | , jsonNull 42 | -- *** Objects 43 | , key 44 | , maybeKey 45 | , at 46 | -- *** Arrays 47 | , index 48 | , indexes 49 | -- *** Path 50 | -- $jsonpath 51 | , element 52 | , path 53 | -- *** Dealing With Failure 54 | , maybe 55 | , either 56 | , oneOf 57 | -- * Decoding Primitive Values 58 | -- *** Void, Unit, Bool 59 | , void 60 | , unit, bool 61 | -- *** Integers (and Natural) 62 | , int, integer, int8, int16, int32, int64 63 | , word, word8, word16, word32, word64 64 | #if (MIN_VERSION_base(4,8,0)) 65 | , natural 66 | #endif 67 | -- *** Real Numbers 68 | , float, double 69 | , scientific 70 | -- *** Strings 71 | , char, text, string 72 | , uuid, version 73 | -- * Time 74 | , zonedTime, localTime, timeOfDay 75 | , utcTime 76 | , day 77 | #if (MIN_VERSION_time_compat(1,9,2)) 78 | , dayOfWeek 79 | #endif 80 | -- * Decoding ByteStrings 81 | -- $decoding 82 | -- *** Decoding From Byte Strings 83 | , decode, decode' 84 | , eitherDecode, eitherDecode' 85 | , decodeStrict, decodeStrict' 86 | , eitherDecodeStrict, eitherDecodeStrict' 87 | -- *** Decoding Files 88 | , decodeFileStrict, decodeFileStrict' 89 | , eitherDecodeFileStrict, eitherDecodeFileStrict' 90 | -- * Parsing (Running Decoders) 91 | , parseMaybe 92 | , parseEither 93 | , module Data.Aeson.Combinators.Compat 94 | ) where 95 | 96 | import Prelude hiding (either, fail, maybe) 97 | import qualified Prelude (either, maybe) 98 | 99 | import Control.Applicative 100 | import Control.Monad hiding (void) 101 | import Control.Monad.Fail (MonadFail (..)) 102 | import qualified Control.Monad.Fail as Fail 103 | 104 | import Data.Aeson.Combinators.Compat 105 | 106 | #if !(MIN_VERSION_aeson(2,2,0)) 107 | import Data.Aeson.Internal (JSONPath, JSONPathElement (..)) 108 | import Data.Aeson.Internal (formatError, iparse) 109 | #endif 110 | #if MIN_VERSION_aeson(2,2,0) 111 | import Data.Aeson.Types (JSONPath, JSONPathElement (..)) 112 | import Data.Aeson.Types (formatError, iparse) 113 | #endif 114 | import qualified Data.Aeson.Parser as Parser 115 | import qualified Data.Aeson.Parser.Internal as ParserI 116 | import Data.Aeson.Types hiding (parseEither, parseMaybe) 117 | import qualified Data.Aeson.Types as ATypes 118 | 119 | import qualified Data.ByteString as B 120 | import qualified Data.ByteString.Lazy as LB 121 | import Data.List.NonEmpty (NonEmpty (..)) 122 | import Data.Text (Text) 123 | import qualified Data.Vector as Vector 124 | 125 | -- Data imports 126 | import Data.Int (Int16, Int32, Int64, Int8) 127 | import Data.Time.Calendar (Day) 128 | #if (MIN_VERSION_time_compat(1,9,2)) 129 | import Data.Time.Calendar.Compat (DayOfWeek) 130 | #endif 131 | import Data.Time.Clock (UTCTime) 132 | import Data.Time.LocalTime (LocalTime, TimeOfDay, ZonedTime) 133 | import Data.UUID.Types (UUID) 134 | import Data.Vector (Vector, (!?)) 135 | import Data.Version (Version) 136 | import Data.Void (Void) 137 | import Data.Word (Word, Word16, Word32, Word64, 138 | Word8) 139 | #if (MIN_VERSION_base(4,8,0)) 140 | import GHC.Natural (Natural) 141 | #endif 142 | import qualified Data.HashMap.Lazy as HL 143 | import qualified Data.HashMap.Strict as HS 144 | import qualified Data.Map.Lazy as ML 145 | import qualified Data.Map.Strict as MS 146 | import Data.Scientific (Scientific) 147 | import Data.Traversable (traverse) 148 | 149 | 150 | -- $usage 151 | -- Combinators and type classes can be used together. 152 | -- 153 | -- __Decode type nested in json__ 154 | -- 155 | -- >>> :set -XOverloadedStrings 156 | -- >>> :set -XDeriveGeneric 157 | -- 158 | -- > import Data.Text 159 | -- > import Data.ByteString.Lazy (ByteString) 160 | -- > import Data.Aeson.Types 161 | -- > import qualified Data.Aeson.Combinators.Decode as ACD 162 | -- > import GHC.Generics 163 | -- > 164 | -- > data Person = Person 165 | -- > { name :: Text 166 | -- > , age :: Int 167 | -- > } deriving (Generic, Show) 168 | -- > 169 | -- > instance FromJSON Person 170 | -- > 171 | -- > decodeEmbededPerson :: [Text] -> ByteString -> Maybe Person 172 | -- > decodeEmbededPerson path json = 173 | -- > ACD.decode (ACD.at path ACD.auto) json 174 | -- 175 | -- Now we can extract Person from any key within the json. 176 | -- 177 | -- > >>> decodeEmbededPerson ["data", "person"] "{\"data\": {\"person\":{\"name\":\"Joe\",\"age\":12}}}" 178 | -- > Just (Person {name = "Joe", age = 12}) 179 | -- 180 | -- __Easily decode multiple data from single json:__ 181 | -- 182 | -- > -- data Person defined above ^ 183 | -- > 184 | -- > -- using alias for simplicity 185 | -- > type Token = Text 186 | -- > 187 | -- > decodePersonWithToken :: ByteString -> Maybe (Token, Person) 188 | -- > decodePersonWithToken json = ACD.decode decoder json 189 | -- > where decoder = 190 | -- > (,) <$> ACD.key "token" ACD.text 191 | -- > <*> ACD.key "person" ACD.auto 192 | -- 193 | -- Which can be used as following 194 | -- 195 | -- > >>> decodePersonWithToken "{\"person\":{\"name\":\"Joe\",\"age\":12}, \"token\": \"foo\"}" 196 | -- > Just ("foo",Person {name = "Joe", age = 12}) 197 | 198 | -- $applicative 199 | -- 200 | -- If you like elm style decoding you can avoid using 'FromJSON' type class altogher. 201 | -- 202 | -- > import Data.Text 203 | -- > import qualified Data.Aeson.Combinators.Decode as ACD 204 | -- > 205 | -- > data Person = Person 206 | -- > { name :: Text 207 | -- > , age :: Int 208 | -- > } deriving (Show) 209 | -- > 210 | -- > personDecoder :: ACD.Decoder Person 211 | -- > personDecoder = Person 212 | -- > <$> ACD.key "name" ACD.text 213 | -- > <*> ACD.key "age" ACD.int 214 | -- 215 | -- And use it directly as: 216 | -- 217 | -- > >>> decode personDecoder "{\"name\":\"Joe\",\"age\":12}" 218 | -- > Just (Person {name = "Joe", age = 12}) 219 | 220 | 221 | -- | 222 | -- A value describing how other values are decoded from JSON. 223 | -- This type is an alternative to Aeson's 'FromJSON' instance implementation. 224 | -- 225 | -- Use 'decode', 'decode', 'eitherDecode', 'eitherDecode'' 226 | -- 'decodeStrict', 'decodeStrict'', 'eitherDecodeStrict' or 'eitherDecodeStrict'' 227 | -- alternatives provided by this module for decoding from 'ByteString'. 228 | -- 229 | -- For decoding files use 230 | -- 'decodeFileStrict', 'decodeFileStrict'' 231 | -- 'eitherDecodeFileStrict', 'eitherDecodeFileStrict'' 232 | -- also provided by this module. 233 | -- 234 | -- When working with 'Value', use 'parseMaybe' or 'parseEither' function. 235 | -- 236 | -- === Functor to map function over 'Decoder' 237 | -- 238 | -- > intToString :: Decoder String 239 | -- > intToString = show <$> Decode.int 240 | -- 241 | -- > >>> decode intToString "2" 242 | -- > Just "2" 243 | -- 244 | -- === Applicative to construct products 245 | -- 246 | -- > stringIntPair :: Decoder (String, Int) 247 | -- > stringIntPair = (,) <$> index 0 string 248 | -- > <*> index 1 int 249 | -- 250 | -- > >>> decode stringIntPair "[\"hello\", 42]" 251 | -- > Just ("hello", 42) 252 | -- 253 | -- === Alternative to construct sums 254 | -- 255 | -- > eitherTextOrInt :: Decoder (Either Text Int) 256 | -- > eitherTextOrInt = Left <$> Decode.text 257 | -- > <|> Right <$> Decode.int 258 | -- 259 | -- > >>> decode eitherTextOrInt "\"Lorem Ipsum\"" 260 | -- > Just (Left "Lorem Ipsum") 261 | -- > >>> decode eitherTextOrInt "42" 262 | -- > Just (Right 42) 263 | -- 264 | -- === Monad for 'Decoder' chaining 265 | -- 266 | -- > odd :: Decoder Int 267 | -- > odd = do 268 | -- > val <- int 269 | -- > if val `mod` 2 == 1 270 | -- > then $ return val 271 | -- > else fail $ "Expected odd value, got " <> show val 272 | -- 273 | -- > >>> eitherDecode odd "3" 274 | -- > Right 3 275 | -- > >>> eitherDecode odd "4" 276 | -- > Left "Error in $: Expected odd value, got 4" 277 | newtype Decoder a = 278 | Decoder (Value -> Parser a) 279 | 280 | instance Functor Decoder where 281 | fmap f (Decoder d) = Decoder $ fmap f . d 282 | {-# INLINE fmap #-} 283 | 284 | instance Applicative Decoder where 285 | pure val = Decoder $ \_ -> pure val 286 | {-# INLINE pure #-} 287 | (Decoder f') <*> (Decoder d) = Decoder $ 288 | \val -> 289 | (\f -> fmap f (d val)) =<< f' val 290 | {-# INLINE (<*>) #-} 291 | 292 | instance Monad Decoder where 293 | return = pure 294 | (Decoder a) >>= f = Decoder $ 295 | \val -> case parse a val of 296 | Success v -> let (Decoder res) = f v 297 | in res val 298 | _ -> unexpected val 299 | {-# INLINE (>>=) #-} 300 | #if !(MIN_VERSION_base(4,13,0)) 301 | fail = Fail.fail 302 | #endif 303 | 304 | instance Alternative Decoder where 305 | empty = Decoder unexpected 306 | {-# INLINE empty #-} 307 | Decoder a <|> Decoder b = Decoder $ \v -> a v <|> b v 308 | {-# INLINE (<|>) #-} 309 | 310 | instance MonadFail Decoder where 311 | fail s = Decoder $ \_ -> Fail.fail s 312 | {-# INLINE fail #-} 313 | 314 | 315 | -- | Conversely, an Aeson's 'FromJSON' instance can be implemented by using 'Decoder' combinators. 316 | -- 317 | -- > newtype People = People [Person] 318 | -- > 319 | -- > instance FromJSON People where 320 | -- > parseJSON = fromDecoder $ Decode.list personDecoder 321 | fromDecoder :: Decoder a -> Value -> Parser a 322 | fromDecoder (Decoder f) = f 323 | {-# INLINE fromDecoder #-} 324 | 325 | 326 | -- | 'Decoder' is compatible with Aeson's 'FromJSON' class. 327 | -- 'auto' decoder acts like a proxy to instance implementation. 328 | -- Any type that is an instance of this class is automatically compatible. 329 | -- 330 | -- While 'auto' is universally usable for all primitive values, 331 | -- this library provides individual type constraint functions 332 | -- for decoding most common primitives and combinators for decoding larger structure from these primitives. 333 | auto :: FromJSON a => Decoder a 334 | auto = Decoder parseJSON 335 | {-# INLINE auto #-} 336 | 337 | 338 | -- Continer Decoders 339 | 340 | -- | Decode JSON null and other JSON value to 'Data.Maybe'. 341 | -- JSON null will be decoded to 'Nothing'. 342 | -- Other value decoded by provided 'Decoder' to 'Just' 343 | nullable :: Decoder a -> Decoder (Maybe a) 344 | nullable (Decoder d) = Decoder $ \case 345 | Null -> pure Nothing 346 | other -> Just <$> d other 347 | {-# INLINE nullable #-} 348 | 349 | 350 | -- | Decode JSON array of values to '[a]' of values 351 | -- using provided 'Decoder'. 352 | list :: Decoder a -> Decoder [a] 353 | list (Decoder d) = Decoder $ 354 | listParser d 355 | {-# INLINE list #-} 356 | 357 | 358 | -- | Decode JSON array of values to 'Vector' of values 359 | -- using provided 'Decoder'. 360 | vector :: Decoder a -> Decoder (Vector a) 361 | vector (Decoder d) = Decoder $ \case 362 | Array v -> Vector.mapM d v 363 | other -> typeMismatch "Array" other 364 | {-# INLINE vector #-} 365 | 366 | 367 | -- | Decode JSON object to 'HL.HashMap' with 'Data.Text' key 368 | -- using provided 'Decoder'. 369 | hashMapLazy :: Decoder a -> Decoder (HL.HashMap Text a) 370 | hashMapLazy (Decoder d) = Decoder $ \case 371 | Object xs -> toHashMapText <$> traverse d xs 372 | val -> typeMismatch "Array" val 373 | {-# INLINE hashMapLazy #-} 374 | 375 | 376 | -- | Decode JSON object to 'HS.HashMap' with 'Data.Text' key 377 | -- using provided 'Decoder'. 378 | hashMapStrict :: Decoder a -> Decoder (HS.HashMap Text a) 379 | hashMapStrict (Decoder d) = Decoder $ \case 380 | Object xs -> toHashMapText <$> traverse d xs 381 | val -> typeMismatch "Array" val 382 | {-# INLINE hashMapStrict #-} 383 | 384 | -- | Decode JSON object to 'KeyMap' with 'Key' key 385 | -- using provided 'Decoder'. 386 | keyMap :: Decoder a -> Decoder (KeyMap a) 387 | keyMap (Decoder d) = Decoder $ \case 388 | Object xs -> traverse d xs 389 | val -> typeMismatch "Array" val 390 | {-# INLINE keyMap #-} 391 | 392 | -- | Decode JSON object to 'ML.Map' with 'Data.Text' key 393 | -- using provided 'Decoder'. 394 | mapLazy :: Decoder a -> Decoder (ML.Map Text a) 395 | mapLazy dec = ML.fromList . HL.toList <$> hashMapLazy dec 396 | {-# INLINE mapLazy #-} 397 | 398 | 399 | -- | Decode JSON object to 'MS.Map' with 'Data.Text' key 400 | -- using provided 'Decoder'. 401 | mapStrict :: Decoder a -> Decoder (MS.Map Text a) 402 | mapStrict dec = MS.fromList . HL.toList <$> hashMapLazy dec 403 | {-# INLINE mapStrict #-} 404 | 405 | 406 | -- Combinators 407 | 408 | -- | Decode JSON null to any value. 409 | -- This function is useful for decoding 410 | -- constructors which represented by null in JSON. 411 | -- 412 | -- > data Codomain = NotSet | Foo | Bar 413 | -- > 414 | -- > myDomainDecoder :: Decoder Codomain 415 | -- > myDomainDecoder = jsonNull NotSet 416 | -- > <|> (text >>= fooBar) 417 | -- > where fooBar "foo" = return Foo 418 | -- > fooBar "bar" = return Bar 419 | -- > fooBar unknown = fail $ "Unknown value " <> show unknown 420 | jsonNull :: a -> Decoder a 421 | jsonNull a = Decoder $ \case 422 | Null -> pure a 423 | val -> typeMismatch "null" val 424 | {-# INLINE jsonNull #-} 425 | 426 | 427 | -- | Extract JSON value from JSON object key 428 | -- 429 | -- >>> decode (key "data" int) "{\"data\": 42}" 430 | -- Just 42 431 | key :: Key -> Decoder a -> Decoder a 432 | key t (Decoder d) = Decoder $ \case 433 | Object v -> d =<< v .: t 434 | val -> typeMismatch "Object" val 435 | {-# INLINE key #-} 436 | 437 | -- | Same as 'key' but works with omitted attributes in payloads and produces parsed values in the context of 'Maybe'. 438 | -- Note that this combinator behaves differently to a combination of 'maybe' and 'key', which produce error if 439 | -- the attribute is missing from the json object. 440 | -- >>> decode (maybeKey "data" int) "{}" 441 | -- Just Nothing 442 | -- 443 | --- >>> decode (maybeKey "data" int) "{\"data\": 42}" 444 | -- Just (Just 42) 445 | maybeKey :: Key -> Decoder a -> Decoder (Maybe a) 446 | maybeKey t (Decoder d) = Decoder $ \case 447 | Object v -> (v .:? t) >>= Prelude.maybe (pure Nothing) (fmap Just . d) 448 | val -> typeMismatch "Object" val 449 | {-# INLINE maybeKey #-} 450 | 451 | 452 | -- | Extract JSON value from JSON object keys 453 | -- 454 | -- >>> decode (at ["data", "value"] int) "{\"data\": {\"value\": 42}}" 455 | -- Just 42 456 | at :: [Key] -> Decoder a -> Decoder a 457 | at pth d = foldr key d pth 458 | {-# INLINE at #-} 459 | 460 | 461 | -- | Extract JSON value from JSON array index 462 | -- 463 | -- >>> decode (index 2 int) "[0,1,2,3,4]" 464 | -- Just 2 465 | index :: Int -> Decoder a -> Decoder a 466 | index i (Decoder d) = Decoder $ \val -> 467 | case val of 468 | Array vec -> case vec !? i of 469 | Just v -> d v 470 | Nothing -> unexpected val 471 | _ -> typeMismatch "Array" val 472 | {-# INLINE index #-} 473 | 474 | 475 | -- | Extract JSON value from JSON array indexes 476 | -- 477 | -- > >>> decode (indexes [0,1,0] int) "[[true, [42]]]" 478 | -- > Just 42 479 | indexes :: [Int] -> Decoder a -> Decoder a 480 | indexes pth d = foldr index d pth 481 | {-# INLINE indexes #-} 482 | 483 | 484 | -- $jsonpath 485 | -- Combinators using Aeson's 'JSONPathElement' and 'JSONPath' types. 486 | -- This makes it possible to combine object keys and array index accessors. 487 | 488 | -- | Decode value from JSON structure. 489 | -- 490 | -- From object key: 491 | -- 492 | -- >>> decode (element (Key "data") text) "{\"data\": \"foo\"}" 493 | -- Just "foo" 494 | -- 495 | -- From array index: 496 | -- 497 | -- >>> decode (element (Index 1) int) "[0,1,2]" 498 | -- Just 1 499 | element :: JSONPathElement -> Decoder a -> Decoder a 500 | element (Key txt) = key txt 501 | element (Index i) = index i 502 | {-# INLINE element #-} 503 | 504 | 505 | -- | Decode value from deep JSON structure. 506 | -- 507 | -- >>> decode (path [Key "data", Index 0] bool) "{\"data\":[true, false, false]}" 508 | -- Just True 509 | path :: JSONPath -> Decoder a -> Decoder a 510 | path pth d = foldr element d pth 511 | {-# INLINE path #-} 512 | 513 | 514 | -- | Try a decoder and get back a 'Just a' if it succeeds and 'Nothing' if it fails. 515 | -- In other words, this decoder always succeeds with a 'Maybe a' value. 516 | -- 517 | -- >>> decode (maybe string) "42" 518 | -- Just Nothing 519 | -- >>> decode (maybe int) "42" 520 | -- Just (Just 42) 521 | maybe :: Decoder a -> Decoder (Maybe a) 522 | maybe (Decoder d) = 523 | Decoder $ \val -> 524 | case parse d val of 525 | Success x -> pure (Just x) 526 | Error _ -> pure Nothing 527 | {-# INLINE maybe #-} 528 | 529 | 530 | -- | Try a decoder and get back a 'Right a' if it succeeds and a 'Left String' if it fails. 531 | -- In other words, this decoder always succeeds with an 'Either String a' value. 532 | -- 533 | -- >>> decode (either string) "42" 534 | -- Just (Left "expected String, but encountered Number") 535 | -- >>> decode (either int) "42" 536 | -- Just (Right 42) 537 | either :: Decoder a -> Decoder (Either String a) 538 | either (Decoder d) = 539 | Decoder $ \val -> 540 | case parse d val of 541 | Success x -> pure (Right x) 542 | Error err -> pure (Left err) 543 | {-# INLINE either #-} 544 | 545 | 546 | -- | Try a number of decoders in order and return the first success. 547 | -- 548 | -- >>> import Data.List.NonEmpty 549 | -- >>> decode (oneOf $ (words <$> string) :| [ list string ]) "\"Hello world!\"" 550 | -- Just ["Hello","world!"] 551 | -- >>> decode (oneOf $ (list string) :| [ words <$> string ] ) "[\"Hello world!\"]" 552 | -- Just ["Hello world!"] 553 | -- >>> decode (oneOf $ (Right <$> bool) :| [ return (Left "Not a boolean") ]) "false" 554 | -- Just (Right False) 555 | -- >>> decode (oneOf $ (Right <$> bool) :| [ return (Left "Not a boolean") ]) "42" 556 | -- Just (Left "Not a boolean") 557 | oneOf :: NonEmpty (Decoder a) -> Decoder a 558 | oneOf (first :| rest) = 559 | foldl (<|>) first rest 560 | {-# INLINE oneOf #-} 561 | 562 | 563 | -- Basic Decoders 564 | 565 | -- | Decode any JSON value to 'Void' value 566 | -- which is impossible to construct. 567 | -- 568 | -- __This Decoder is guarenteed to fail.__ 569 | void :: Decoder Void 570 | void = auto 571 | {-# INLINE void #-} 572 | 573 | 574 | -- | Decode JSON null into @()@ 575 | unit :: Decoder () 576 | unit = auto 577 | {-# INLINE unit #-} 578 | 579 | 580 | -- | Decode JSON booleans to Haskell 'Data.Bool' 581 | bool :: Decoder Bool 582 | bool = auto 583 | {-# INLINE bool #-} 584 | 585 | 586 | -- | Decode JSON number to 'Data.Int.Int' 587 | int :: Decoder Int 588 | int = auto 589 | {-# INLINE int #-} 590 | 591 | 592 | -- | Decode JSON number to 'Data.Int.Int8' 593 | int8 :: Decoder Int8 594 | int8 = auto 595 | {-# INLINE int8 #-} 596 | 597 | 598 | -- | Decode JSON number to 'Data.Int.Int16' 599 | int16 :: Decoder Int16 600 | int16 = auto 601 | {-# INLINE int16 #-} 602 | 603 | 604 | -- | Decode JSON number to 'Data.Int.Int32' 605 | int32 :: Decoder Int32 606 | int32 = auto 607 | {-# INLINE int32 #-} 608 | 609 | 610 | -- | Decode JSON number to 'Data.Int.Int64' 611 | int64 :: Decoder Int64 612 | int64 = auto 613 | {-# INLINE int64 #-} 614 | 615 | 616 | -- | Decode JSON number to unbounded 'Integer' 617 | integer :: Decoder Integer 618 | integer = auto 619 | {-# INLINE integer #-} 620 | 621 | 622 | #if (MIN_VERSION_base(4,8,0)) 623 | -- | Decode JSON number to GHC's 'GHC.Natural' (non negative) 624 | -- 625 | -- This function requires 'base' >= 4.8.0 626 | natural :: Decoder Natural 627 | natural = auto 628 | {-# INLINE natural #-} 629 | #endif 630 | 631 | 632 | -- | Decode JSON number to bounded 'Data.Word.Word' 633 | word :: Decoder Word 634 | word = auto 635 | {-# INLINE word #-} 636 | 637 | 638 | -- | Decode JSON number to bounded 'Data.Word.Word8' 639 | word8 :: Decoder Word8 640 | word8 = auto 641 | {-# INLINE word8 #-} 642 | 643 | 644 | -- | Decode JSON number to bounded 'Data.Word.Word16' 645 | word16 :: Decoder Word16 646 | word16 = auto 647 | {-# INLINE word16 #-} 648 | 649 | 650 | -- | Decode JSON number to bounded 'Data.Word.Word32' 651 | word32 :: Decoder Word32 652 | word32 = auto 653 | {-# INLINE word32 #-} 654 | 655 | 656 | -- | Decode JSON number to bounded 'Data.Word.Word64' 657 | word64 :: Decoder Word64 658 | word64 = auto 659 | {-# INLINE word64 #-} 660 | 661 | 662 | -- | Decode JSON number to 'Float' 663 | float :: Decoder Float 664 | float = auto 665 | {-# INLINE float #-} 666 | 667 | 668 | -- | Decode JSON number to 'Double' 669 | double :: Decoder Double 670 | double = auto 671 | {-# INLINE double #-} 672 | 673 | 674 | -- | Decode JSON number to arbitrary precision 'Scientific' 675 | scientific :: Decoder Scientific 676 | scientific = auto 677 | {-# INLINE scientific #-} 678 | 679 | 680 | -- | Decode single character JSON string to 'Data.Char' 681 | char :: Decoder Char 682 | char = auto 683 | {-# INLINE char #-} 684 | 685 | 686 | -- | Decode JSON string to 'Data.String' 687 | string :: Decoder String 688 | string = auto 689 | {-# INLINE string #-} 690 | 691 | 692 | -- | Decode JSON string to 'Data.Text' 693 | text :: Decoder Text 694 | text = auto 695 | {-# INLINE text #-} 696 | 697 | 698 | -- | Decode JSON string to 'Data.UUID.Types.UUID' 699 | uuid :: Decoder UUID 700 | uuid = auto 701 | {-# INLINE uuid #-} 702 | 703 | 704 | -- | Decode JSON string to 'Data.Version' 705 | version :: Decoder Version 706 | version = auto 707 | {-# INLINE version #-} 708 | 709 | 710 | -- | Decode JSON string to 'Data.Local.Time.ZonedTime' 711 | -- using Aeson's instance implementation. 712 | -- 713 | -- Supported string formats: 714 | -- 715 | -- YYYY-MM-DD HH:MM Z YYYY-MM-DD HH:MM:SS Z YYYY-MM-DD HH:MM:SS.SSS Z 716 | -- 717 | -- 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. 718 | zonedTime :: Decoder ZonedTime 719 | zonedTime = auto 720 | {-# INLINE zonedTime #-} 721 | 722 | 723 | -- | Decode JSON string to 'Data.Local.Time.LocalTime' 724 | -- using Aeson's instance implementation. 725 | localTime :: Decoder LocalTime 726 | localTime = auto 727 | {-# INLINE localTime #-} 728 | 729 | 730 | -- | Decode JSON string to 'Data.Local.Time.TimeOfDay' 731 | -- using Aeson's instance implementation. 732 | timeOfDay :: Decoder TimeOfDay 733 | timeOfDay = auto 734 | {-# INLINE timeOfDay #-} 735 | 736 | 737 | -- | Decode JSON string to 'Data.Time.Clock.UTCTime' 738 | -- using Aesons's instance implementation 739 | utcTime :: Decoder UTCTime 740 | utcTime = auto 741 | {-# INLINE utcTime #-} 742 | 743 | 744 | -- | Decode JSON string to 'Data.Time.Calendar.Day' 745 | -- using Aesons's instance implementation 746 | day :: Decoder Day 747 | day = auto 748 | {-# INLINE day #-} 749 | 750 | 751 | #if (MIN_VERSION_time_compat(1,9,2)) 752 | -- | Decode JSON string to 'Data.Time.Calendar.Compat.DayOfWeek' 753 | -- using Aesons's instance implementation 754 | -- 755 | -- This function requires 'time-compat' >= 1.9.2 756 | dayOfWeek :: Decoder DayOfWeek 757 | dayOfWeek = auto 758 | {-# INLINE dayOfWeek #-} 759 | #endif 760 | 761 | 762 | 763 | -- Decoding 764 | 765 | 766 | -- $decoding 767 | -- 768 | -- Following functions are evivalent to ones provided by Aeson itself. 769 | -- The only difference is that versions implemented by Aeson 770 | -- work only with instances of 'FromJSON' class. 771 | -- Functions defines in this module are using 'Decoder' argument 772 | -- instead of instance implementation. 773 | 774 | -- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'. 775 | -- If this fails due to incomplete or invalid input, 'Nothing' is 776 | -- returned. 777 | -- 778 | -- The input must consist solely of a JSON document, with no trailing 779 | -- data except for whitespace. 780 | -- 781 | -- This function parses immediately, but defers conversion. See 782 | -- 'Data.Aeson.json' for details. 783 | decode :: Decoder a -> LB.ByteString -> Maybe a 784 | decode (Decoder d) = 785 | Parser.decodeWith ParserI.jsonEOF (parse d) 786 | {-# INLINE decode #-} 787 | 788 | 789 | -- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'. 790 | -- If this fails due to incomplete or invalid input, 'Nothing' is 791 | -- returned. 792 | -- 793 | -- The input must consist solely of a JSON document, with no trailing 794 | -- data except for whitespace. 795 | -- 796 | -- This function parses and performs conversion immediately. See 797 | -- 'Data.Aeson.json'' for details. 798 | decode' :: Decoder a -> LB.ByteString -> Maybe a 799 | decode' (Decoder d) = 800 | Parser.decodeWith ParserI.jsonEOF' (parse d) 801 | {-# INLINE decode' #-} 802 | 803 | 804 | -- | Like 'decode' but returns an error message when decoding fails. 805 | eitherDecode :: Decoder a -> LB.ByteString -> Either String a 806 | eitherDecode (Decoder d) = 807 | eitherFormatError . Parser.eitherDecodeWith ParserI.jsonEOF (iparse d) 808 | {-# INLINE eitherDecode #-} 809 | 810 | 811 | -- | Like 'decode'' but returns an error message when decoding fails. 812 | eitherDecode' :: Decoder a -> LB.ByteString -> Either String a 813 | eitherDecode' (Decoder d) = 814 | eitherFormatError . Parser.eitherDecodeWith ParserI.jsonEOF' (iparse d) 815 | {-# INLINE eitherDecode' #-} 816 | 817 | 818 | -- Strict Decoding 819 | 820 | 821 | -- | Efficiently deserialize a JSON value from a strict 'B.ByteString'. 822 | -- If this fails due to incomplete or invalid input, 'Nothing' is 823 | -- returned. 824 | -- 825 | -- The input must consist solely of a JSON document, with no trailing 826 | -- data except for whitespace. 827 | -- 828 | -- This function parses immediately, but defers conversion. See 829 | -- 'Data.Aeson.json' for details. 830 | decodeStrict :: Decoder a -> B.ByteString -> Maybe a 831 | decodeStrict (Decoder d) = 832 | Parser.decodeStrictWith ParserI.jsonEOF (parse d) 833 | {-# INLINE decodeStrict #-} 834 | 835 | 836 | -- | Efficiently deserialize a JSON value from a strict 'B.ByteString'. 837 | -- If this fails due to incomplete or invalid input, 'Nothing' is 838 | -- returned. 839 | -- 840 | -- The input must consist solely of a JSON document, with no trailing 841 | -- data except for whitespace. 842 | -- 843 | -- This function parses and performs conversion immediately. See 844 | -- 'Data.Aeson.json'' for details. 845 | decodeStrict' :: Decoder a -> B.ByteString -> Maybe a 846 | decodeStrict' (Decoder d) = 847 | Parser.decodeStrictWith ParserI.jsonEOF' (parse d) 848 | {-# INLINE decodeStrict' #-} 849 | 850 | 851 | -- | Like 'decodeStrict' but returns an error message when decoding fails. 852 | eitherDecodeStrict :: Decoder a -> B.ByteString -> Either String a 853 | eitherDecodeStrict (Decoder d) = 854 | eitherFormatError . Parser.eitherDecodeStrictWith ParserI.jsonEOF (iparse d) 855 | {-# INLINE eitherDecodeStrict #-} 856 | 857 | 858 | -- | Like 'decodeStrict'' but returns an error message when decoding fails. 859 | eitherDecodeStrict' :: Decoder a -> B.ByteString -> Either String a 860 | eitherDecodeStrict' (Decoder d) = 861 | eitherFormatError . Parser.eitherDecodeStrictWith ParserI.jsonEOF' (iparse d) 862 | {-# INLINE eitherDecodeStrict' #-} 863 | 864 | 865 | -- File Decoding 866 | 867 | 868 | -- | Efficiently deserialize a JSON value from a file. 869 | -- If this fails due to incomplete or invalid input, 'Nothing' is 870 | -- returned. 871 | -- 872 | -- The input file's content must consist solely of a JSON document, 873 | -- with no trailing data except for whitespace. 874 | -- 875 | -- This function parses immediately, but defers conversion. See 876 | -- 'Data.Aeson.json' for details. 877 | decodeFileStrict :: Decoder a -> FilePath -> IO (Maybe a) 878 | decodeFileStrict dec = 879 | fmap (decodeStrict dec) . B.readFile 880 | {-# INLINE decodeFileStrict #-} 881 | 882 | 883 | -- | Efficiently deserialize a JSON value from a file. 884 | -- If this fails due to incomplete or invalid input, 'Nothing' is 885 | -- returned. 886 | -- 887 | -- The input file's content must consist solely of a JSON document, 888 | -- with no trailing data except for whitespace. 889 | -- 890 | -- This function parses and performs conversion immediately. See 891 | -- 'Data.Aeson.json'' for details. 892 | decodeFileStrict' :: Decoder a -> FilePath -> IO (Maybe a) 893 | decodeFileStrict' dec = 894 | fmap (decodeStrict' dec) . B.readFile 895 | {-# INLINE decodeFileStrict' #-} 896 | 897 | 898 | -- | Like 'decodeFileStrict' but returns an error message when decoding fails. 899 | eitherDecodeFileStrict :: Decoder a -> FilePath -> IO (Either String a) 900 | eitherDecodeFileStrict dec = 901 | fmap (eitherDecodeStrict dec) . B.readFile 902 | {-# INLINE eitherDecodeFileStrict #-} 903 | 904 | 905 | -- | Like 'decodeFileStrict'' but returns an error message when decoding fails. 906 | eitherDecodeFileStrict' :: Decoder a -> FilePath -> IO (Either String a) 907 | eitherDecodeFileStrict' dec = 908 | fmap (eitherDecodeStrict' dec) . B.readFile 909 | {-# INLINE eitherDecodeFileStrict' #-} 910 | 911 | 912 | -- Parsing 913 | 914 | 915 | -- | Run decoder over 'Value'. 916 | -- Returns 'Nothing' in case of failure 917 | parseMaybe :: Decoder a -> Value -> Maybe a 918 | parseMaybe (Decoder f) = ATypes.parseMaybe f 919 | {-# INLINE parseMaybe #-} 920 | 921 | 922 | -- | Run decoder over 'Value'. 923 | -- Returns 'Left' with error message in case of failure 924 | parseEither :: Decoder a -> Value -> Either String a 925 | parseEither (Decoder f) = ATypes.parseEither f 926 | {-# INLINE parseEither #-} 927 | 928 | 929 | -- Private functions Aeson doesn't expose 930 | 931 | 932 | eitherFormatError :: Either (JSONPath, String) a -> Either String a 933 | eitherFormatError = Prelude.either (Left . uncurry formatError) Right 934 | {-# INLINE eitherFormatError #-} 935 | 936 | 937 | #if !(MIN_VERSION_aeson(1,4,3)) 938 | -- These functions are not exposed in aeson 1.4.2.0 939 | -- implementation is copied from 940 | -- https://hackage.haskell.org/package/aeson-1.4.6.0/docs/src/Data.Aeson.Types.FromJSON.html#unexpected 941 | 942 | unexpected :: Value -> Parser a 943 | unexpected actual = Fail.fail $ "unexpected " ++ typeOf actual 944 | {-# INLINE unexpected #-} 945 | 946 | 947 | typeOf :: Value -> String 948 | typeOf v = case v of 949 | Object _ -> "Object" 950 | Array _ -> "Array" 951 | String _ -> "String" 952 | Number _ -> "Number" 953 | Bool _ -> "Boolean" 954 | Null -> "Null" 955 | {-# INLINE typeOf #-} 956 | #endif 957 | -------------------------------------------------------------------------------- /lib/Data/Aeson/Combinators/Encode.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | -- | 4 | -- Module : Data.Aeson.Combinators.Encode 5 | -- Copyright : (c) Marek Fajkus 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : marek.faj@gmail.com 9 | -- 10 | -- Functions in this module serve as an alternative 11 | -- 'ToJSON' type class. This allows to define for mapping 12 | -- from data type into multiple JSON representations. 13 | -- type level wrapping. 14 | -- 15 | -- There are two way of defining such encoder: 16 | -- 17 | -- * Using simple function @a -> Value@ which doesn't require this library 18 | -- * Using this library as DSL together with 'Contravariant' 19 | -- 20 | module Data.Aeson.Combinators.Encode ( 21 | -- * Importing 22 | -- $importing 23 | 24 | -- * Alternative to using 'Encode' Combinators 25 | -- $alternative 26 | 27 | -- * Example Usage 28 | -- $usage 29 | 30 | -- * Encoder 31 | Encoder(..) 32 | , auto 33 | , run 34 | -- * Object Encoding 35 | -- $objects 36 | , KeyValueEncoder 37 | , object 38 | , field 39 | -- ** Alternative Object Encoding 40 | , KeyValueEncoder' 41 | , object' 42 | , field' 43 | -- * Collections 44 | , list 45 | , vector 46 | , jsonArray 47 | -- * Encoding Primitive Values 48 | -- 49 | -- *** Void, Unit, Bool 50 | , void 51 | , unit, bool 52 | -- *** Integers (and Natural) 53 | , int, integer, int8, int16, int32, int64 54 | , word, word8, word16, word32, word64 55 | #if (MIN_VERSION_base(4,8,0)) 56 | , natural 57 | #endif 58 | -- *** Floating Points 59 | , float, double 60 | , scientific 61 | -- *** Strings 62 | , char, text, string 63 | , uuid, version 64 | -- * Encoding Time 65 | , zonedTime, localTime, timeOfDay 66 | , utcTime 67 | , day 68 | #if (MIN_VERSION_time_compat(1,9,2)) 69 | , dayOfWeek 70 | #endif 71 | -- * Evaluating Encoders 72 | , encode 73 | , toEncoding 74 | , module Data.Aeson.Combinators.Compat 75 | ) where 76 | 77 | import Control.Applicative 78 | import Control.Monad (join) 79 | import Data.Functor.Contravariant 80 | 81 | import Data.Aeson (ToJSON, Value (..)) 82 | import qualified Data.Aeson as Aeson 83 | import Data.Aeson.Combinators.Compat 84 | import qualified Data.Aeson.Encoding as E 85 | import Data.Aeson.Types (Pair) 86 | import qualified Data.ByteString.Lazy as BS 87 | import Data.Text (Text) 88 | import Data.Vector (Vector, fromList, (!?)) 89 | import qualified Data.Vector as Vector 90 | 91 | import Data.Int (Int16, Int32, Int64, Int8) 92 | import Data.Time.Calendar (Day) 93 | #if (MIN_VERSION_time_compat(1,9,2)) 94 | import Data.Time.Calendar.Compat (DayOfWeek) 95 | #endif 96 | import Data.Time.Clock (UTCTime) 97 | import Data.Time.LocalTime (LocalTime, TimeOfDay, ZonedTime) 98 | import Data.UUID.Types (UUID) 99 | import Data.Version (Version) 100 | import Data.Void (Void) 101 | import Data.Word (Word, Word16, Word32, Word64, 102 | Word8) 103 | #if (MIN_VERSION_base(4,8,0)) 104 | import GHC.Natural (Natural) 105 | #endif 106 | import qualified Data.HashMap.Lazy as HL 107 | import qualified Data.HashMap.Strict as HS 108 | import qualified Data.Map.Lazy as ML 109 | import qualified Data.Map.Strict as MS 110 | import Data.Scientific (Scientific) 111 | import Data.Traversable (traverse) 112 | 113 | {- $importing 114 | This module as meant to be import as @qualified@ 115 | 116 | > import Data.Aeson.Combinators.Encode as Encode 117 | -} 118 | 119 | {- $alternative 120 | Be aware than in most cause you won't need to use this module. 121 | you can utilize Aeson's 'Value' type and it's instance of 'ToJSON' directly. 122 | 123 | >>> import qualified Data.Aeson as Aeson 124 | >>> import Data.Aeson ((.=)) 125 | 126 | >>> data Object = Object { tag :: String, id :: Int } 127 | 128 | Define custom encoding function: 129 | 130 | >>> :{ 131 | encodeObject :: Object -> Value 132 | encodeObject (Object tag id) = 133 | Aeson.object ["tag" .= tag, "id" .= id] 134 | :} 135 | 136 | >>> Aeson.encode (encodeObject (Object "foo" 42)) 137 | "{\"tag\":\"foo\",\"id\":42}" 138 | -} 139 | 140 | {- $usage 141 | 142 | >>> :set -XOverloadedStrings 143 | >>> :set -XDeriveGeneric 144 | 145 | First lets define some type 146 | 147 | >>> :{ 148 | data Person = Person 149 | { name :: String 150 | , age :: Int 151 | } deriving (Show, Eq) 152 | :} 153 | 154 | And first encoder for this type: 155 | 156 | >>> :{ 157 | personEncoder :: Encoder Person 158 | personEncoder = object 159 | [ field "name" string name 160 | , field "age" int age 161 | ] 162 | :} 163 | 164 | We can use this 'Encoder' to encode value into JSON: 165 | 166 | >>> encode personEncoder (Person "Jane" 42) 167 | "{\"age\":42,\"name\":\"Jane\"}" 168 | 169 | Now we can use 'Contravariant' to manipulate our encoder. 170 | 171 | Our type might be wrap in some rither type like this one: 172 | 173 | >>> import Data.Functor.Contravariant 174 | >>> data Surrounding = S Person Bool 175 | 176 | But we still want to be able to encode it: 177 | 178 | >>> :{ 179 | surroundingEncoder :: Encoder Surrounding 180 | surroundingEncoder = contramap (\(S person _) -> person) personEncoder 181 | :} 182 | 183 | -} 184 | 185 | 186 | {-| 187 | Value describing encoding of @a@ into a JSON 'Value'. 188 | This is essentially just a wrapper around function that 189 | should be applied later. 190 | 191 | === Covariant to map function over input 192 | 193 | Given: 194 | 195 | >>> :{ 196 | data Person = Person 197 | { name :: String 198 | , age :: Int 199 | } deriving (Show, Eq) 200 | :} 201 | 202 | >>> :{ 203 | personEncoder :: Encoder Person 204 | personEncoder = object 205 | [ field "name" string name 206 | , field "age" int age 207 | ] 208 | :} 209 | 210 | We can extract person from any pair: 211 | 212 | >>> :{ 213 | -- Using personEncoder definition from example above 214 | pairEncoder2 :: Encoder (Person, a) 215 | pairEncoder2 = contramap fst personEncoder 216 | :} 217 | 218 | >>> encode pairEncoder2 (Person "Jane" 42, Nothing) 219 | "{\"age\":42,\"name\":\"Jane\"}" 220 | 221 | === Divisible and Decidable 222 | 223 | Some of you might know library @covariant@ and ask what is a support for 224 | other covariant typeclasses. 225 | It's not possible to define lawful Divisble instance for JSON 'Value' 226 | and by extension it's not possible to define Decidable either. 227 | While it is posible to provide somewhat useful unlawful instances for these this 228 | library opts to not to do that. 229 | 230 | -} 231 | newtype Encoder a = Encoder (a -> Value) 232 | 233 | 234 | instance Contravariant Encoder where 235 | contramap f (Encoder enc) = Encoder (enc . f) 236 | {-# INLINE contramap #-} 237 | 238 | 239 | -- | Run 'Encoder' given a value. this is essentially just a function application. 240 | run :: Encoder a -> a -> Value 241 | run (Encoder f) = f 242 | {-# INLINE run #-} 243 | 244 | 245 | -- | "Grab" 'Encoder' from 'ToJSON' definition. 246 | auto :: ToJSON a => Encoder a 247 | auto = Encoder Aeson.toJSON 248 | {-# INLINE auto #-} 249 | 250 | 251 | -- Combinators 252 | 253 | {- $objects 254 | There are two alternative ways of defining Object encodings. 255 | Both provide "eqvivalent" types and functions with consistent naming. 256 | Variants without and with @'@ suffix are meant to be used together. 257 | -} 258 | 259 | {-| Object Encoder 260 | 261 | >>> :{ 262 | data Object = Object 263 | { name :: Text 264 | , age :: Int 265 | } deriving (Show, Eq) 266 | :} 267 | 268 | >>> :{ 269 | objectEncoder :: Encoder Object 270 | objectEncoder = object 271 | [ field "name" text name 272 | , field "age" int age 273 | ] 274 | :} 275 | 276 | >>> encode objectEncoder $ Object "Joe" 30 277 | "{\"age\":30,\"name\":\"Joe\"}" 278 | 279 | -} 280 | type KeyValueEncoder a = a -> Pair 281 | 282 | 283 | {-| Object combinators -} 284 | object :: [KeyValueEncoder a] -> Encoder a 285 | object xs = Encoder $ \val -> Aeson.object $ fmap (\f -> f val) xs 286 | {-# INLINE object #-} 287 | 288 | 289 | {-| Define object field -} 290 | field :: Key -> Encoder b -> (a -> b) -> KeyValueEncoder a 291 | field name (Encoder enc) get v = (name, enc $ get v) 292 | {-# INLINE field #-} 293 | 294 | 295 | {-| Object Encoder (alternative) 296 | 297 | >>> :set -XRecordWildCards 298 | 299 | >>> :{ 300 | data Object = Object 301 | { name :: Text 302 | , age :: Int 303 | } deriving (Show, Eq) 304 | :} 305 | 306 | >>> :{ 307 | objectEncoder' :: Encoder Object 308 | objectEncoder' = object' $ \Object{..} -> 309 | [ field' "name" text name 310 | , field' "age" int age 311 | ] 312 | :} 313 | 314 | >>> encode objectEncoder' $ Object "Joe" 30 315 | "{\"age\":30,\"name\":\"Joe\"}" 316 | -} 317 | type KeyValueEncoder' a = a -> [Pair] 318 | 319 | 320 | {-| Object combinators (alternative) -} 321 | object' :: KeyValueEncoder' a -> Encoder a 322 | object' f = Encoder $ \val -> Aeson.object $ f val 323 | {-# INLINE object' #-} 324 | 325 | 326 | {-| Define object field (alternative) -} 327 | field' :: Key -> Encoder a -> a -> (Key, Value) 328 | field' name (Encoder enc) val = (name, enc val) 329 | {-# INLINE field' #-} 330 | 331 | 332 | -- Collections 333 | 334 | 335 | {-| Encode 'Vector' -} 336 | vector :: Encoder a -> Encoder (Vector a) 337 | vector (Encoder f) = Encoder $ \val -> Aeson.Array $ f <$> val 338 | {-# INLINE vector #-} 339 | 340 | 341 | {-| Encode 'List' -} 342 | list :: Encoder a -> Encoder [a] 343 | list (Encoder f) = Encoder $ \val -> Aeson.Array $ fromList $ f <$> val 344 | {-# INLINE list #-} 345 | 346 | 347 | {-| Encode multiple values as array -} 348 | jsonArray :: [Encoder a] -> Encoder a 349 | jsonArray xs = Encoder $ \a -> Array $ Vector.fromList $ (\(Encoder f) -> f a) <$> xs 350 | {-# INLINE jsonArray #-} 351 | 352 | 353 | -- Basic Encoders 354 | 355 | 356 | -- | Encode any JSON value to 'Void' value 357 | -- which is impossible to construct. 358 | -- 359 | -- __This Encoder is guarenteed to fail.__ 360 | void :: Encoder Void 361 | void = auto 362 | {-# INLINE void #-} 363 | 364 | 365 | -- | Encode JSON null into '()' 366 | unit :: Encoder () 367 | unit = auto 368 | {-# INLINE unit #-} 369 | 370 | 371 | -- | Encode JSON booleans to Haskell 'Data.Bool' 372 | bool :: Encoder Bool 373 | bool = auto 374 | {-# INLINE bool #-} 375 | 376 | 377 | -- | Encode JSON number to 'Data.Int.Int' 378 | int :: Encoder Int 379 | int = auto 380 | {-# INLINE int #-} 381 | 382 | 383 | -- | Encode JSON number to 'Data.Int.Int8' 384 | int8 :: Encoder Int8 385 | int8 = auto 386 | {-# INLINE int8 #-} 387 | 388 | 389 | -- | Encode JSON number to 'Data.Int.Int16' 390 | int16 :: Encoder Int16 391 | int16 = auto 392 | {-# INLINE int16 #-} 393 | 394 | 395 | -- | Encode JSON number to 'Data.Int.Int32' 396 | int32 :: Encoder Int32 397 | int32 = auto 398 | {-# INLINE int32 #-} 399 | 400 | 401 | -- | Encode JSON number to 'Data.Int.Int64' 402 | int64 :: Encoder Int64 403 | int64 = auto 404 | {-# INLINE int64 #-} 405 | 406 | 407 | -- | Encode JSON number to unbounded 'Integer' 408 | integer :: Encoder Integer 409 | integer = auto 410 | {-# INLINE integer #-} 411 | 412 | 413 | #if (MIN_VERSION_base(4,8,0)) 414 | -- | Encode JSON number to GHC's 'GHC.Natural' (non negative) 415 | -- 416 | -- This function requires 'base' >= 4.8.0 417 | natural :: Encoder Natural 418 | natural = auto 419 | {-# INLINE natural #-} 420 | #endif 421 | 422 | 423 | -- | Encode JSON number to bounded 'Data.Word.Word' 424 | word :: Encoder Word 425 | word = auto 426 | {-# INLINE word #-} 427 | 428 | 429 | -- | Encode JSON number to bounded 'Data.Word.Word8' 430 | word8 :: Encoder Word8 431 | word8 = auto 432 | {-# INLINE word8 #-} 433 | 434 | 435 | -- | Encode JSON number to bounded 'Data.Word.Word16' 436 | word16 :: Encoder Word16 437 | word16 = auto 438 | {-# INLINE word16 #-} 439 | 440 | 441 | -- | Encode JSON number to bounded 'Data.Word.Word32' 442 | word32 :: Encoder Word32 443 | word32 = auto 444 | {-# INLINE word32 #-} 445 | 446 | 447 | -- | Encode JSON number to bounded 'Data.Word.Word64' 448 | word64 :: Encoder Word64 449 | word64 = auto 450 | {-# INLINE word64 #-} 451 | 452 | 453 | -- | Encode JSON number to 'Float' 454 | float :: Encoder Float 455 | float = auto 456 | {-# INLINE float #-} 457 | 458 | 459 | -- | Encode JSON number to 'Double' 460 | double :: Encoder Double 461 | double = auto 462 | {-# INLINE double #-} 463 | 464 | 465 | -- | Encode JSON number to arbitrary precision 'Scientific' 466 | scientific :: Encoder Scientific 467 | scientific = auto 468 | {-# INLINE scientific #-} 469 | 470 | 471 | -- | Encode single character JSON string to 'Data.Char' 472 | char :: Encoder Char 473 | char = auto 474 | {-# INLINE char #-} 475 | 476 | 477 | -- | Encode JSON string to 'Data.String' 478 | string :: Encoder String 479 | string = auto 480 | {-# INLINE string #-} 481 | 482 | 483 | -- | Encode JSON string to 'Data.Text' 484 | text :: Encoder Text 485 | text = auto 486 | {-# INLINE text #-} 487 | 488 | 489 | -- | Encode JSON string to 'Data.UUID.Types.UUID' 490 | uuid :: Encoder UUID 491 | uuid = auto 492 | {-# INLINE uuid #-} 493 | 494 | 495 | -- | Encode JSON string to 'Data.Version' 496 | version :: Encoder Version 497 | version = auto 498 | {-# INLINE version #-} 499 | 500 | 501 | -- | Encode JSON string to 'Data.Local.Time.ZonedTime' 502 | -- using Aeson's instance implementation. 503 | -- 504 | -- Supported string formats: 505 | -- 506 | -- YYYY-MM-DD HH:MM Z YYYY-MM-DD HH:MM:SS Z YYYY-MM-DD HH:MM:SS.SSS Z 507 | -- 508 | -- 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. 509 | zonedTime :: Encoder ZonedTime 510 | zonedTime = auto 511 | {-# INLINE zonedTime #-} 512 | 513 | 514 | -- | Encode JSON string to 'Data.Local.Time.LocalTime' 515 | -- using Aeson's instance implementation. 516 | localTime :: Encoder LocalTime 517 | localTime = auto 518 | {-# INLINE localTime #-} 519 | 520 | 521 | -- | Encode JSON string to 'Data.Local.Time.TimeOfDay' 522 | -- using Aeson's instance implementation. 523 | timeOfDay :: Encoder TimeOfDay 524 | timeOfDay = auto 525 | {-# INLINE timeOfDay #-} 526 | 527 | 528 | -- | Encode JSON string to 'Data.Time.Clock.UTCTime' 529 | -- using Aesons's instance implementation 530 | utcTime :: Encoder UTCTime 531 | utcTime = auto 532 | {-# INLINE utcTime #-} 533 | 534 | 535 | -- | Encode JSON string to 'Data.Time.Calendar.Day' 536 | -- using Aesons's instance implementation 537 | day :: Encoder Day 538 | day = auto 539 | {-# INLINE day #-} 540 | 541 | 542 | #if (MIN_VERSION_time_compat(1,9,2)) 543 | -- | Encode JSON string to 'Data.Time.Calendar.Compat.DayOfWeek' 544 | -- using Aesons's instance implementation 545 | -- 546 | -- This function requires 'time-compat' >= 1.9.2 547 | dayOfWeek :: Encoder DayOfWeek 548 | dayOfWeek = auto 549 | {-# INLINE dayOfWeek #-} 550 | #endif 551 | 552 | 553 | -- Encode 554 | 555 | 556 | {-| Encode value into (Lazy) @ByteString@ 557 | -} 558 | encode :: Encoder a -> a -> BS.ByteString 559 | encode encoder = 560 | E.encodingToLazyByteString . toEncoding encoder 561 | {-# INLINE encode #-} 562 | 563 | 564 | {-| Convert value to encoding 565 | -} 566 | toEncoding :: Encoder a -> a -> E.Encoding 567 | toEncoding (Encoder enc) = E.value . enc 568 | {-# INLINE toEncoding #-} 569 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | with (import ./default.nix); 2 | ghc925.env 3 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2023-12-28 2 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: 32fd92ba224ce05d14c465a117f7668250053f6649d73869460b9ea4d23a99ce 10 | size: 513657 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2023/12/28.yaml 12 | original: nightly-2023-12-28 13 | -------------------------------------------------------------------------------- /test/JSONDecodeSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | 6 | module JSONDecodeSpec where 7 | 8 | import Control.Applicative 9 | import qualified Data.Aeson.Combinators.Decode as JD 10 | import Data.Aeson.Types (FromJSON (..)) 11 | import Data.ByteString.Lazy 12 | import Data.ByteString.Lazy.UTF8 (fromString) 13 | import Data.Text 14 | import GHC.Generics 15 | import Test.Hspec 16 | 17 | data Object = Object 18 | { name :: Text 19 | , nick :: Text 20 | } 21 | deriving (Show, Eq, Generic) 22 | 23 | data FooBar = Foo | Bar 24 | deriving (Show, Eq) 25 | 26 | instance FromJSON Object 27 | 28 | decoder :: JD.Decoder Object 29 | decoder = 30 | Object 31 | <$> JD.key "name" JD.text 32 | <*> JD.key "nick" JD.text 33 | 34 | json :: ByteString 35 | json = "{\"name\":\"Jany Doe\",\"nick\": \"jany\"}" 36 | 37 | jsonNested :: ByteString 38 | jsonNested = "{\"data\":" <> json <> "}" 39 | 40 | objectSpec :: Spec 41 | objectSpec = do 42 | describe "field" $ do 43 | let res = Just $ Object "Jany Doe" "jany" 44 | 45 | it "should decode object" $ do 46 | JD.decode decoder json `shouldBe` res 47 | 48 | it "should decode nested object" $ do 49 | JD.decode (JD.key "data" decoder) jsonNested 50 | `shouldBe` res 51 | 52 | it "should be possible to use default decoder" $ do 53 | JD.decode JD.auto json `shouldBe` res 54 | 55 | describe "at" $ do 56 | let 57 | nest' :: Int -> ByteString -> ByteString 58 | nest' n inner = 59 | if n <= 0 then 60 | inner 61 | else 62 | nest' (n - 1) ("{\"level-" <> fromString (show n) <> "\":" <> inner <> "}") 63 | let nest n = nest' n json 64 | let res = Just $ Object "Jany Doe" "jany" 65 | 66 | it "should decode object directly for empty list" $ do 67 | JD.decode (JD.at [] decoder) json 68 | `shouldBe` res 69 | 70 | it "should decode 2 level json" $ do 71 | let jdata = nest 2 72 | 73 | JD.decode (JD.at ["level-1", "level-2"] decoder) jdata 74 | `shouldBe` res 75 | 76 | it "should decode 10 level json" $ do 77 | let jdata = nest 10 78 | let path = ["level-1", "level-2", "level-3", "level-4", "level-5" 79 | , "level-6", "level-7", "level-8", "level-9", "level-10" 80 | ] 81 | 82 | JD.decode (JD.at path decoder) jdata `shouldBe` res 83 | 84 | arraySpec :: Spec 85 | arraySpec = do 86 | describe "index" $ do 87 | it "decode singleton by index" $ do 88 | JD.decode (JD.index 0 decoder) "[{\"name\": \"Sanders\", \"nick\": \"bern\"}]" 89 | `shouldBe` Just (Object "Sanders" "bern") 90 | 91 | it "should decode nth index" $ do 92 | JD.decode (JD.index 1 decoder) "[false, {\"name\": \"Sanders\", \"nick\": \"bern\"}, true]" 93 | `shouldBe` Just (Object "Sanders" "bern") 94 | 95 | monadSpec :: Spec 96 | monadSpec = 97 | describe "monadic decoding" $ do 98 | let fromText v = 99 | case v of 100 | "foo" -> pure Foo 101 | "bar" -> pure Bar 102 | _ -> fail "unknown" 103 | 104 | it "should work as a dummy value" $ do 105 | JD.decode (JD.string >>= pure) "\"foo\"" 106 | `shouldBe` Just "foo" 107 | 108 | it "should turn string to sum" $ do 109 | JD.decode (JD.string >>= fromText) "\"foo\"" 110 | `shouldBe` Just Foo 111 | 112 | it "should fail with right error" $ do 113 | JD.eitherDecode (JD.string >>= fromText) "\"foobar\"" 114 | `shouldBe` Left "Error in $: unknown" 115 | 116 | alternativeSpec :: Spec 117 | alternativeSpec = 118 | describe "alternative (<|>)" $ do 119 | let (dec :: JD.Decoder (Either Bool Object)) = 120 | Left <$> JD.bool <|> Right <$> decoder 121 | 122 | it "should decode first alternative" $ do 123 | JD.decode dec "false" `shouldBe` Just (Left False) 124 | 125 | it "should decode second alternative" $ do 126 | JD.decode dec "{\"name\": \"Joe\",\"nick\": \"jd\"}" 127 | `shouldBe` Just (Right $ Object "Joe" "jd") 128 | 129 | jsonNullSpec :: Spec 130 | jsonNullSpec = 131 | describe "jsonNull" $ do 132 | let barDec txt = 133 | case txt of 134 | "bar" -> pure Bar 135 | _ -> fail $ "Unknown value" <> show txt 136 | 137 | let (dec :: JD.Decoder FooBar) = 138 | JD.jsonNull Foo <|> (barDec =<< JD.text) 139 | 140 | it "should decode Foo from null" $ do 141 | JD.decode dec "null" `shouldBe` Just Foo 142 | 143 | it "should decode Bar from string" $ do 144 | JD.decode dec "\"bar\"" `shouldBe` Just Bar 145 | 146 | spec :: Spec 147 | spec = do 148 | objectSpec 149 | arraySpec 150 | monadSpec 151 | alternativeSpec 152 | jsonNullSpec 153 | -------------------------------------------------------------------------------- /test/JSONEncodeSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | module JSONEncodeSpec where 5 | 6 | import qualified Data.Aeson.Combinators.Encode as JE 7 | import Data.Text 8 | import Test.Hspec 9 | 10 | 11 | data Object = Object 12 | { name :: Text 13 | , age :: Int 14 | } deriving (Show, Eq) 15 | 16 | 17 | objectEncoder :: JE.Encoder Object 18 | objectEncoder = JE.object 19 | [ JE.field "name" JE.text name 20 | , JE.field "age" JE.int age 21 | ] 22 | 23 | 24 | objectEncoder' :: JE.Encoder Object 25 | objectEncoder' = JE.object' $ \Object {..} -> 26 | [ JE.field' "name" JE.text name 27 | , JE.field' "age" JE.int age 28 | ] 29 | 30 | 31 | encodePrimitives :: Spec 32 | encodePrimitives = describe "primitives" $ do 33 | it "encode bool" $ do 34 | JE.encode JE.bool True `shouldBe` "true" 35 | 36 | 37 | objectEncoding :: Spec 38 | objectEncoding = do 39 | let object = Object "Joe" 30 40 | 41 | -- poor man's workaround for key ordering 42 | -- see: https://github.com/haskell/aeson/issues/837 43 | let json res = 44 | res == "{\"age\":30,\"name\":\"Joe\"}" 45 | || res == "{\"name\":\"Joe\",\"age\":30}" 46 | 47 | describe "object encoding" $ do 48 | it "should encode using getter style encoding" $ do 49 | JE.encode objectEncoder object `shouldSatisfy` json 50 | 51 | it "should encode using explicit style encoding" $ do 52 | JE.encode objectEncoder' object `shouldSatisfy` json 53 | 54 | 55 | listSpec :: Spec 56 | listSpec = describe "list encoding" $ do 57 | it "encodes list of bools" $ do 58 | JE.encode (JE.list JE.auto) [True, False] `shouldBe` "[true,false]" 59 | 60 | 61 | data MyRec = MyRec 62 | { recTitle :: String 63 | , recStart :: Int 64 | , recEnd :: Int 65 | } deriving (Show, Eq) 66 | 67 | 68 | spec :: Spec 69 | spec = do 70 | encodePrimitives 71 | objectEncoding 72 | listSpec 73 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | import qualified JSONDecodeSpec as Decode 2 | import qualified JSONEncodeSpec as Encode 3 | import Test.Hspec (hspec) 4 | 5 | main :: IO () 6 | main = hspec $ do 7 | Decode.spec 8 | Encode.spec 9 | --------------------------------------------------------------------------------