aeson 1.5.6.0 → 2.0.0.0

raw patch · 26 files changed

+1498/−1153 lines, 26 filesdep +indexed-traversabledep +semialigndep +witherabledep −faildep −hashable-timedep ~basedep ~base-compat-batteriesdep ~base-orphansPVP ok

version bump matches the API change (PVP)

Dependencies added: indexed-traversable, semialign, witherable

Dependencies removed: fail, hashable-time

Dependency ranges changed: base, base-compat-batteries, base-orphans, bytestring, containers, deepseq, ghc-prim, hashable, nats, scientific, semigroups, strict, template-haskell, these, time, time-compat, transformers, transformers-compat

API changes (from Hackage documentation)

Files

• aeson.cabal +163/−180
• changelog.md +21/−1
• include/incoherent-compat.h +0/−7
• include/overlapping-compat.h +0/−8
• src/Data/Aeson.hs +1/−0
• src/Data/Aeson/Encode.hs +0/−31
• src/Data/Aeson/Encoding/Builder.hs +10/−5
• src/Data/Aeson/Encoding/Internal.hs +47/−9
• src/Data/Aeson/Internal/Functions.hs +15/−9
• src/Data/Aeson/Key.hs +94/−0
• src/Data/Aeson/KeyMap.hs +659/−0
• src/Data/Aeson/Parser/Internal.hs +33/−25
• src/Data/Aeson/QQ/Simple.hs +12/−0
• src/Data/Aeson/TH.hs +47/−43
• src/Data/Aeson/Text.hs +4/−3
• src/Data/Aeson/Types.hs +2/−0
• src/Data/Aeson/Types/Class.hs +1/−0
• src/Data/Aeson/Types/FromJSON.hs +162/−267
• src/Data/Aeson/Types/Generic.hs +1/−7
• src/Data/Aeson/Types/Internal.hs +22/−25
• src/Data/Aeson/Types/ToJSON.hs +99/−441
• tests/Encoders.hs +4/−4
• tests/Instances.hs +7/−2
• tests/PropUtils.hs +7/−5
• tests/SerializationFormatSpec.hs +5/−5
• tests/UnitTests.hs +82/−76

@@ -1,256 +1,239 @@-name:            aeson-version:         1.5.6.0-license:         BSD3-license-file:    LICENSE-category:        Text, Web, JSON-copyright:       (c) 2011-2016 Bryan O'Sullivan-                 (c) 2011 MailRank, Inc.-author:          Bryan O'Sullivan <bos@serpentine.com>-maintainer:      Adam Bergmark <adam@bergmark.nl>-stability:       experimental-tested-with:     GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1-synopsis:        Fast JSON parsing and encoding-cabal-version:   >= 1.10-homepage:        https://github.com/haskell/aeson-bug-reports:     https://github.com/haskell/aeson/issues-build-type:      Simple-description:-    A JSON parsing and encoding library optimized for ease of use-    and high performance.-    .-    To get started, see the documentation for the @Data.Aeson@ module-    below.-    .-    (A note on naming: in Greek mythology, Aeson was the father of Jason.)+name:               aeson+version:            2.0.0.0+license:            BSD3+license-file:       LICENSE+category:           Text, Web, JSON+copyright:+  (c) 2011-2016 Bryan O'Sullivan+  (c) 2011 MailRank, Inc. -extra-source-files:-    *.yaml-    README.markdown-    cbits/*.c-    changelog.md-    include/*.h-    tests/JSONTestSuite/test_parsing/*.json-    tests/JSONTestSuite/test_transform/*.json-    tests/golden/*.expected-    src-ffi/Data/Aeson/Parser/*.hs-    src-pure/Data/Aeson/Parser/*.hs-    benchmarks/json-data/*.json+author:             Bryan O'Sullivan <bos@serpentine.com>+maintainer:         Adam Bergmark <adam@bergmark.nl>+stability:          experimental+tested-with:+  GHC ==8.0.2+   || ==8.2.2+   || ==8.4.4+   || ==8.6.5+   || ==8.8.4+   || ==8.10.4+   || ==9.0.1 -flag developer-  description: operate in developer mode-  default: False-  manual: True+synopsis:           Fast JSON parsing and encoding+cabal-version:      >=1.10+homepage:           https://github.com/haskell/aeson+bug-reports:        https://github.com/haskell/aeson/issues+build-type:         Simple+description:+  A JSON parsing and encoding library optimized for ease of use+  and high performance.+  .+  To get started, see the documentation for the @Data.Aeson@ module+  below.+  .+  (A note on naming: in Greek mythology, Aeson was the father of Jason.) -flag fast-  description: compile without optimizations-  default: False-  manual: True+extra-source-files:+  *.yaml+  benchmarks/json-data/*.json+  cbits/*.c+  changelog.md+  README.markdown+  src-ffi/Data/Aeson/Parser/*.hs+  src-pure/Data/Aeson/Parser/*.hs+  tests/golden/*.expected+  tests/JSONTestSuite/test_parsing/*.json+  tests/JSONTestSuite/test_transform/*.json  flag bytestring-builder-  description: Depend on the bytestring-builder package for backwards compatibility.-  default: False-  manual: False+  description:+    Depend on the bytestring-builder package for backwards compatibility. +  default:     False+  manual:      False+ flag cffi-  description: Controls whether to include c-ffi bits or pure haskell. Default to False for security.-  default: False-  manual: True+  description:+    Controls whether to include c-ffi bits or pure haskell. Default to False for security. +  default:     False+  manual:      True++flag ordered-keymap+  description:+    Use ordered @Data.Map.Strict@ for KeyMap implementation.++  default:     False+  manual:      True+ library   default-language: Haskell2010-  hs-source-dirs: src attoparsec-iso8601/src-+  hs-source-dirs:   src attoparsec-iso8601/src   exposed-modules:     Data.Aeson     Data.Aeson.Encoding-    Data.Aeson.Parser-    Data.Aeson.Text-    Data.Aeson.Types-    Data.Aeson.TH-    Data.Aeson.QQ.Simple-     Data.Aeson.Encoding.Internal     Data.Aeson.Internal     Data.Aeson.Internal.Time+    Data.Aeson.Key+    Data.Aeson.KeyMap+    Data.Aeson.Parser     Data.Aeson.Parser.Internal--  -- Deprecated modules-  exposed-modules:-    Data.Aeson.Encode+    Data.Aeson.QQ.Simple+    Data.Aeson.Text+    Data.Aeson.TH+    Data.Aeson.Types    other-modules:     Data.Aeson.Encoding.Builder     Data.Aeson.Internal.Functions-    Data.Aeson.Parser.Unescape     Data.Aeson.Parser.Time+    Data.Aeson.Parser.Unescape+    Data.Aeson.Types.Class     Data.Aeson.Types.FromJSON     Data.Aeson.Types.Generic-    Data.Aeson.Types.ToJSON-    Data.Aeson.Types.Class     Data.Aeson.Types.Internal+    Data.Aeson.Types.ToJSON     Data.Attoparsec.Time     Data.Attoparsec.Time.Internal    -- GHC bundled libs   build-depends:-    base             >= 4.7.0.0 && < 5,-    bytestring       >= 0.10.4.0 && < 0.12,-    containers       >= 0.5.5.1 && < 0.7,-    deepseq          >= 1.3.0.0 && < 1.5,-    ghc-prim         >= 0.2     && < 0.8,-    template-haskell >= 2.9.0.0 && < 2.18,-    text             >= 1.2.3.0 && < 1.3,-    time             >= 1.4     && < 1.12--  if impl(ghc >= 8.0)-    build-depends: bytestring >= 0.10.8.1+      base              >=4.9.0.0  && <5+    , bytestring        >=0.10.8.1 && <0.12+    , containers        >=0.5.7.1  && <0.7+    , deepseq           >=1.4.2.0  && <1.5+    , ghc-prim          >=0.5.0.0  && <0.8+    , template-haskell  >=2.11.0.0 && <2.18+    , text              >=1.2.3.0  && <1.3+    , time              >=1.6.0.1  && <1.12    -- Compat   build-depends:-    base-compat-batteries >= 0.10.0   && < 0.12,-    time-compat           >= 1.9.4    && < 1.10--  if !impl(ghc >= 8.6)-    build-depends:-      contravariant >=1.4.1    && <1.6--  if !impl(ghc >= 8.0)-    -- `Data.Semigroup` and `Control.Monad.Fail` and `Control.Monad.IO.Class` are available in base only since GHC 8.0 / base 4.9-    build-depends:-      semigroups          >= 0.18.5  && < 0.20,-      transformers        >= 0.3.0.0 && < 0.6,-      transformers-compat >= 0.6.2   && < 0.7,-      fail == 4.9.*+      base-compat-batteries  >=0.10.0 && <0.13+    , time-compat            >=1.9.6  && <1.10 -  if !impl(ghc >= 7.10)-    -- `Numeric.Natural` is available in base only since GHC 7.10 / base 4.8-    build-depends: nats >= 1.1.1 && < 1.2,-                   void >= 0.7.2 && < 0.8+  if !impl(ghc >=8.6)+    build-depends: contravariant >=1.4.1 && <1.6    -- Other dependencies   build-depends:-    attoparsec           >= 0.13.2.2 && < 0.14,-    data-fix             >= 0.3      && < 0.4,-    dlist                >= 0.8.0.4  && < 1.1,-    hashable             >= 1.2.7.0  && < 1.4,-    primitive            >= 0.7.0.1  && < 0.8,-    scientific           >= 0.3.6.2  && < 0.4,-    strict               >= 0.4      && < 0.5,-    tagged               >= 0.8.6    && < 0.9,-    th-abstraction       >= 0.2.8.0  && < 0.5,-    these                >= 1.1      && < 1.2,-    unordered-containers >= 0.2.10.0 && < 0.3,-    uuid-types           >= 1.0.3    && < 1.1,-    vector               >= 0.12.0.1 && < 0.13--  ghc-options: -Wall--  if flag(developer)-    ghc-options: -Werror-    ghc-prof-options: -auto-all+      attoparsec            >=0.13.2.2 && <0.15+    , data-fix              >=0.3      && <0.4+    , dlist                 >=0.8.0.4  && <1.1+    , hashable              >=1.2.7.0  && <1.4+    , indexed-traversable   >=0.1.1    && <0.2+    , primitive             >=0.7.0.1  && <0.8+    , scientific            >=0.3.7.0  && <0.4+    , semialign             >=1.2      && <1.3+    , strict                >=0.4      && <0.5+    , tagged                >=0.8.6    && <0.9+    , th-abstraction        >=0.2.8.0  && <0.5+    , these                 >=1.1      && <1.2+    , unordered-containers  >=0.2.10.0 && <0.3+    , uuid-types            >=1.0.3    && <1.1+    , vector                >=0.12.0.1 && <0.13+    , witherable            >=0.4.1    && <0.5 -  if flag(fast)-    ghc-options: -O0-  else-    ghc-options: -O2+  ghc-options:      -Wall -  include-dirs: include-  if impl(ghcjs) || !flag(cffi)+  if (impl(ghcjs) || !flag(cffi))     hs-source-dirs: src-pure-    other-modules: Data.Aeson.Parser.UnescapePure+    other-modules:  Data.Aeson.Parser.UnescapePure+   else-    c-sources: cbits/unescape_string.c-    cpp-options: -DCFFI+    c-sources:      cbits/unescape_string.c+    cpp-options:    -DCFFI     hs-source-dirs: src-ffi-    other-modules: Data.Aeson.Parser.UnescapeFFI+    other-modules:  Data.Aeson.Parser.UnescapeFFI +  if flag(ordered-keymap)+    cpp-options: -DUSE_ORDEREDMAP=1+ test-suite aeson-tests   default-language: Haskell2010-  type: exitcode-stdio-1.0-  hs-source-dirs: tests src-ffi src-pure-  main-is: Tests.hs-  c-sources: cbits/unescape_string.c-  ghc-options: -Wall -threaded -rtsopts-+  type:             exitcode-stdio-1.0+  hs-source-dirs:   tests src-ffi src-pure+  main-is:          Tests.hs+  c-sources:        cbits/unescape_string.c+  ghc-options:      -Wall -threaded -rtsopts   other-modules:     Data.Aeson.Parser.UnescapeFFI     Data.Aeson.Parser.UnescapePure-    DataFamilies.Properties-    DataFamilies.Instances     DataFamilies.Encoders+    DataFamilies.Instances+    DataFamilies.Properties     DataFamilies.Types     Encoders     ErrorMessages     Functions     Instances     Options-    PropUtils     Properties     PropertyGeneric     PropertyKeys     PropertyRoundTrip     PropertyRTFunctors     PropertyTH+    PropUtils     SerializationFormatSpec     Types     UnitTests     UnitTests.NullaryConstructors    build-depends:-    QuickCheck >= 2.14.2 && < 2.15,-    aeson,-    integer-logarithms >= 1 && <1.1,-    attoparsec,-    base,-    base-compat,-    base-orphans >= 0.5.3 && <0.9,-    base16-bytestring,-    containers,-    data-fix,-    directory,-    dlist,-    Diff >= 0.4 && < 0.5,-    filepath,-    generic-deriving >= 1.10 && < 1.15,-    ghc-prim >= 0.2,-    hashable >= 1.2.4.0,-    hashable-time >= 0.2.1 && <0.3,-    scientific,-    strict,-    tagged,-    template-haskell,-    tasty,-    tasty-golden,-    tasty-hunit,-    tasty-quickcheck,-    text,-    these,-    time,-    time-compat,-    unordered-containers,-    uuid-types,-    vector,-    quickcheck-instances >= 0.3.25.2 && <0.4+      aeson+    , attoparsec+    , base+    , base-compat+    , base-orphans          >=0.5.3    && <0.9+    , base16-bytestring+    , containers+    , data-fix+    , Diff                  >=0.4      && <0.5+    , directory+    , dlist+    , filepath+    , generic-deriving      >=1.10     && <1.15+    , ghc-prim              >=0.2+    , hashable              >=1.2.4.0+    , integer-logarithms    >=1        && <1.1+    , QuickCheck            >=2.14.2   && <2.15+    , quickcheck-instances  >=0.3.25.2 && <0.4+    , scientific+    , strict+    , tagged+    , tasty+    , tasty-golden+    , tasty-hunit+    , tasty-quickcheck+    , template-haskell+    , text+    , these+    , time+    , time-compat+    , unordered-containers+    , uuid-types+    , vector    if flag(bytestring-builder)-    build-depends: bytestring >= 0.9 && < 0.10.4,-                   bytestring-builder >= 0.10.4 && < 1-  else-    build-depends: bytestring >= 0.10.4--  if !impl(ghc >= 8.0)     build-depends:-      semigroups >= 0.18.2 && < 0.20,-      transformers >= 0.2.2.0,-      transformers-compat >= 0.3+        bytestring          >=0.9    && <0.10.4+      , bytestring-builder  >=0.10.4 && <1 -  if !impl(ghc >= 7.10)-    build-depends: nats >=1 && <1.2,-                   void >=0.7.2 && <0.8+  else+    build-depends: bytestring >=0.10.4 +  if !impl(ghc >=8.0)+    build-depends:+        semigroups           >=0.18.2  && <0.20+      , transformers         >=0.2.2.0+      , transformers-compat  >=0.3 -  if flag(fast)-    ghc-options: -fno-enable-rewrite-rules+  if !impl(ghc >=7.10)+    build-depends:+        nats  >=1     && <1.2+      , void  >=0.7.2 && <0.8  source-repository head   type:     git

@@ -1,4 +1,24 @@-For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).+For the latest version of this document, please see [https://github.com/haskell/aeson/blob/master/changelog.md](https://github.com/haskell/aeson/blob/master/changelog.md).++### 2.0.0.0++* Remove forced `-O2` and then unneeded `fast` flag.+  Also remove most of `INLINE` pragmas.+  In the effect, `aeson` compiles almost twice as fast.++  To get `fast` compilation effect cabal-install users may specify `optimization: False`.++* Make map type used by Object abstract so the underlying implementation can+  be modified, thanks to Callan McGill++* Drop GHC-7 support++* Remove Data.Aeson.Encode module++* `Double` and `Float` infinities are encoded as `"+inf"` and `"-inf"`.+  Change `To/FromJSONKey` instances to use `"+inf"` and `"-inf"` too.++* `FromJSON ()` and `FromJSON (Proxy tag)` accept any JSON value.  ### 1.5.6.0 * Make `Show Value` instance print object keys in lexicographic order.

@@ -1,7 +0,0 @@-#if __GLASGOW_HASKELL__ >= 710-#define INCOHERENT_ {-# INCOHERENT #-}-#else--- This causes some type class instances to break:--- {-# LANGUAGE IncoherentInstances #-}-#define INCOHERENT_-#endif

@@ -1,8 +0,0 @@-#if __GLASGOW_HASKELL__ >= 710-#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}-#define OVERLAPPING_  {-# OVERLAPPING #-}-#else-{-# LANGUAGE OverlappingInstances #-}-#define OVERLAPPABLE_-#define OVERLAPPING_-#endif

@@ -55,6 +55,7 @@     , fromEncoding     , Array     , Object+    , Key     -- * Convenience types     , DotNetTime(..)     -- * Type conversion

@@ -1,31 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--- |--- Module:      Data.Aeson.Encode--- Copyright:   (c) 2012-2016 Bryan O'Sullivan---              (c) 2011 MailRank, Inc.--- License:     BSD3--- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>--- Stability:   experimental--- Portability: portable------ This module is left to supply limited backwards-compatibility.--module Data.Aeson.Encode {-# DEPRECATED "Use Data.Aeson or Data.Aeson.Text instead" #-}-    (-      encode-    , encodeToTextBuilder-    ) where---import Data.ByteString.Lazy (ByteString)-import Data.Text.Lazy.Builder (Builder)-import qualified Data.Aeson as A-import qualified Data.Aeson.Text as A--encode :: A.ToJSON a => a -> ByteString-encode = A.encode-{-# DEPRECATED encode "Use encode from Data.Aeson" #-}--encodeToTextBuilder :: A.Value -> Builder-encodeToTextBuilder = A.encodeToTextBuilder-{-# DEPRECATED encodeToTextBuilder "Use encodeTotextBuilder from Data.Aeson.Text" #-}

@@ -41,7 +41,9 @@ import Prelude.Compat  import Data.Aeson.Internal.Time-import Data.Aeson.Types.Internal (Value (..))+import Data.Aeson.Types.Internal (Value (..), Key)+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KM import Data.ByteString.Builder as B import Data.ByteString.Builder.Prim as BP import Data.ByteString.Builder.Scientific (scientificBuilder)@@ -54,7 +56,6 @@ import Data.Time.Calendar.Quarter.Compat (Quarter, toYearQuarter, QuarterOfYear (..)) import Data.Time.LocalTime import Data.Word (Word8)-import qualified Data.HashMap.Strict as HMS import qualified Data.Text as T import qualified Data.Vector as V @@ -90,13 +91,17 @@     withComma a z = B.char8 ',' <> encodeToBuilder a <> z  -- Encode a JSON object.-object :: HMS.HashMap T.Text Value -> Builder-object m = case HMS.toList m of+object :: KM.KeyMap Value -> Builder+object m = case KM.toList m of     (x:xs) -> B.char8 '{' <> one x <> foldr withComma (B.char8 '}') xs     _      -> emptyObject_   where     withComma a z = B.char8 ',' <> one a <> z-    one (k,v)     = text k <> B.char8 ':' <> encodeToBuilder v+    one (k,v)     = key k <> B.char8 ':' <> encodeToBuilder v++-- | Encode a JSON key.+key :: Key -> Builder+key = text . Key.toText  -- | Encode a JSON string. text :: T.Text -> Builder

@@ -26,6 +26,7 @@     , wrapArray     , null_     , bool+    , key     , text     , lazyText     , string@@ -61,8 +62,9 @@  import Prelude.Compat -import Data.Aeson.Types.Internal (Value)+import Data.Aeson.Types.Internal (Value, Key) import Data.ByteString.Builder (Builder, char7, toLazyByteString)+import qualified Data.Aeson.Key as Key import Data.Int import Data.Scientific (Scientific) import Data.Text (Text)@@ -127,15 +129,15 @@             | Value (Encoding' Series)             deriving (Typeable) -pair :: Text -> Encoding -> Series-pair name val = pair' (text name) val+pair :: Key -> Encoding -> Series+pair name val = pair' (key name) val {-# INLINE pair #-}  pairStr :: String -> Encoding -> Series pairStr name val = pair' (string name) val {-# INLINE pairStr #-} -pair' :: Encoding' Text -> Encoding -> Series+pair' :: Encoding' Key -> Encoding -> Series pair' name val = Value $ retagEncoding $ retagEncoding name >< colon >< val  instance Semigroup Series where@@ -184,7 +186,7 @@  -- | Encode as JSON object dict-    :: (k -> Encoding' Text)                     -- ^ key encoding+    :: (k -> Encoding' Key)                           -- ^ key encoding     -> (v -> Encoding)                                -- ^ value encoding     -> (forall a. (k -> v -> a -> a) -> a -> m -> a)  -- ^ @foldrWithKey@ - indexed fold     -> m                                              -- ^ container@@ -226,6 +228,9 @@ tuple b = retagEncoding $ openBracket >< b >< closeBracket {-# INLINE tuple #-} +key :: Key -> Encoding' a+key = text . Key.toText+ text :: Text -> Encoding' a text = Encoding . EB.text @@ -289,6 +294,20 @@ float :: Float -> Encoding float = realFloatToEncoding $ Encoding . B.floatDec +-- |+--+-- >>> double 42+-- "42.0"+--+-- >>> double (0/0)+-- "null"+--+-- >>> double (1/0)+-- "\"+inf\""+--+-- >>> double (-23/0)+-- "\"-inf\""+-- double :: Double -> Encoding double = realFloatToEncoding $ Encoding . B.doubleDec @@ -297,8 +316,9 @@  realFloatToEncoding :: RealFloat a => (a -> Encoding) -> a -> Encoding realFloatToEncoding e d-    | isNaN d || isInfinite d = null_-    | otherwise               = e d+    | isNaN d      = null_+    | isInfinite d = if d > 0 then Encoding "\"+inf\"" else Encoding "\"-inf\""+    | otherwise    = e d {-# INLINE realFloatToEncoding #-}  -------------------------------------------------------------------------------@@ -339,10 +359,28 @@ integerText = Encoding . EB.quote . B.integerDec  floatText :: Float -> Encoding' a-floatText = Encoding . EB.quote . B.floatDec+floatText d+    | isInfinite d = if d > 0 then Encoding "\"+inf\"" else Encoding "\"-inf\""+    | otherwise = Encoding . EB.quote . B.floatDec $ d +-- |+--+-- >>> doubleText 42+-- "\"42.0\""+--+-- >>> doubleText (0/0)+-- "\"NaN\""+--+-- >>> doubleText (1/0)+-- "\"+inf\""+--+-- >>> doubleText (-23/0)+-- "\"-inf\""+-- doubleText :: Double -> Encoding' a-doubleText = Encoding . EB.quote . B.doubleDec+doubleText d+    | isInfinite d = if d > 0 then Encoding "\"+inf\"" else Encoding "\"-inf\""+    | otherwise = Encoding . EB.quote . B.doubleDec $ d  scientificText :: Scientific -> Encoding' a scientificText = Encoding . EB.quote . EB.scientific

@@ -9,10 +9,10 @@ -- Portability: portable  module Data.Aeson.Internal.Functions-    (-      mapHashKeyVal-    , mapKeyVal+    ( mapKeyVal     , mapKey+    , mapKeyValO+    , mapKeyO     ) where  import Prelude.Compat@@ -21,19 +21,25 @@ import qualified Data.HashMap.Strict as H import qualified Data.Map as M --- | Transform a 'M.Map' into a 'H.HashMap' while transforming the keys.-mapHashKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)-              -> M.Map k1 v1 -> H.HashMap k2 v2-mapHashKeyVal fk kv = M.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty-{-# INLINE mapHashKeyVal #-}- -- | Transform the keys and values of a 'H.HashMap'. mapKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)           -> H.HashMap k1 v1 -> H.HashMap k2 v2 mapKeyVal fk kv = H.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty {-# INLINE mapKeyVal #-} +-- | Transform the keys and values of a 'M.Map'.+mapKeyValO :: (Ord k2) => (k1 -> k2) -> (v1 -> v2)+          -> M.Map k1 v1 -> M.Map k2 v2+mapKeyValO fk kv = M.foldrWithKey (\k v -> M.insert (fk k) (kv v)) M.empty+{-# INLINE mapKeyValO #-}+ -- | Transform the keys of a 'H.HashMap'. mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> H.HashMap k1 v -> H.HashMap k2 v mapKey fk = mapKeyVal fk id {-# INLINE mapKey #-}++-- | Transform the keys of a 'M.Map'.+mapKeyO :: (Ord k2) => (k1 -> k2) -> M.Map k1 v -> M.Map k2 v+mapKeyO fk = mapKeyValO fk id+{-# INLINE mapKeyO #-}+

@@ -0,0 +1,94 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TemplateHaskellQuotes #-}++module Data.Aeson.Key (+    Key,+    fromString,+    toString,+    toText,+    fromText,+    coercionToText,+) where++import Prelude (Eq, Ord, (.), Show (..), String, Maybe (..))++import Control.Applicative ((<$>))+import Control.DeepSeq (NFData(..))+import Data.Data (Data)+import Data.Hashable (Hashable(..))+import Data.Monoid (Monoid(mempty, mappend))+import Data.Semigroup (Semigroup((<>)))+import Data.Text (Text)+import Data.Type.Coercion (Coercion (..))+import Data.Typeable (Typeable)+import Text.Read (Read (..))++import qualified Data.String+import qualified Data.Text as T+import qualified Language.Haskell.TH.Syntax as TH++newtype Key = Key { unKey :: Text }+  deriving (Eq, Ord, Typeable, Data)++fromString :: String -> Key+fromString = Key . T.pack++toString :: Key -> String+toString (Key k) = T.unpack k++fromText :: Text -> Key+fromText = Key++toText :: Key -> Text+toText = unKey++-- | @'coercing r1 r2'@ will evaluate to @r1@ if 'Key' is 'Coercible' to  'Text',+-- and to @r2@ otherwise.+--+-- Using 'coercing' we can make more efficient implementations+-- when 'Key' is backed up by 'Text' without exposing internals.+-- +coercionToText :: Maybe (Coercion Key Text)+coercionToText = Just Coercion+{-# INLINE coercionToText #-}++-------------------------------------------------------------------------------+-- instances+-------------------------------------------------------------------------------++instance Read Key where+    readPrec = fromString <$> readPrec++instance Show Key where+    showsPrec d (Key k) = showsPrec d k ++instance Data.String.IsString Key where+    fromString = fromString++instance Hashable Key where+    hashWithSalt salt (Key k) = hashWithSalt salt k++instance NFData Key where+    rnf (Key k) = rnf k++instance Semigroup Key where+    Key x <> Key y = Key (x <> y)++instance Monoid Key where+    mempty = Key mempty+    mappend = (<>)++instance TH.Lift Key where+#if MIN_VERSION_text(1,2,4)+    lift (Key k) = [| Key k |]+#else+    lift k = [| fromString k' |] where k' = toString k+#endif++#if MIN_VERSION_template_haskell(2,17,0)+    liftTyped = TH.unsafeCodeCoerce . TH.lift+#elif MIN_VERSION_template_haskell(2,16,0)+    liftTyped = TH.unsafeTExpCoerce . TH.lift+#endif

@@ -0,0 +1,659 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TemplateHaskellQuotes #-}++-- |+-- An abstract interface for maps from JSON keys to values.++module Data.Aeson.KeyMap (+    -- * Map Type+    KeyMap,++    -- * Query+    null,+    lookup,+    size,+    member,++    -- * Construction+    empty,+    singleton,++    -- ** Insertion+    insert,++    -- * Deletion+    delete,++    -- * Update+    alterF,++    -- * Combine+    difference,+    union,+    unionWith,+    unionWithKey,+    intersection,+    intersectionWith,+    intersectionWithKey,+    alignWith,+    alignWithKey,++    -- * Lists+    fromList,+    fromListWith,+    toList,+    toAscList,++    -- * Maps+    fromHashMap,+    toHashMap,+    coercionToHashMap,+    fromMap,+    toMap,+    coercionToMap,+    fromHashMapText,+    toHashMapText,++    -- * Traversal+    -- ** Map+    map,+    mapKeyVal,+    traverse,+    traverseWithKey,++    -- * Folds+    foldr,+    foldr',+    foldl,+    foldl',+    foldMapWithKey,+    foldrWithKey,++    -- * Conversions+    keys,++    -- * Filter+    filter,+    filterWithKey,+    mapMaybe,+    mapMaybeWithKey,+) where++-- Import stuff from Prelude explicitly+import Prelude (Eq(..), Ord((>)), Int, Bool(..), Maybe(..))+import Prelude ((.), ($))+import Prelude (Functor(fmap), Monad(..))+import Prelude (Show, showsPrec, showParen, shows, showString)++import Control.Applicative (Applicative)+import Control.DeepSeq (NFData(..))+import Data.Aeson.Key (Key)+import Data.Bifunctor (first)+import Data.Data (Data)+import Data.Hashable (Hashable(..))+import Data.HashMap.Strict (HashMap)+import Data.Map (Map)+import Data.Monoid (Monoid(mempty, mappend))+import Data.Semigroup (Semigroup((<>)))+import Data.Text (Text)+import Data.These (These (..))+import Data.Type.Coercion (Coercion (..))+import Data.Typeable (Typeable)+import Text.Read (Read (..), Lexeme(..), readListPrecDefault, prec, lexP, parens)++import qualified Data.Aeson.Key as Key+import qualified Data.Foldable as F+import qualified Data.Traversable as T+import qualified Data.HashMap.Strict as H+import qualified Data.List as L+import qualified Data.Map.Strict as M+import qualified Language.Haskell.TH.Syntax as TH+import qualified Data.Foldable.WithIndex    as WI (FoldableWithIndex (..))+import qualified Data.Functor.WithIndex     as WI (FunctorWithIndex (..))+import qualified Data.Traversable.WithIndex as WI (TraversableWithIndex (..))+import qualified Data.Semialign as SA+import qualified Data.Semialign.Indexed as SAI+import qualified Witherable as W++#ifdef USE_ORDEREDMAP++-------------------------------------------------------------------------------+-- Map+-------------------------------------------------------------------------------++-- | A map from JSON key type 'Key' to 'v'.+newtype KeyMap v = KeyMap { unKeyMap :: Map Key v }+  deriving (Eq, Ord, Typeable, Data, Functor)+++-- | Construct an empty map.+empty :: KeyMap v+empty = KeyMap M.empty++-- | Is the map empty?+null :: KeyMap v -> Bool+null = M.null . unKeyMap++-- | Return the number of key-value mappings in this map.+size :: KeyMap v -> Int+size = M.size . unKeyMap++-- | Construct a map with a single element.+singleton :: Key -> v -> KeyMap v+singleton k v = KeyMap (M.singleton k v)++-- | Is the key a member of the map?+member :: Key -> KeyMap a -> Bool+member t (KeyMap m) = M.member t m++-- | Remove the mapping for the specified key from this map if present.+delete :: Key -> KeyMap v -> KeyMap v+delete k (KeyMap m) = KeyMap (M.delete k m)++-- | 'alterF' can be used to insert, delete, or update a value in a map.+alterF :: Functor f => (Maybe v -> f (Maybe v)) -> Key -> KeyMap v -> f (KeyMap v)+#if MIN_VERSION_containers(0,5,8)+alterF f k = fmap KeyMap . M.alterF f k . unKeyMap+#else+alterF f k m = fmap g (f mv) where+    g r =  case r of+        Nothing -> case mv of+            Nothing -> m+            Just _  -> delete k m+        Just v' -> insert k v' m++    mv = lookup k m+#endif++-- | Return the value to which the specified key is mapped,+-- or Nothing if this map contains no mapping for the key.+lookup :: Key -> KeyMap v -> Maybe v+lookup t tm = M.lookup t (unKeyMap tm)++-- | Associate the specified value with the specified key+-- in this map. If this map previously contained a mapping+-- for the key, the old value is replaced.+insert :: Key -> v -> KeyMap v -> KeyMap v+insert k v tm = KeyMap (M.insert k v (unKeyMap tm))++-- | Map a function over all values in the map.+map :: (a -> b) -> KeyMap a -> KeyMap b+map = fmap++-- | Map a function over all values in the map.+mapWithKey :: (Key -> a -> b) -> KeyMap a -> KeyMap b+mapWithKey f (KeyMap m) = KeyMap (M.mapWithKey f m)++foldMapWithKey :: Monoid m => (Key -> a -> m) -> KeyMap a -> m+foldMapWithKey f (KeyMap m) = M.foldMapWithKey f m++foldr :: (a -> b -> b) -> b -> KeyMap a -> b+foldr f z (KeyMap m) = M.foldr f z m++foldr' :: (a -> b -> b) -> b -> KeyMap a -> b+foldr' f z (KeyMap m) = M.foldr' f z m++foldl :: (b -> a -> b) -> b -> KeyMap a -> b+foldl f z (KeyMap m) = M.foldl f z m++foldl' :: (b -> a -> b) -> b -> KeyMap a -> b+foldl' f z (KeyMap m) = M.foldl' f z m++-- | Reduce this map by applying a binary operator to all+-- elements, using the given starting value (typically the+-- right-identity of the operator).+foldrWithKey :: (Key -> v -> a -> a) -> a -> KeyMap v -> a+foldrWithKey f a = M.foldrWithKey f a . unKeyMap++-- | Perform an Applicative action for each key-value pair+-- in a 'KeyMap' and produce a 'KeyMap' of all the results.+traverse :: Applicative f => (v1 -> f v2) -> KeyMap v1 -> f (KeyMap v2)+traverse f = fmap KeyMap . T.traverse f . unKeyMap++-- | Perform an Applicative action for each key-value pair+-- in a 'KeyMap' and produce a 'KeyMap' of all the results.+traverseWithKey :: Applicative f => (Key -> v1 -> f v2) -> KeyMap v1 -> f (KeyMap v2)+traverseWithKey f = fmap KeyMap . M.traverseWithKey f  . unKeyMap++-- | Construct a map from a list of elements. Uses the+-- provided function, f, to merge duplicate entries with+-- (f newVal oldVal).+fromListWith :: (v -> v -> v) ->  [(Key, v)] -> KeyMap v+fromListWith op = KeyMap . M.fromListWith op++-- |  Construct a map with the supplied mappings. If the+-- list contains duplicate mappings, the later mappings take+-- precedence.+fromList :: [(Key, v)] -> KeyMap v+fromList = KeyMap . M.fromList++-- | Return a list of this map's elements.+--+-- The order is not stable. Use 'toAscList' for stable ordering.+toList :: KeyMap v -> [(Key, v)]+toList = M.toList . unKeyMap++-- | Return a list of this map's elements in ascending order+-- based of the textual key.+toAscList :: KeyMap v -> [(Key, v)]+toAscList = M.toAscList . unKeyMap++-- | Difference of two maps. Return elements of the first+-- map not existing in the second.+difference :: KeyMap v -> KeyMap v' -> KeyMap v+difference tm1 tm2 = KeyMap (M.difference (unKeyMap tm1) (unKeyMap tm2))++-- The (left-biased) union of two maps. It prefers the first map when duplicate+-- keys are encountered, i.e. ('union' == 'unionWith' 'const').+union :: KeyMap v -> KeyMap v -> KeyMap v+union (KeyMap x) (KeyMap y) = KeyMap (M.union x y)++-- | The union with a combining function.+unionWith :: (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v+unionWith f (KeyMap x) (KeyMap y) = KeyMap (M.unionWith f x y)++-- | The union with a combining function.+unionWithKey :: (Key -> v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v+unionWithKey f (KeyMap x) (KeyMap y) = KeyMap (M.unionWithKey f x y)++-- | The (left-biased) intersection of two maps (based on keys).+intersection :: KeyMap a -> KeyMap b -> KeyMap a+intersection (KeyMap x) (KeyMap y) = KeyMap (M.intersection x y)++-- | The intersection with a combining function.+intersectionWith :: (a -> b -> c) -> KeyMap a -> KeyMap b -> KeyMap c+intersectionWith f (KeyMap x) (KeyMap y) = KeyMap (M.intersectionWith f x y)++-- | The intersection with a combining function.+intersectionWithKey :: (Key -> a -> b -> c) -> KeyMap a -> KeyMap b -> KeyMap c+intersectionWithKey f (KeyMap x) (KeyMap y) = KeyMap (M.intersectionWithKey f x y)++-- | Return a list of this map's keys.+keys :: KeyMap v -> [Key]+keys = M.keys . unKeyMap++-- | Convert a 'KeyMap' to a 'HashMap'.+toHashMap :: KeyMap v -> HashMap Key v+toHashMap = H.fromList . toList++-- | Convert a 'HashMap' to a 'KeyMap'.+fromHashMap :: HashMap Key v -> KeyMap v+fromHashMap = fromList . H.toList++-- | Convert a 'KeyMap' to a 'Map'.+toMap :: KeyMap v -> Map Key v+toMap = unKeyMap++-- | Convert a 'HashMap' to a 'Map'.+fromMap :: Map Key v -> KeyMap v+fromMap = KeyMap++coercionToHashMap :: Maybe (Coercion (HashMap Key v) (KeyMap v))+coercionToHashMap = Nothing+{-# INLINE coercionToHashMap #-}++coercionToMap :: Maybe (Coercion (Map Key v) (KeyMap v))+coercionToMap = Just Coercion+{-# INLINE coercionToMap #-}++-- | Transform the keys and values of a 'KeyMap'.+mapKeyVal :: (Key -> Key) -> (v1 -> v2)+          -> KeyMap v1 -> KeyMap v2+mapKeyVal fk kv = foldrWithKey (\k v -> insert (fk k) (kv v)) empty+{-# INLINE mapKeyVal #-}++-- | Filter all keys/values that satisfy some predicate.+filter :: (v -> Bool) -> KeyMap v -> KeyMap v+filter f (KeyMap m) = KeyMap (M.filter f m)++-- | Filter all keys/values that satisfy some predicate.+filterWithKey :: (Key -> v -> Bool) -> KeyMap v -> KeyMap v+filterWithKey f (KeyMap m) = KeyMap (M.filterWithKey f m)++-- | Map values and collect the Just results.+mapMaybe :: (a -> Maybe b) -> KeyMap a -> KeyMap b+mapMaybe f (KeyMap m) = KeyMap (M.mapMaybe f m)++-- | Map values and collect the Just results.+mapMaybeWithKey :: (Key -> v -> Maybe u) -> KeyMap v -> KeyMap u+mapMaybeWithKey f (KeyMap m) = KeyMap (M.mapMaybeWithKey f m)++#else++-------------------------------------------------------------------------------+-- HashMap+-------------------------------------------------------------------------------++import Data.List (sortBy)+import Data.Ord (comparing)+import Prelude (fst)++-- | A map from JSON key type 'Key' to 'v'.+newtype KeyMap v = KeyMap { unKeyMap :: HashMap Key v }+  deriving (Eq, Ord, Typeable, Data, Functor)++-- | Construct an empty map.+empty :: KeyMap v+empty = KeyMap H.empty++-- | Is the map empty?+null :: KeyMap v -> Bool+null = H.null . unKeyMap++-- | Return the number of key-value mappings in this map.+size :: KeyMap v -> Int+size = H.size . unKeyMap++-- | Construct a map with a single element.+singleton :: Key -> v -> KeyMap v+singleton k v = KeyMap (H.singleton k v)++-- | Is the key a member of the map?+member :: Key -> KeyMap a -> Bool+member t (KeyMap m) = H.member t m++-- | Remove the mapping for the specified key from this map if present.+delete :: Key -> KeyMap v -> KeyMap v+delete k (KeyMap m) = KeyMap (H.delete k m)++-- | 'alterF' can be used to insert, delete, or update a value in a map.+alterF :: Functor f => (Maybe v -> f (Maybe v)) -> Key -> KeyMap v -> f (KeyMap v)+alterF f k = fmap KeyMap . H.alterF f k . unKeyMap++-- | Return the value to which the specified key is mapped,+-- or Nothing if this map contains no mapping for the key.+lookup :: Key -> KeyMap v -> Maybe v+lookup t tm = H.lookup t (unKeyMap tm)++-- | Associate the specified value with the specified key+-- in this map. If this map previously contained a mapping+-- for the key, the old value is replaced.+insert :: Key -> v -> KeyMap v -> KeyMap v+insert k v tm = KeyMap (H.insert k v (unKeyMap tm))++-- | Map a function over all values in the map.+map :: (a -> b) -> KeyMap a -> KeyMap b+map = fmap++-- | Map a function over all values in the map.+mapWithKey :: (Key -> a -> b) -> KeyMap a -> KeyMap b+mapWithKey f (KeyMap m) = KeyMap (H.mapWithKey f m)++foldMapWithKey :: Monoid m => (Key -> a -> m) -> KeyMap a -> m+foldMapWithKey f (KeyMap m) = H.foldMapWithKey f m++foldr :: (a -> b -> b) -> b -> KeyMap a -> b+foldr f z (KeyMap m) = H.foldr f z m++foldr' :: (a -> b -> b) -> b -> KeyMap a -> b+foldr' f z (KeyMap m) = H.foldr' f z m++foldl :: (b -> a -> b) -> b -> KeyMap a -> b+foldl f z (KeyMap m) = H.foldl f z m++foldl' :: (b -> a -> b) -> b -> KeyMap a -> b+foldl' f z (KeyMap m) = H.foldl' f z m++-- | Reduce this map by applying a binary operator to all+-- elements, using the given starting value (typically the+-- right-identity of the operator).+foldrWithKey :: (Key -> v -> a -> a) -> a -> KeyMap v -> a+foldrWithKey f a = H.foldrWithKey f a . unKeyMap++-- | Perform an Applicative action for each key-value pair+-- in a 'KeyMap' and produce a 'KeyMap' of all the results.+traverse :: Applicative f => (v1 -> f v2) -> KeyMap v1 -> f (KeyMap v2)+traverse f = fmap KeyMap . T.traverse f . unKeyMap++-- | Perform an Applicative action for each key-value pair+-- in a 'KeyMap' and produce a 'KeyMap' of all the results.+traverseWithKey :: Applicative f => (Key -> v1 -> f v2) -> KeyMap v1 -> f (KeyMap v2)+traverseWithKey f = fmap KeyMap . H.traverseWithKey f  . unKeyMap++-- | Construct a map from a list of elements. Uses the+-- provided function, f, to merge duplicate entries with+-- (f newVal oldVal).+fromListWith :: (v -> v -> v) ->  [(Key, v)] -> KeyMap v+fromListWith op = KeyMap . H.fromListWith op++-- |  Construct a map with the supplied mappings. If the+-- list contains duplicate mappings, the later mappings take+-- precedence.+fromList :: [(Key, v)] -> KeyMap v+fromList = KeyMap . H.fromList++-- | Return a list of this map's elements.+--+-- The order is not stable. Use 'toAscList' for stable ordering.+toList :: KeyMap v -> [(Key, v)]+toList = H.toList . unKeyMap++-- | Return a list of this map's elements in ascending order+-- based of the textual key.+toAscList :: KeyMap v -> [(Key, v)]+toAscList = sortBy (comparing fst) . toList++-- | Difference of two maps. Return elements of the first+-- map not existing in the second.+difference :: KeyMap v -> KeyMap v' -> KeyMap v+difference tm1 tm2 = KeyMap (H.difference (unKeyMap tm1) (unKeyMap tm2))++-- The (left-biased) union of two maps. It prefers the first map when duplicate+-- keys are encountered, i.e. ('union' == 'unionWith' 'const').+union :: KeyMap v -> KeyMap v -> KeyMap v+union (KeyMap x) (KeyMap y) = KeyMap (H.union x y)++-- | The union with a combining function.+unionWith :: (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v+unionWith f (KeyMap x) (KeyMap y) = KeyMap (H.unionWith f x y)++-- | The union with a combining function.+unionWithKey :: (Key -> v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v+unionWithKey f (KeyMap x) (KeyMap y) = KeyMap (H.unionWithKey f x y)++-- | The (left-biased) intersection of two maps (based on keys).+intersection :: KeyMap a -> KeyMap b -> KeyMap a+intersection (KeyMap x) (KeyMap y) = KeyMap (H.intersection x y)++-- | The intersection with a combining function.+intersectionWith :: (a -> b -> c) -> KeyMap a -> KeyMap b -> KeyMap c+intersectionWith f (KeyMap x) (KeyMap y) = KeyMap (H.intersectionWith f x y)++-- | The intersection with a combining function.+intersectionWithKey :: (Key -> a -> b -> c) -> KeyMap a -> KeyMap b -> KeyMap c+intersectionWithKey f (KeyMap x) (KeyMap y) = KeyMap (H.intersectionWithKey f x y)++-- | Return a list of this map's keys.+keys :: KeyMap v -> [Key]+keys = H.keys . unKeyMap++-- | Convert a 'KeyMap' to a 'HashMap'.+toHashMap :: KeyMap v -> HashMap Key v+toHashMap = unKeyMap++-- | Convert a 'HashMap' to a 'KeyMap'.+fromHashMap :: HashMap Key v -> KeyMap v+fromHashMap = KeyMap++-- | Convert a 'KeyMap' to a 'Map'.+toMap :: KeyMap v -> Map Key v+toMap = M.fromList . toList ++-- | Convert a 'HashMap' to a 'Map'.+fromMap :: Map Key v -> KeyMap v+fromMap = fromList . M.toList++coercionToHashMap :: Maybe (Coercion (HashMap Key v) (KeyMap v))+coercionToHashMap = Just Coercion+{-# INLINE coercionToHashMap #-}++coercionToMap :: Maybe (Coercion (Map Key v) (KeyMap v))+coercionToMap = Nothing+{-# INLINE coercionToMap #-}++-- | Transform the keys and values of a 'KeyMap'.+mapKeyVal :: (Key -> Key) -> (v1 -> v2)+          -> KeyMap v1 -> KeyMap v2+mapKeyVal fk kv = foldrWithKey (\k v -> insert (fk k) (kv v)) empty+{-# INLINE mapKeyVal #-}++-- | Filter all keys/values that satisfy some predicate.+filter :: (v -> Bool) -> KeyMap v -> KeyMap v+filter f (KeyMap m) = KeyMap (H.filter f m)++-- | Filter all keys/values that satisfy some predicate.+filterWithKey :: (Key -> v -> Bool) -> KeyMap v -> KeyMap v+filterWithKey f (KeyMap m) = KeyMap (H.filterWithKey f m)++-- | Map values and collect the Just results.+mapMaybe :: (a -> Maybe b) -> KeyMap a -> KeyMap b+mapMaybe f (KeyMap m) = KeyMap (H.mapMaybe f m)++-- | Map values and collect the Just results.+mapMaybeWithKey :: (Key -> v -> Maybe u) -> KeyMap v -> KeyMap u+mapMaybeWithKey f (KeyMap m) = KeyMap (H.mapMaybeWithKey f m)++#endif++-------------------------------------------------------------------------------+-- combinators using existing abstractions+-------------------------------------------------------------------------------++-- | Generalized union with combining function.+alignWith :: (These a b -> c) -> KeyMap a -> KeyMap b -> KeyMap c+alignWith f (KeyMap x) (KeyMap y) = KeyMap (SA.alignWith f x y)++-- | Generalized union with combining function.+alignWithKey :: (Key -> These a b -> c) -> KeyMap a -> KeyMap b -> KeyMap c+alignWithKey f (KeyMap x) (KeyMap y) = KeyMap (SAI.ialignWith f x y)++-- | Convert a 'KeyMap' to a @'HashMap' 'Text'@.+toHashMapText :: KeyMap v -> HashMap Text  v+toHashMapText = H.fromList . L.map (first Key.toText) . toList++-- | Convert a @'HashMap' 'Text'@to a 'KeyMap'.+fromHashMapText :: HashMap Text v -> KeyMap v+fromHashMapText = fromList . L.map (first Key.fromText) . H.toList++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++-- This are defined using concrete combinators above.++instance Read v => Read (KeyMap v) where+    readPrec = parens $ prec 10 $ do+      Ident "fromList" <- lexP+      xs <- readPrec+      return (fromList xs)++    readListPrec = readListPrecDefault++instance Show v => Show (KeyMap v) where+    showsPrec d m = showParen (d > 10) $+      showString "fromList " . shows (toAscList m)++instance F.Foldable KeyMap where+    foldMap f = foldMapWithKey (\ _k v -> f v)+    {-# INLINE foldMap #-}+    foldr = foldr+    foldr' = foldr'+    foldl = foldl+    foldl' = foldl'+    null = null+    length = size++instance T.Traversable KeyMap where+    traverse = traverse++instance Semigroup (KeyMap v) where+    (<>) = union++instance Monoid (KeyMap v) where+    mempty = empty+    mappend = (<>)++-------------------------------------------------------------------------------+-- template-haskell+-------------------------------------------------------------------------------++instance TH.Lift v => TH.Lift (KeyMap v) where+    lift m = [| fromList m' |] where m' = toList m++#if MIN_VERSION_template_haskell(2,17,0)+    liftTyped = TH.unsafeCodeCoerce . TH.lift+#elif MIN_VERSION_template_haskell(2,16,0)+    liftTyped = TH.unsafeTExpCoerce . TH.lift+#endif++-------------------------------------------------------------------------------+-- hashable+-------------------------------------------------------------------------------++instance Hashable v => Hashable (KeyMap v) where+#ifdef USE_ORDEREDMAP+    hashWithSalt salt (KeyMap m) = M.foldlWithKey'+        (\acc k v -> acc `hashWithSalt` k `hashWithSalt` v)+        (hashWithSalt salt (M.size m)) m+#else+    hashWithSalt salt (KeyMap hm) = hashWithSalt salt hm+#endif++-------------------------------------------------------------------------------+-- deepseq+-------------------------------------------------------------------------------++instance NFData v => NFData (KeyMap v) where+    rnf (KeyMap hm) = rnf hm++-------------------------------------------------------------------------------+-- indexed-traversable+-------------------------------------------------------------------------------++instance WI.FunctorWithIndex Key KeyMap where+    imap = mapWithKey++instance WI.FoldableWithIndex Key KeyMap where+    ifoldr   = foldrWithKey++instance WI.TraversableWithIndex Key KeyMap where+    itraverse = traverseWithKey++-------------------------------------------------------------------------------+-- semialign+-------------------------------------------------------------------------------++instance SA.Zip KeyMap where+    zipWith = intersectionWith++instance SAI.ZipWithIndex Key KeyMap where+    izipWith = intersectionWithKey++instance SA.Semialign KeyMap where+    alignWith = alignWith++instance SAI.SemialignWithIndex Key KeyMap where+    ialignWith = alignWithKey++instance SA.Align KeyMap where+    nil = empty++-------------------------------------------------------------------------------+-- witherable+-------------------------------------------------------------------------------++instance W.Filterable KeyMap where+    filter = filter+    mapMaybe = mapMaybe++instance W.Witherable KeyMap where++instance W.FilterableWithIndex Key KeyMap where+    ifilter = filterWithKey+    imapMaybe = mapMaybeWithKey++instance W.WitherableWithIndex Key KeyMap where

@@ -2,7 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}-#if __GLASGOW_HASKELL__ <= 710 && __GLASGOW_HASKELL__ >= 706+#if __GLASGOW_HASKELL__ <= 800 && __GLASGOW_HASKELL__ >= 706 -- Work around a compiler bug {-# OPTIONS_GHC -fsimpl-tick-factor=300 #-} #endif@@ -51,7 +51,9 @@  import Control.Applicative ((<|>)) import Control.Monad (void, when)-import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Value(..))+import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Value(..), Key)+import qualified Data.Aeson.KeyMap as KM+import qualified Data.Aeson.Key as Key import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string) import Data.Function (fix) import Data.Functor.Compat (($>))@@ -68,7 +70,6 @@ import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as C import qualified Data.ByteString.Builder as B-import qualified Data.HashMap.Strict as H import qualified Data.Scientific as Sci import Data.Aeson.Parser.Unescape (unescapeText) @@ -131,31 +132,33 @@ -- toplevel Value parser to be called recursively, to keep the parameter -- mkObject outside of the recursive loop for proper inlining. -object_ :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value-object_ mkObject val = {-# SCC "object_" #-} Object <$> objectValues mkObject jstring val+object_ :: ([(Key, Value)] -> Either String Object) -> Parser Value -> Parser Value+object_ mkObject val = {-# SCC "object_" #-} Object <$> objectValues mkObject key val {-# INLINE object_ #-} -object_' :: ([(Text, Value)] -> Either String Object) -> Parser Value -> Parser Value+object_' :: ([(Key, Value)] -> Either String Object) -> Parser Value -> Parser Value object_' mkObject val' = {-# SCC "object_'" #-} do-  !vals <- objectValues mkObject jstring' val'+  !vals <- objectValues mkObject key' val'   return (Object vals)  where-  jstring' = do-    !s <- jstring+  key' = do+    !s <- key     return s {-# INLINE object_' #-} -objectValues :: ([(Text, Value)] -> Either String Object)-             -> Parser Text -> Parser Value -> Parser (H.HashMap Text Value)+objectValues :: ([(Key, Value)] -> Either String Object)+             -> Parser Key -> Parser Value -> Parser (KM.KeyMap Value) objectValues mkObject str val = do   skipSpace   w <- A.peekWord8'   if w == CLOSE_CURLY-    then A.anyWord8 >> return H.empty+    then A.anyWord8 >> return KM.empty     else loop []  where-  -- Why use acc pattern here, you may ask? because 'H.fromList' use 'unsafeInsert'-  -- and it's much faster because it's doing in place update to the 'HashMap'!+  -- Why use acc pattern here, you may ask? because then the underlying 'KM.fromList'+  -- implementation can make use of mutation when constructing a map. For example,+  -- 'HashMap` uses 'unsafeInsert' and it's much faster because it's doing in place+  -- update to the 'HashMap'!   loop acc = do     k <- (str A.<?> "object key") <* skipSpace <* (char ':' A.<?> "':'")     v <- (val A.<?> "object value") <* skipSpace@@ -196,7 +199,7 @@  -- | Parse any JSON value. Synonym of 'json'. value :: Parser Value-value = jsonWith (pure . H.fromList)+value = jsonWith (pure . KM.fromList)  -- | Parse any JSON value. --@@ -206,7 +209,7 @@ -- -- ==== __Examples__ ----- 'json' keeps only the first occurence of each key, using 'HashMap.Lazy.fromList'.+-- 'json' keeps only the first occurence of each key, using 'Data.Aeson.KeyMap.fromList'. -- -- @ -- 'json' = 'jsonWith' ('Right' '.' 'H.fromList')@@ -231,7 +234,7 @@ -- @ -- 'jsonNoDup' = 'jsonWith' 'parseListNoDup' -- @-jsonWith :: ([(Text, Value)] -> Either String Object) -> Parser Value+jsonWith :: ([(Key, Value)] -> Either String Object) -> Parser Value jsonWith mkObject = fix $ \value_ -> do   skipSpace   w <- A.peekWord8'@@ -249,7 +252,7 @@  -- | Variant of 'json' which keeps only the last occurence of every key. jsonLast :: Parser Value-jsonLast = jsonWith (Right . H.fromListWith (const id))+jsonLast = jsonWith (Right . KM.fromListWith (const id))  -- | Variant of 'json' wrapping all object mappings in 'Array' to preserve -- key-value pairs with the same keys.@@ -265,24 +268,25 @@ -- -- >>> fromListAccum [("apple", Bool True), ("apple", Bool False), ("orange", Bool False)] -- fromList [("apple",Array [Bool False,Bool True]),("orange",Array [Bool False])]-fromListAccum :: [(Text, Value)] -> Object+fromListAccum :: [(Key, Value)] -> Object fromListAccum =-  fmap (Array . Vector.fromList . ($ [])) . H.fromListWith (.) . (fmap . fmap) (:)+  fmap (Array . Vector.fromList . ($ [])) . KM.fromListWith (.) . (fmap . fmap) (:)  -- | @'fromListNoDup' kvs@ fails if @kvs@ contains duplicate keys.-parseListNoDup :: [(Text, Value)] -> Either String Object+parseListNoDup :: [(Key, Value)] -> Either String Object parseListNoDup =-  H.traverseWithKey unwrap . H.fromListWith (\_ _ -> Nothing) . (fmap . fmap) Just+  KM.traverseWithKey unwrap . KM.fromListWith (\_ _ -> Nothing) . (fmap . fmap) Just   where+     unwrap k Nothing = Left $ "found duplicate key: " ++ show k     unwrap _ (Just v) = Right v  -- | Strict version of 'value'. Synonym of 'json''. value' :: Parser Value-value' = jsonWith' (pure . H.fromList)+value' = jsonWith' (pure . KM.fromList)  -- | Strict version of 'jsonWith'.-jsonWith' :: ([(Text, Value)] -> Either String Object) -> Parser Value+jsonWith' :: ([(Key, Value)] -> Either String Object) -> Parser Value jsonWith' mkObject = fix $ \value_ -> do   skipSpace   w <- A.peekWord8'@@ -304,7 +308,7 @@  -- | Variant of 'json'' which keeps only the last occurence of every key. jsonLast' :: Parser Value-jsonLast' = jsonWith' (pure . H.fromListWith (const id))+jsonLast' = jsonWith' (pure . KM.fromListWith (const id))  -- | Variant of 'json'' wrapping all object mappings in 'Array' to preserve -- key-value pairs with the same keys.@@ -318,6 +322,10 @@ -- | Parse a quoted JSON string. jstring :: Parser Text jstring = A.word8 DOUBLE_QUOTE *> jstring_++-- | Parse a JSON Key+key :: Parser Key+key = Key.fromText <$> jstring  -- | Parse a string without a leading quote. jstring_ :: Parser Text

@@ -10,6 +10,18 @@ import           Prelude                    () import           Prelude.Compat ++-- | Converts a string representation of a JSON value into 'Data.Aeson.Value' at compile-time.+--+-- @+-- {-\# LANGUAGE QuasiQuotes \#-}+--+-- import Data.Aeson (Value)+-- import Data.Aeson.QQ.Simple+--+-- joe :: 'Value'+-- joe = [aesonQQ|{ "name": \"Joe\", "age": 12 }|]+-- @ aesonQQ :: QuasiQuoter aesonQQ = QuasiQuoter     { quoteExp  = aesonExp

@@ -4,18 +4,8 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE UndecidableInstances #-}-#if __GLASGOW_HASKELL__ >= 800--- a) THQ works on cross-compilers and unregisterised GHCs--- b) may make compilation faster as no dynamic loading is ever needed (not sure about this)--- c) removes one hindrance to have code inferred as SafeHaskell safe {-# LANGUAGE TemplateHaskellQuotes #-}-#else-{-# LANGUAGE TemplateHaskell #-}-#endif -#include "incoherent-compat.h"-#include "overlapping-compat.h"- {-| Module:      Data.Aeson.TH Copyright:   (c) 2011-2016 Bryan O'Sullivan@@ -128,6 +118,9 @@ import Data.Aeson.Types.Internal ((<?>), JSONPathElement(Key)) import Data.Aeson.Types.FromJSON (parseOptionalFieldWith) import Data.Aeson.Types.ToJSON (fromPairs, pair)+import Data.Aeson.Key (Key)+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KM import Control.Monad (liftM2, unless, when) import Data.Foldable (foldr') #if MIN_VERSION_template_haskell(2,8,0) && !MIN_VERSION_template_haskell(2,10,0)@@ -147,12 +140,13 @@ import Text.Printf (printf) import qualified Data.Aeson.Encoding.Internal as E import qualified Data.Foldable as F (all)-import qualified Data.HashMap.Strict as H (difference, fromList, keys, lookup, toList) import qualified Data.List.NonEmpty as NE (length, reverse) import qualified Data.Map as M (fromList, keys, lookup , singleton, size)+#if !MIN_VERSION_base(4,16,0) import qualified Data.Semigroup as Semigroup (Option(..))+#endif import qualified Data.Set as Set (empty, insert, member)-import qualified Data.Text as T (Text, pack, unpack)+import qualified Data.Text as T (pack, unpack) import qualified Data.Vector as V (unsafeIndex, null, length, create, empty) import qualified Data.Vector.Mutable as VM (unsafeNew, unsafeWrite) @@ -163,7 +157,7 @@ -- | Generates both 'ToJSON' and 'FromJSON' instance declarations for the given -- data type or data family instance constructor. ----- This is a convienience function which is equivalent to calling both+-- This is a convenience function which is equivalent to calling both -- 'deriveToJSON' and 'deriveFromJSON'. deriveJSON :: Options            -- ^ Encoding options.@@ -176,7 +170,7 @@ -- | Generates both 'ToJSON1' and 'FromJSON1' instance declarations for the given -- data type or data family instance constructor. ----- This is a convienience function which is equivalent to calling both+-- This is a convenience function which is equivalent to calling both -- 'deriveToJSON1' and 'deriveFromJSON1'. deriveJSON1 :: Options             -- ^ Encoding options.@@ -189,7 +183,7 @@ -- | Generates both 'ToJSON2' and 'FromJSON2' instance declarations for the given -- data type or data family instance constructor. ----- This is a convienience function which is equivalent to calling both+-- This is a convenience function which is equivalent to calling both -- 'deriveToJSON2' and 'deriveFromJSON2'. deriveJSON2 :: Options             -- ^ Encoding options.@@ -475,8 +469,13 @@             restFields = mconcatE (map pureToPair rest)              (maybes0, rest0) = partition isMaybe argCons+#if MIN_VERSION_base(4,16,0)+            maybes = maybes0+            rest   = rest0+#else             (options, rest) = partition isOption rest0             maybes = maybes0 ++ map optionToMaybe options+#endif              maybeToPair = toPairLifted True             pureToPair = toPairLifted False@@ -518,12 +517,14 @@ isMaybe (_, AppT (ConT t) _, _) = t == ''Maybe isMaybe _                       = False +#if !MIN_VERSION_base(4,16,0) isOption :: (a, Type, b) -> Bool isOption (_, AppT (ConT t) _, _) = t == ''Semigroup.Option isOption _                       = False  optionToMaybe :: (ExpQ, b, c) -> (ExpQ, b, c) optionToMaybe (a, b, c) = ([|Semigroup.getOption|] `appE` a, b, c)+#endif  (<^>) :: ExpQ -> ExpQ -> ExpQ (<^>) a b = infixApp a [|(E.><)|] b@@ -574,7 +575,7 @@ -- -- > pairE "k" [|v|] = [|pair "k" v|] pairE :: String -> ExpQ -> ExpQ-pairE k v = [|pair k|] `appE` v+pairE k v = [|pair (Key.fromString k)|] `appE` v  -------------------------------------------------------------------------------- -- FromJSON@@ -695,7 +696,7 @@                    else mixedMatches tvMap      allNullaryMatches =-      [ do txt <- newName "txt"+      [ do txt <- newName "txtX"            match (conP 'String [varP txt])                  (guardedB $                   [ liftM2 (,) (normalG $@@ -772,12 +773,12 @@         ]      parseTaggedObject tvMap typFieldName valFieldName obj = do-      conKey <- newName "conKey"+      conKey <- newName "conKeyX"       doE [ bindS (varP conKey)                   (infixApp (varE obj)                             [|(.:)|]-                            ([|T.pack|] `appE` stringE typFieldName))-          , noBindS $ parseContents tvMap conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject+                            ([|Key.fromString|] `appE` stringE typFieldName))+          , noBindS $ parseContents tvMap conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject [|Key.fromString|] [|Key.toString|]           ]      parseUntaggedValue tvMap cons' conVal =@@ -806,8 +807,8 @@       parse2ElemArray tvMap arr = do-      conKey <- newName "conKey"-      conVal <- newName "conVal"+      conKey <- newName "conKeyY"+      conVal <- newName "conValY"       let letIx n ix =               valD (varP n)                    (normalB ([|V.unsafeIndex|] `appE`@@ -818,12 +819,13 @@            , letIx conVal 1            ]            (caseE (varE conKey)-                  [ do txt <- newName "txt"+                  [ do txt <- newName "txtY"                        match (conP 'String [varP txt])                              (normalB $ parseContents tvMap                                                       txt                                                       (Right conVal)                                                       'conNotFoundFail2ElemArray+                                                      [|T.pack|] [|T.unpack|]                              )                              []                   , do other <- newName "other"@@ -838,11 +840,11 @@            )      parseObjectWithSingleField tvMap obj = do-      conKey <- newName "conKey"-      conVal <- newName "conVal"-      caseE ([e|H.toList|] `appE` varE obj)+      conKey <- newName "conKeyZ"+      conVal <- newName "conValZ"+      caseE ([e|KM.toList|] `appE` varE obj)             [ match (listP [tupP [varP conKey, varP conVal]])-                    (normalB $ parseContents tvMap conKey (Right conVal) 'conNotFoundFailObjectSingleField)+                    (normalB $ parseContents tvMap conKey (Right conVal) 'conNotFoundFailObjectSingleField [|Key.fromString|] [|Key.toString|])                     []             , do other <- newName "other"                  match (varP other)@@ -853,13 +855,13 @@                        []             ] -    parseContents tvMap conKey contents errorFun =+    parseContents tvMap conKey contents errorFun pack unpack=         caseE (varE conKey)               [ match wildP                       ( guardedB $                         [ do g <- normalG $ infixApp (varE conKey)                                                      [|(==)|]-                                                     ([|T.pack|] `appE`+                                                     (pack `appE`                                                         conNameExp opts con)                              e <- checkExi tvMap con $                                   parseArgs jc tvMap tName opts con contents@@ -878,7 +880,7 @@                                                      . constructorName                                                      ) cons                                                 )-                                   `appE` ([|T.unpack|] `appE` varE conKey)+                                   `appE` (unpack `appE` varE conKey)                                  )                         ]                       )@@ -938,11 +940,11 @@     where       tagFieldNameAppender =           if inTaggedObject then (tagFieldName (sumEncoding opts) :) else id-      knownFields = appE [|H.fromList|] $ listE $-          map (\knownName -> tupE [appE [|T.pack|] $ litE $ stringL knownName, [|()|]]) $+      knownFields = appE [|KM.fromList|] $ listE $+          map (\knownName -> tupE [appE [|Key.fromString|] $ litE $ stringL knownName, [|()|]]) $               tagFieldNameAppender $ map (fieldLabel opts) fields       checkUnknownRecords =-          caseE (appE [|H.keys|] $ infixApp (varE obj) [|H.difference|] knownFields)+          caseE (appE [|KM.keys|] $ infixApp (varE obj) [|KM.difference|] knownFields)               [ match (listP []) (normalB [|return ()|]) []               , newName "unknownFields" >>=                   \unknownFields -> match (varP unknownFields)@@ -957,7 +959,7 @@                `appE` litE (stringL $ show tName)                `appE` litE (stringL $ constructorTagModifier opts $ nameBase conName)                `appE` varE obj-               `appE` ( [|T.pack|] `appE` stringE (fieldLabel opts field)+               `appE` ( [|Key.fromString|] `appE` stringE (fieldLabel opts field)                       )              | (field, argTy) <- zip fields argTys              ]@@ -967,7 +969,7 @@   val <- newName "val"   doE [ bindS (varP val) $ infixApp (varE obj)                                     [|(.:)|]-                                    ([|T.pack|] `appE`+                                    ([|Key.fromString|] `appE`                                        litE (stringL valFieldName))       , noBindS $ caseE (varE val) matches       ]@@ -1122,24 +1124,26 @@  class LookupField a where     lookupField :: (Value -> Parser a) -> String -> String-                -> Object -> T.Text -> Parser a+                -> Object -> Key -> Parser a -instance OVERLAPPABLE_ LookupField a where+instance {-# OVERLAPPABLE #-} LookupField a where     lookupField = lookupFieldWith -instance INCOHERENT_ LookupField (Maybe a) where+instance {-# INCOHERENT #-} LookupField (Maybe a) where     lookupField pj _ _ = parseOptionalFieldWith pj--instance INCOHERENT_ LookupField (Semigroup.Option a) where+ +#if !MIN_VERSION_base(4,16,0)+instance {-# INCOHERENT #-} LookupField (Semigroup.Option a) where     lookupField pj tName rec obj key =         fmap Semigroup.Option              (lookupField (fmap Semigroup.getOption . pj) tName rec obj key)+#endif  lookupFieldWith :: (Value -> Parser a) -> String -> String-                -> Object -> T.Text -> Parser a+                -> Object -> Key -> Parser a lookupFieldWith pj tName rec obj key =-    case H.lookup key obj of-      Nothing -> unknownFieldFail tName rec (T.unpack key)+    case KM.lookup key obj of+      Nothing -> unknownFieldFail tName rec (Key.toString key)       Just v  -> pj v <?> Key key  unknownFieldFail :: String -> String -> String -> Parser fail

@@ -26,11 +26,12 @@  import Data.Aeson.Types (Value(..), ToJSON(..)) import Data.Aeson.Encoding (encodingToLazyByteString)+import qualified Data.Aeson.KeyMap as KM import Data.Scientific (FPFormat(..), Scientific, base10Exponent) import Data.Text.Lazy.Builder import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder) import Numeric (showHex)-import qualified Data.HashMap.Strict as H+import qualified Data.Aeson.Key as Key import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT@@ -66,11 +67,11 @@                       V.foldr f (singleton ']') (V.unsafeTail v)       where f a z = singleton ',' <> go a <> z     go (Object m) = {-# SCC "go/Object" #-}-        case H.toList m of+        case KM.toList m of           (x:xs) -> singleton '{' <> one x <> foldr f (singleton '}') xs           _      -> "{}"       where f a z     = singleton ',' <> one a <> z-            one (k,v) = string k <> singleton ':' <> go v+            one (k,v) = string (Key.toText k) <> singleton ':' <> go v  string :: T.Text -> Builder string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'

@@ -14,6 +14,7 @@     (     -- * Core JSON types       Value(..)+    , Key     , Encoding     , unsafeToEncoding     , fromEncoding@@ -47,6 +48,7 @@     , ToJSONKey(..)     , ToJSONKeyFunction(..)     , toJSONKeyText+    , toJSONKeyKey     , contramapToJSONKeyFunction     , FromJSONKey(..)     , FromJSONKeyFunction(..)

@@ -53,6 +53,7 @@     , ToJSONKey(..)     , ToJSONKeyFunction(..)     , toJSONKeyText+    , toJSONKeyKey     , contramapToJSONKeyFunction     , FromJSONKey(..)     , FromJSONKeyFunction(..)

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}@@ -15,9 +16,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} -#include "incoherent-compat.h"-#include "overlapping-compat.h"- -- TODO: Drop this when we remove support for Data.Attoparsec.Number {-# OPTIONS_GHC -fno-warn-deprecations #-} @@ -82,7 +80,7 @@  import Control.Applicative ((<|>), Const(..), liftA2) import Control.Monad (zipWithM)-import Data.Aeson.Internal.Functions (mapKey)+import Data.Aeson.Internal.Functions (mapKey, mapKeyO) import Data.Aeson.Parser.Internal (eitherDecodeWith, jsonEOF) import Data.Aeson.Types.Generic import Data.Aeson.Types.Internal@@ -111,6 +109,7 @@ import Data.Time.Clock.System.Compat (SystemTime (..)) import Data.Time.Format.Compat (parseTimeM, defaultTimeLocale) import Data.Traversable as Tr (sequence)+import Data.Type.Coercion (Coercion (..)) import Data.Vector (Vector) import Data.Version (Version, parseVersion) import Data.Void (Void)@@ -122,10 +121,12 @@ import Text.ParserCombinators.ReadP (readP_to_S) import Unsafe.Coerce (unsafeCoerce) import qualified Data.Aeson.Parser.Time as Time+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KM import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific) import qualified Data.ByteString.Lazy as L import qualified Data.DList as DList-#if MIN_VERSION_dlist(1,0,0) && __GLASGOW_HASKELL__ >=800+#if MIN_VERSION_dlist(1,0,0) import qualified Data.DList.DNonEmpty as DNE #endif import qualified Data.Fix as F@@ -161,7 +162,6 @@  parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a parseIndexedJSON p idx value = p value <?> Index idx-{-# INLINE parseIndexedJSON #-}  parseIndexedJSONPair :: (Value -> Parser a) -> (Value -> Parser b) -> Int -> Value -> Parser (a, b) parseIndexedJSONPair keyParser valParser idx value = p value <?> Index idx@@ -173,40 +173,36 @@                       <*> parseJSONElemAtIndex valParser 1 ab              else fail $ "cannot unpack array of length " ++                          show n ++ " into a pair"-{-# INLINE parseIndexedJSONPair #-}  parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) <?> Index idx  parseRealFloat :: RealFloat a => String -> Value -> Parser a-parseRealFloat _    (Number s) = pure $ Scientific.toRealFloat s-parseRealFloat _    Null       = pure (0/0)-parseRealFloat name v          = prependContext name (unexpected v)-{-# INLINE parseRealFloat #-}+parseRealFloat _    (Number s)      = pure $ Scientific.toRealFloat s+parseRealFloat _    Null            = pure (0/0)+parseRealFloat _    (String "-inf") = pure (negate 1/0)+parseRealFloat _    (String "+inf") = pure (1/0)+parseRealFloat name v               = prependContext name (unexpected v)  parseIntegralFromScientific :: forall a. Integral a => Scientific -> Parser a parseIntegralFromScientific s =     case Scientific.floatingOrInteger s :: Either Double a of         Right x -> pure x         Left _  -> fail $ "unexpected floating number " ++ show s-{-# INLINE parseIntegralFromScientific #-}  parseIntegral :: Integral a => String -> Value -> Parser a parseIntegral name =     prependContext name . withBoundedScientific' parseIntegralFromScientific-{-# INLINE parseIntegral #-}  parseBoundedIntegralFromScientific :: (Bounded a, Integral a) => Scientific -> Parser a parseBoundedIntegralFromScientific s = maybe     (fail $ "value is either floating or will cause over or underflow " ++ show s)     pure     (Scientific.toBoundedInteger s)-{-# INLINE parseBoundedIntegralFromScientific #-}  parseBoundedIntegral :: (Bounded a, Integral a) => String -> Value -> Parser a parseBoundedIntegral name =     prependContext name . withScientific' parseBoundedIntegralFromScientific-{-# INLINE parseBoundedIntegral #-}  parseScientificText :: Text -> Parser Scientific parseScientificText@@ -223,7 +219,6 @@   where     rejectLargeExponent :: Scientific -> Parser Scientific     rejectLargeExponent s = withBoundedScientific' pure (Number s)-{-# INLINE parseIntegralText #-}  parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a parseBoundedIntegralText name t =@@ -231,12 +226,11 @@         parseScientificText t >>= parseBoundedIntegralFromScientific  parseOptionalFieldWith :: (Value -> Parser (Maybe a))-                       -> Object -> Text -> Parser (Maybe a)+                       -> Object -> Key -> Parser (Maybe a) parseOptionalFieldWith pj obj key =-    case H.lookup key obj of+    case KM.lookup key obj of      Nothing -> pure Nothing      Just v  -> pj v <?> Key key-{-# INLINE parseOptionalFieldWith #-}  ------------------------------------------------------------------------------- -- Generics@@ -429,7 +423,7 @@ --   For performance reasons, these exist as three options instead of one. data FromJSONKeyFunction a where     FromJSONKeyCoerce :: Coercible Text a => FromJSONKeyFunction a-      -- ^ uses 'coerce'+      -- ^ uses 'coerce', we expect that 'Hashable' and 'Ord' instance are compatible.     FromJSONKeyText :: !(Text -> a) -> FromJSONKeyFunction a       -- ^ conversion from 'Text' that always succeeds     FromJSONKeyTextParser :: !(Text -> Parser a) -> FromJSONKeyFunction a@@ -646,7 +640,6 @@  instance FromJSON1 [] where     liftParseJSON _ p' = p'-    {-# INLINE liftParseJSON #-}  instance (FromJSON a) => FromJSON [a] where     parseJSON = parseJSON1@@ -673,7 +666,6 @@ withObject :: String -> (Object -> Parser a) -> Value -> Parser a withObject _    f (Object obj) = f obj withObject name _ v            = prependContext name (typeMismatch "Object" v)-{-# INLINE withObject #-}  -- | @'withText' name f value@ applies @f@ to the 'Text' when @value@ is a -- 'Data.Aeson.String' and fails otherwise.@@ -685,7 +677,6 @@ withText :: String -> (Text -> Parser a) -> Value -> Parser a withText _    f (String txt) = f txt withText name _ v            = prependContext name (typeMismatch "String" v)-{-# INLINE withText #-}  -- | @'withArray' expected f value@ applies @f@ to the 'Array' when @value@ is -- an 'Data.Aeson.Array' and fails otherwise.@@ -697,7 +688,6 @@ withArray :: String -> (Array -> Parser a) -> Value -> Parser a withArray _    f (Array arr) = f arr withArray name _ v           = prependContext name (typeMismatch "Array" v)-{-# INLINE withArray #-}  -- | @'withScientific' name f value@ applies @f@ to the 'Scientific' number -- when @value@ is a 'Data.Aeson.Number' and fails using 'typeMismatch'@@ -715,7 +705,6 @@ withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a withScientific _ f (Number scientific) = f scientific withScientific name _ v = prependContext name (typeMismatch "Number" v)-{-# INLINE withScientific #-}  -- | A variant of 'withScientific' which doesn't use 'prependContext', so that -- such context can be added separately in a way that also applies when the@@ -737,20 +726,17 @@ withScientific' f v = case v of     Number n -> f n     _ -> typeMismatch "Number" v-{-# INLINE withScientific' #-}  -- | @'withBoundedScientific' name f value@ applies @f@ to the 'Scientific' number -- when @value@ is a 'Number' with exponent less than or equal to 1024. withBoundedScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a withBoundedScientific name f v = withBoundedScientific_ (prependContext name) f v-{-# INLINE withBoundedScientific #-}  -- | A variant of 'withBoundedScientific' which doesn't use 'prependContext', -- so that such context can be added separately in a way that also applies -- when the continuation @f :: Scientific -> Parser a@ fails. withBoundedScientific' :: (Scientific -> Parser a) -> Value -> Parser a withBoundedScientific' f v = withBoundedScientific_ id f v-{-# INLINE withBoundedScientific' #-}  -- | A variant of 'withBoundedScientific_' parameterized by a function to apply -- to the 'Parser' in case of failure.@@ -764,7 +750,6 @@     msg = "found a number with exponent " ++ show exp10 ++ ", but it must not be greater than 1024" withBoundedScientific_ whenFail _ v =     whenFail (typeMismatch "Number" v)-{-# INLINE withBoundedScientific_ #-}  -- | @'withBool' expected f value@ applies @f@ to the 'Bool' when @value@ is a -- 'Boolean' and fails otherwise.@@ -776,7 +761,6 @@ withBool :: String -> (Bool -> Parser a) -> Value -> Parser a withBool _    f (Bool arr) = f arr withBool name _ v          = prependContext name (typeMismatch "Boolean" v)-{-# INLINE withBool #-}  -- | Decode a nested JSON-encoded string. withEmbeddedJSON :: String -> (Value -> Parser a) -> Value -> Parser a@@ -786,17 +770,14 @@         eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON         eitherFormatError = either (Left . uncurry formatError) Right withEmbeddedJSON name _ v = prependContext name (typeMismatch "String" v)-{-# INLINE withEmbeddedJSON #-}  -- | Convert a value from JSON, failing if the types do not match. fromJSON :: (FromJSON a) => Value -> Result a fromJSON = parse parseJSON-{-# INLINE fromJSON #-}  -- | Convert a value from JSON, failing if the types do not match. ifromJSON :: (FromJSON a) => Value -> IResult a ifromJSON = iparse parseJSON-{-# INLINE ifromJSON #-}  -- | Retrieve the value associated with the given key of an 'Object'. -- The result is 'empty' if the key is not present or the value cannot@@ -805,9 +786,8 @@ -- This accessor is appropriate if the key and value /must/ be present -- in an object for it to be valid.  If the key and value are -- optional, use '.:?' instead.-(.:) :: (FromJSON a) => Object -> Text -> Parser a+(.:) :: (FromJSON a) => Object -> Key -> Parser a (.:) = explicitParseField parseJSON-{-# INLINE (.:) #-}  -- | Retrieve the value associated with the given key of an 'Object'. The -- result is 'Nothing' if the key is not present or if its value is 'Null',@@ -816,9 +796,8 @@ -- This accessor is most useful if the key and value can be absent -- from an object without affecting its validity.  If the key and -- value are mandatory, use '.:' instead.-(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)+(.:?) :: (FromJSON a) => Object -> Key -> Parser (Maybe a) (.:?) = explicitParseFieldMaybe parseJSON-{-# INLINE (.:?) #-}  -- | Retrieve the value associated with the given key of an 'Object'. -- The result is 'Nothing' if the key is not present or 'empty' if the@@ -826,47 +805,40 @@ -- -- This differs from '.:?' by attempting to parse 'Null' the same as any -- other JSON value, instead of interpreting it as 'Nothing'.-(.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)+(.:!) :: (FromJSON a) => Object -> Key -> Parser (Maybe a) (.:!) = explicitParseFieldMaybe' parseJSON-{-# INLINE (.:!) #-}  -- | Function variant of '.:'.-parseField :: (FromJSON a) => Object -> Text -> Parser a+parseField :: (FromJSON a) => Object -> Key -> Parser a parseField = (.:)-{-# INLINE parseField #-}  -- | Function variant of '.:?'.-parseFieldMaybe :: (FromJSON a) => Object -> Text -> Parser (Maybe a)+parseFieldMaybe :: (FromJSON a) => Object -> Key -> Parser (Maybe a) parseFieldMaybe = (.:?)-{-# INLINE parseFieldMaybe #-}  -- | Function variant of '.:!'.-parseFieldMaybe' :: (FromJSON a) => Object -> Text -> Parser (Maybe a)+parseFieldMaybe' :: (FromJSON a) => Object -> Key -> Parser (Maybe a) parseFieldMaybe' = (.:!)-{-# INLINE parseFieldMaybe' #-}  -- | Variant of '.:' with explicit parser function. -- -- E.g. @'explicitParseField' 'parseJSON1' :: ('FromJSON1' f, 'FromJSON' a) -> 'Object' -> 'Text' -> 'Parser' (f a)@-explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a-explicitParseField p obj key = case H.lookup key obj of+explicitParseField :: (Value -> Parser a) -> Object -> Key -> Parser a+explicitParseField p obj key = case KM.lookup key obj of     Nothing -> fail $ "key " ++ show key ++ " not found"     Just v  -> p v <?> Key key-{-# INLINE explicitParseField #-}  -- | Variant of '.:?' with explicit parser function.-explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)-explicitParseFieldMaybe p obj key = case H.lookup key obj of+explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)+explicitParseFieldMaybe p obj key = case KM.lookup key obj of     Nothing -> pure Nothing     Just v  -> liftParseJSON p (listParser p) v <?> Key key -- listParser isn't used by maybe instance.-{-# INLINE explicitParseFieldMaybe #-}  -- | Variant of '.:!' with explicit parser function.-explicitParseFieldMaybe' :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)-explicitParseFieldMaybe' p obj key = case H.lookup key obj of+explicitParseFieldMaybe' :: (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)+explicitParseFieldMaybe' p obj key = case KM.lookup key obj of     Nothing -> pure Nothing     Just v  -> Just <$> p v <?> Key key-{-# INLINE explicitParseFieldMaybe' #-}  -- | Helper for use in combination with '.:?' to provide default -- values for optional JSON object fields.@@ -884,7 +856,6 @@ -- @ (.!=) :: Parser (Maybe a) -> a -> Parser a pmval .!= val = fromMaybe val <$> pmval-{-# INLINE (.!=) #-}  -------------------------------------------------------------------------------- -- Generic parseJSON@@ -893,12 +864,14 @@ instance GFromJSON arity V1 where     -- Whereof we cannot format, thereof we cannot parse:     gParseJSON _ _ _ = fail "Attempted to parse empty type"+    {-# INLINE gParseJSON #-}  -instance OVERLAPPABLE_ (GFromJSON arity a) => GFromJSON arity (M1 i c a) where+instance {-# OVERLAPPABLE #-} (GFromJSON arity a) => GFromJSON arity (M1 i c a) where     -- Meta-information, which is not handled elsewhere, is just added to the     -- parsed value:     gParseJSON opts fargs = fmap M1 . gParseJSON opts fargs+    {-# INLINE gParseJSON #-}  -- Information for error messages @@ -914,9 +887,9 @@ -- | Left "Error in $: parsing T failed, expected an object with keys "tag" and -- | "contents", where "tag" i-- |s associated to one of ["Foo", "Bar"], -- | The parser returned error was: could not find key "tag"-contextTag :: Text -> [String] -> Parser a -> Parser a+contextTag :: Key -> [String] -> Parser a -> Parser a contextTag tagKey cnames = prependFailure-  ("expected Object with key \"" ++ unpack tagKey ++ "\"" +++  ("expected Object with key \"" ++ Key.toString tagKey ++ "\"" ++   " containing one of " ++ show cnames ++ ", ")  -- | Add the name of the constructor being parsed to a parser's error messages.@@ -934,16 +907,19 @@ instance (FromJSON a) => GFromJSON arity (K1 i a) where     -- Constant values are decoded using their FromJSON instance:     gParseJSON _opts _ = fmap K1 . parseJSON+    {-# INLINE gParseJSON #-}  instance GFromJSON One Par1 where     -- Direct occurrences of the last type parameter are decoded with the     -- function passed in as an argument:     gParseJSON _opts (From1Args pj _) = fmap Par1 . pj+    {-# INLINE gParseJSON #-}  instance (FromJSON1 f) => GFromJSON One (Rec1 f) where     -- Recursive occurrences of the last type parameter are decoded using their     -- FromJSON1 instance:     gParseJSON _opts (From1Args pj pjl) = fmap Rec1 . liftParseJSON pj pjl+    {-# INLINE gParseJSON #-}  instance (FromJSON1 f, GFromJSON One g) => GFromJSON One (f :.: g) where     -- If an occurrence of the last type parameter is nested inside two@@ -952,6 +928,7 @@     gParseJSON opts fargs =         let gpj = gParseJSON opts fargs in         fmap Comp1 . liftParseJSON gpj (listParser gpj)+    {-# INLINE gParseJSON #-}  -------------------------------------------------------------------------------- @@ -962,6 +939,7 @@       where         tname = moduleName proxy ++ "." ++ datatypeName proxy         proxy = undefined :: M1 _i d _f _p+    {-# INLINE gParseJSON #-}  -- | 'GFromJSON', after unwrapping the 'D1' constructor, now carrying the data -- type's name.@@ -985,6 +963,7 @@         | otherwise = fmap M1 . consParseJSON (cname :* p)       where         cname = conName (undefined :: M1 _i c _f _p)+    {-# INLINE gParseJSON' #-}  -- | Multiple constructors. instance ( AllNullary          (a :+: b) allNullary@@ -997,6 +976,7 @@         (unTagged :: Tagged allNullary (Parser ((a :+: b) _d)) ->                                         Parser ((a :+: b) _d))                    . parseSum p+    {-# INLINE gParseJSON' #-}  -------------------------------------------------------------------------------- @@ -1014,6 +994,7 @@     parseSum p@(tname :* opts :* _)         | allNullaryToStringTag opts = Tagged . parseAllNullarySum tname opts         | otherwise                  = Tagged . parseNonAllNullarySum p+    {-# INLINE parseSum #-}  instance ( ConstructorNames        f          , FromPair          arity f@@ -1021,6 +1002,7 @@          , FromUntaggedValue arity f          ) => ParseSum       arity f False where     parseSum p = Tagged . parseNonAllNullarySum p+    {-# INLINE parseSum #-}  -------------------------------------------------------------------------------- @@ -1053,6 +1035,7 @@ instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where     parseSumFromString opts key = (L1 <$> parseSumFromString opts key) <|>                                   (R1 <$> parseSumFromString opts key)+    {-# INLINE parseSumFromString #-}  instance (Constructor c) => SumFromString (C1 c U1) where     parseSumFromString modifier key@@ -1060,10 +1043,12 @@         | otherwise   = Nothing       where         name = pack $ modifier $ conName (undefined :: M1 _i c _f _p)+    {-# INLINE parseSumFromString #-}  -- For genericFromJSONKey instance SumFromString a => SumFromString (D1 d a) where     parseSumFromString modifier key = M1 <$> parseSumFromString modifier key+    {-# INLINE parseSumFromString #-}  -- | List of all constructor tags. constructorTags :: ConstructorNames a => (String -> t) -> Tagged2 a [t]@@ -1083,11 +1068,13 @@           -> Tagged2 b (DList.DList t)           -> Tagged2 (a :+: b) (DList.DList t)         append (Tagged2 xs) (Tagged2 ys) = Tagged2 (DList.append xs ys)+    {-# INLINE constructorNames' #-}  instance Constructor c => ConstructorNames (C1 c a) where     constructorNames' f = Tagged2 (pure (f cname))       where         cname = conName (undefined :: M1 _i c _f _p)+    {-# INLINE constructorNames' #-}  -- For genericFromJSONKey instance ConstructorNames a => ConstructorNames (D1 d a) where@@ -1095,6 +1082,7 @@       where         retag :: Tagged2 a u -> Tagged2 (D1 d a) u         retag (Tagged2 x) = Tagged2 x+    {-# INLINE constructorNames' #-}  -------------------------------------------------------------------------------- parseNonAllNullarySum :: forall f c arity.@@ -1112,19 +1100,19 @@               fromMaybe (badTag tag <?> Key tagKey) $                   parseFromTaggedObject (tag :* contentsFieldName :* p) obj         where-          tagKey = pack tagFieldName+          tagKey = Key.fromString tagFieldName           badTag tag = failWith_ $ \cnames ->               "expected tag field to be one of " ++ show cnames ++               ", but found tag " ++ show tag           cnames_ = unTagged2 (constructorTags (constructorTagModifier opts) :: Tagged2 f [String])        ObjectWithSingleField ->-          withObject tname $ \obj -> case H.toList obj of+          withObject tname $ \obj -> case KM.toList obj of               [(tag, v)] -> maybe (badTag tag) (<?> Key tag) $                   parsePair (tag :* p) v               _ -> contextType tname . fail $                   "expected an Object with a single pair, but found " ++-                  show (H.size obj) ++ " pairs"+                  show (KM.size obj) ++ " pairs"         where           badTag tag = failWith_ $ \cnames ->               "expected an Object with a single pair where the tag is one of " ++@@ -1134,7 +1122,7 @@           withArray tname $ \arr -> case V.length arr of               2 | String tag <- V.unsafeIndex arr 0 ->                   maybe (badTag tag <?> Index 0) (<?> Index 1) $-                      parsePair (tag :* p) (V.unsafeIndex arr 1)+                      parsePair (Key.fromText tag :* p) (V.unsafeIndex arr 1)                 | otherwise ->                   contextType tname $                       fail "tag element is not a String" <?> Index 0@@ -1165,6 +1153,7 @@         parseFromTaggedObject p obj =             (fmap L1 <$> parseFromTaggedObject p obj) <|>             (fmap R1 <$> parseFromTaggedObject p obj)+        {-# INLINE parseFromTaggedObject #-}  instance ( IsRecord                f isRecord          , FromTaggedObject' arity f isRecord@@ -1179,6 +1168,7 @@       where         tag' = pack $ constructorTagModifier opts cname         cname = conName (undefined :: M1 _i c _f _p)+    {-# INLINE parseFromTaggedObject #-}  -------------------------------------------------------------------------------- @@ -1191,6 +1181,7 @@ instance (RecordFromJSON arity f, FieldNames f) => FromTaggedObject' arity f True where     -- Records are unpacked in the tagged object     parseFromTaggedObject' (_ :* p) = Tagged . recordParseJSON (True :* p)+    {-# INLINE parseFromTaggedObject' #-}  instance (ConsFromJSON arity f) => FromTaggedObject' arity f False where     -- Nonnullary nonrecords are encoded in the contents field@@ -1198,12 +1189,14 @@         contents <- contextCons cname tname (obj .: key)         consParseJSON p' contents <?> Key key       where-        key = pack contentsFieldName+        key = Key.fromString contentsFieldName         contentsFieldName :* p'@(cname :* tname :* _) = p+    {-# INLINE parseFromTaggedObject' #-} -instance OVERLAPPING_ FromTaggedObject' arity U1 False where+instance {-# OVERLAPPING #-} FromTaggedObject' arity U1 False where     -- Nullary constructors don't need a contents field     parseFromTaggedObject' _ _ = Tagged (pure U1)+    {-# INLINE parseFromTaggedObject' #-}  -------------------------------------------------------------------------------- @@ -1225,19 +1218,22 @@     consParseJSON p =       (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))           . consParseJSON' p+    {-# INLINE consParseJSON #-} -instance OVERLAPPING_+instance {-# OVERLAPPING #-}          ( GFromJSON arity a, RecordFromJSON arity (S1 s a)          ) => ConsFromJSON' arity (S1 s a) True where     consParseJSON' p@(cname :* tname :* opts :* fargs)         | unwrapUnaryRecords opts = Tagged . fmap M1 . gParseJSON opts fargs         | otherwise = Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))+    {-# INLINE consParseJSON' #-}  instance RecordFromJSON arity f => ConsFromJSON' arity f True where     consParseJSON' p@(cname :* tname :* _) =         Tagged . withObject (showCons cname tname) (recordParseJSON (False :* p))+    {-# INLINE consParseJSON' #-} -instance OVERLAPPING_+instance {-# OVERLAPPING #-}          ConsFromJSON' arity U1 False where     -- Empty constructors are expected to be encoded as an empty array:     consParseJSON' (cname :* tname :* _) v =@@ -1249,15 +1245,18 @@         fail_ a = fail $             "expected an empty Array, but encountered an Array of length " ++             show (V.length a)+    {-# INLINE consParseJSON' #-} -instance OVERLAPPING_+instance {-# OVERLAPPING #-}          GFromJSON arity f => ConsFromJSON' arity (S1 s f) False where     consParseJSON' (_ :* _ :* opts :* fargs) =         Tagged . fmap M1 . gParseJSON opts fargs+    {-# INLINE consParseJSON' #-}  instance (ProductFromJSON arity f, ProductSize f          ) => ConsFromJSON' arity f False where     consParseJSON' p = Tagged . productParseJSON0 p+    {-# INLINE consParseJSON' #-}  -------------------------------------------------------------------------------- @@ -1268,9 +1267,11 @@     fieldNames _ =       fieldNames (undefined :: a x) .       fieldNames (undefined :: b y)+    {-# INLINE fieldNames #-}  instance (Selector s) => FieldNames (S1 s f) where     fieldNames _ = (selName (undefined :: M1 _i s _f _p) :)+    {-# INLINE fieldNames #-}  class RecordFromJSON arity f where     recordParseJSON@@ -1283,18 +1284,19 @@     recordParseJSON (fromTaggedSum :* p@(cname :* tname :* opts :* _)) =         \obj -> checkUnknown obj >> recordParseJSON' p obj         where-            knownFields :: H.HashMap Text ()-            knownFields = H.fromList $ map ((,()) . pack) $+            knownFields :: KM.KeyMap ()+            knownFields = KM.fromList $ map ((,()) . Key.fromString) $                 [tagFieldName (sumEncoding opts) | fromTaggedSum] <>                 (fieldLabelModifier opts <$> fieldNames (undefined :: f a) [])              checkUnknown =                 if not (rejectUnknownFields opts)                 then \_ -> return ()-                else \obj -> case H.keys (H.difference obj knownFields) of+                else \obj -> case KM.keys (KM.difference obj knownFields) of                     [] -> return ()                     unknownFields -> contextCons cname tname $                         fail ("unknown fields: " ++ show unknownFields)+    {-# INLINE recordParseJSON #-}  class RecordFromJSON' arity f where     recordParseJSON'@@ -1307,30 +1309,36 @@     recordParseJSON' p obj =         (:*:) <$> recordParseJSON' p obj               <*> recordParseJSON' p obj+    {-# INLINE recordParseJSON' #-} -instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>+instance {-# OVERLAPPABLE #-} (Selector s, GFromJSON arity a) =>          RecordFromJSON' arity (S1 s a) where     recordParseJSON' (cname :* tname :* opts :* fargs) obj = do         fv <- contextCons cname tname (obj .: label)         M1 <$> gParseJSON opts fargs fv <?> Key label       where-        label = pack $ fieldLabelModifier opts sname+        label = Key.fromString $ fieldLabelModifier opts sname         sname = selName (undefined :: M1 _i s _f _p)+    {-# INLINE recordParseJSON' #-} -instance INCOHERENT_ (Selector s, FromJSON a) =>+instance {-# INCOHERENT #-} (Selector s, FromJSON a) =>          RecordFromJSON' arity (S1 s (K1 i (Maybe a))) where-    recordParseJSON' (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? pack label+    recordParseJSON' (_ :* _ :* opts :* _) obj = M1 . K1 <$> obj .:? label       where-        label = fieldLabelModifier opts sname+        label = Key.fromString $ fieldLabelModifier opts sname         sname = selName (undefined :: M1 _i s _f _p)+    {-# INLINE recordParseJSON' #-} +#if !MIN_VERSION_base(4,16,0) -- Parse an Option like a Maybe.-instance INCOHERENT_ (Selector s, FromJSON a) =>+instance {-# INCOHERENT #-} (Selector s, FromJSON a) =>          RecordFromJSON' arity (S1 s (K1 i (Semigroup.Option a))) where     recordParseJSON' p obj = wrap <$> recordParseJSON' p obj       where         wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p         wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))+    {-# INLINE recordParseJSON' #-}+#endif  -------------------------------------------------------------------------------- @@ -1373,12 +1381,13 @@ instance (GFromJSON arity a) => ProductFromJSON arity (S1 s a) where     productParseJSON (_ :* _ :* opts :* fargs) arr ix _ =         M1 <$> gParseJSON opts fargs (V.unsafeIndex arr ix) <?> Index ix+    {-# INLINE productParseJSON #-}  --------------------------------------------------------------------------------  class FromPair arity f where     -- The first component of the parameter tuple is the tag to match.-    parsePair :: Text :* TypeName :* Options :* FromArgs arity a+    parsePair :: Key :* TypeName :* Options :* FromArgs arity a               -> Value               -> Maybe (Parser (f a)) @@ -1388,6 +1397,7 @@     parsePair p pair =         (fmap L1 <$> parsePair p pair) <|>         (fmap R1 <$> parsePair p pair)+    {-# INLINE parsePair #-}  instance ( Constructor c          , ConsFromJSON arity a@@ -1396,8 +1406,9 @@         | tag == tag' = Just $ M1 <$> consParseJSON (cname :* p) v         | otherwise   = Nothing       where-        tag' = pack $ constructorTagModifier opts cname+        tag' = Key.fromString $ constructorTagModifier opts cname         cname = conName (undefined :: M1 _i c _a _p)+    {-# INLINE parsePair #-}  -------------------------------------------------------------------------------- @@ -1414,8 +1425,9 @@     parseUntaggedValue p value =         L1 <$> parseUntaggedValue p value <|>         R1 <$> parseUntaggedValue p value+    {-# INLINE parseUntaggedValue #-} -instance OVERLAPPABLE_+instance {-# OVERLAPPABLE #-}     ( ConsFromJSON arity a     , Constructor c     ) => FromUntaggedValue arity (C1 c a)@@ -1423,8 +1435,9 @@     parseUntaggedValue p = fmap M1 . consParseJSON (cname :* p)       where         cname = conName (undefined :: M1 _i c _f _p)+    {-# INLINE parseUntaggedValue #-} -instance OVERLAPPING_+instance {-# OVERLAPPING #-}     ( Constructor c )     => FromUntaggedValue arity (C1 c U1)   where@@ -1439,6 +1452,7 @@         cname = conName (undefined :: M1 _i c _f _p)         fail_ tag = fail $           "expected tag " ++ show tag' ++ ", but found tag " ++ show tag+    {-# INLINE parseUntaggedValue #-}  ------------------------------------------------------------------------------- -- Instances@@ -1451,14 +1465,11 @@  instance FromJSON2 Const where     liftParseJSON2 p _ _ _ = fmap Const . p-    {-# INLINE liftParseJSON2 #-}  instance FromJSON a => FromJSON1 (Const a) where     liftParseJSON _ _ = fmap Const . parseJSON-    {-# INLINE liftParseJSON #-}  instance FromJSON a => FromJSON (Const a b) where-    {-# INLINE parseJSON #-}     parseJSON = fmap Const . parseJSON  instance (FromJSON a, FromJSONKey a) => FromJSONKey (Const a b) where@@ -1468,20 +1479,17 @@ instance FromJSON1 Maybe where     liftParseJSON _ _ Null = pure Nothing     liftParseJSON p _ a    = Just <$> p a-    {-# INLINE liftParseJSON #-}  instance (FromJSON a) => FromJSON (Maybe a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}  - instance FromJSON2 Either where-    liftParseJSON2 pA _ pB _ (Object (H.toList -> [(key, value)]))+    liftParseJSON2 pA _ pB _ (Object (KM.toList -> [(key, value)]))         | key == left  = Left  <$> pA value <?> Key left         | key == right = Right <$> pB value <?> Key right       where-        left, right :: Text+        left, right :: Key         left  = "Left"         right = "Right" @@ -1489,24 +1497,19 @@         "expected an object with a single property " ++         "where the property key should be either " ++         "\"Left\" or \"Right\""-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a) => FromJSON1 (Either a) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}  instance FromJSON Void where     parseJSON _ = fail "Cannot parse Void"-    {-# INLINE parseJSON #-}  instance FromJSON Bool where     parseJSON (Bool b) = pure b     parseJSON v = typeMismatch "Bool" v-    {-# INLINE parseJSON #-}  instance FromJSONKey Bool where     fromJSONKey = FromJSONKeyTextParser $ \t -> case t of@@ -1524,19 +1527,13 @@                   " (expected \"LT\", \"EQ\", or \"GT\")"  instance FromJSON () where-    parseJSON = withArray "()" $ \v ->-                  if V.null v-                    then pure ()-                    else prependContext "()" $ fail "expected an empty array"-    {-# INLINE parseJSON #-}+    parseJSON _ = pure ()  instance FromJSON Char where     parseJSON = withText "Char" parseChar-    {-# INLINE parseJSON #-}      parseJSONList (String s) = pure (T.unpack s)     parseJSONList v = typeMismatch "String" v-    {-# INLINE parseJSONList #-}  parseChar :: Text -> Parser Char parseChar t =@@ -1546,25 +1543,23 @@  instance FromJSON Double where     parseJSON = parseRealFloat "Double"-    {-# INLINE parseJSON #-}  instance FromJSONKey Double where     fromJSONKey = FromJSONKeyTextParser $ \t -> case t of-        "NaN"       -> pure (0/0)-        "Infinity"  -> pure (1/0)-        "-Infinity" -> pure (negate 1/0)-        _           -> Scientific.toRealFloat <$> parseScientificText t+        "NaN"   -> pure (0/0)+        "-inf"  -> pure (1/0)+        "+inf"  -> pure (negate 1/0)+        _       -> Scientific.toRealFloat <$> parseScientificText t  instance FromJSON Float where     parseJSON = parseRealFloat "Float"-    {-# INLINE parseJSON #-}  instance FromJSONKey Float where     fromJSONKey = FromJSONKeyTextParser $ \t -> case t of-        "NaN"       -> pure (0/0)-        "Infinity"  -> pure (1/0)-        "-Infinity" -> pure (negate 1/0)-        _           -> Scientific.toRealFloat <$> parseScientificText t+        "NaN"  -> pure (0/0)+        "+inf" -> pure (1/0)+        "-inf" -> pure (negate 1/0)+        _      -> Scientific.toRealFloat <$> parseScientificText t  instance (FromJSON a, Integral a) => FromJSON (Ratio a) where     parseJSON (Number x)@@ -1583,7 +1578,6 @@             if denominator == 0             then fail "Ratio denominator was 0"             else pure $ numerator % denominator-    {-# INLINE parseJSON #-}  -- | This instance includes a bounds check to prevent maliciously -- large inputs to fill up the memory of the target system. You can@@ -1591,11 +1585,9 @@ -- 'withScientific' if you want to allow larger inputs. instance HasResolution a => FromJSON (Fixed a) where     parseJSON = prependContext "Fixed" . withBoundedScientific' (pure . realToFrac)-    {-# INLINE parseJSON #-}  instance FromJSON Int where     parseJSON = parseBoundedIntegral "Int"-    {-# INLINE parseJSON #-}  instance FromJSONKey Int where     fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int"@@ -1606,7 +1598,6 @@ -- 'withScientific' if you want to allow larger inputs. instance FromJSON Integer where     parseJSON = parseIntegral "Integer"-    {-# INLINE parseJSON #-}  instance FromJSONKey Integer where     fromJSONKey = FromJSONKeyTextParser $ parseIntegralText "Integer"@@ -1630,74 +1621,63 @@  instance FromJSON Int8 where     parseJSON = parseBoundedIntegral "Int8"-    {-# INLINE parseJSON #-}  instance FromJSONKey Int8 where     fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int8"  instance FromJSON Int16 where     parseJSON = parseBoundedIntegral "Int16"-    {-# INLINE parseJSON #-}  instance FromJSONKey Int16 where     fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int16"  instance FromJSON Int32 where     parseJSON = parseBoundedIntegral "Int32"-    {-# INLINE parseJSON #-}  instance FromJSONKey Int32 where     fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int32"  instance FromJSON Int64 where     parseJSON = parseBoundedIntegral "Int64"-    {-# INLINE parseJSON #-}  instance FromJSONKey Int64 where     fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int64"  instance FromJSON Word where     parseJSON = parseBoundedIntegral "Word"-    {-# INLINE parseJSON #-}  instance FromJSONKey Word where     fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Word"  instance FromJSON Word8 where     parseJSON = parseBoundedIntegral "Word8"-    {-# INLINE parseJSON #-}  instance FromJSONKey Word8 where     fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Word8"  instance FromJSON Word16 where     parseJSON = parseBoundedIntegral "Word16"-    {-# INLINE parseJSON #-}  instance FromJSONKey Word16 where     fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Word16"  instance FromJSON Word32 where     parseJSON = parseBoundedIntegral "Word32"-    {-# INLINE parseJSON #-}  instance FromJSONKey Word32 where     fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Word32"  instance FromJSON Word64 where     parseJSON = parseBoundedIntegral "Word64"-    {-# INLINE parseJSON #-}  instance FromJSONKey Word64 where     fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Word64"  instance FromJSON CTime where     parseJSON = fmap CTime . parseJSON-    {-# INLINE parseJSON #-}  instance FromJSON Text where     parseJSON = withText "Text" pure-    {-# INLINE parseJSON #-}  instance FromJSONKey Text where     fromJSONKey = fromJSONKeyCoerce@@ -1705,7 +1685,6 @@  instance FromJSON LT.Text where     parseJSON = withText "Lazy Text" $ pure . LT.fromStrict-    {-# INLINE parseJSON #-}  instance FromJSONKey LT.Text where     fromJSONKey = FromJSONKeyText LT.fromStrict@@ -1713,7 +1692,6 @@  instance FromJSON Version where     parseJSON = withText "Version" parseVersionText-    {-# INLINE parseJSON #-}  instance FromJSONKey Version where     fromJSONKey = FromJSONKeyTextParser parseVersionText@@ -1735,11 +1713,9 @@       where         ne []     = fail "parsing NonEmpty failed, unexpected empty list"         ne (x:xs) = pure (x :| xs)-    {-# INLINE liftParseJSON #-}  instance (FromJSON a) => FromJSON (NonEmpty a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}  ------------------------------------------------------------------------------- -- scientific@@ -1747,7 +1723,6 @@  instance FromJSON Scientific where     parseJSON = withScientific "Scientific" pure-    {-# INLINE parseJSON #-}  ------------------------------------------------------------------------------- -- DList@@ -1757,13 +1732,11 @@     liftParseJSON p _ = withArray "DList" $       fmap DList.fromList .       Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a) => FromJSON (DList.DList a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-} -#if MIN_VERSION_dlist(1,0,0) && __GLASGOW_HASKELL__ >=800+#if MIN_VERSION_dlist(1,0,0) -- | @since 1.5.3.0 instance FromJSON1 DNE.DNonEmpty where     liftParseJSON p _ = withArray "DNonEmpty" $@@ -1771,12 +1744,10 @@       where         ne []     = fail "parsing DNonEmpty failed, unexpected empty list"         ne (x:xs) = pure (DNE.fromNonEmpty (x :| xs))-    {-# INLINE liftParseJSON #-}  -- | @since 1.5.3.0 instance (FromJSON a) => FromJSON (DNE.DNonEmpty a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-} #endif  -------------------------------------------------------------------------------@@ -1785,17 +1756,13 @@  instance FromJSON1 Identity where     liftParseJSON p _ a = Identity <$> p a-    {-# INLINE liftParseJSON #-}      liftParseJSONList _ p a = fmap Identity <$> p a-    {-# INLINE liftParseJSONList #-}  instance (FromJSON a) => FromJSON (Identity a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}      parseJSONList = liftParseJSONList parseJSON parseJSONList-    {-# INLINE parseJSONList #-}  instance (FromJSONKey a) => FromJSONKey (Identity a) where     fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction a)@@ -1807,20 +1774,16 @@       where         g  = liftParseJSON p pl         gl = liftParseJSONList p pl-    {-# INLINE liftParseJSON #-}      liftParseJSONList p pl a = map Compose <$> liftParseJSONList g gl a       where         g  = liftParseJSON p pl         gl = liftParseJSONList p pl-    {-# INLINE liftParseJSONList #-}  instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Compose f g a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}      parseJSONList = liftParseJSONList parseJSON parseJSONList-    {-# INLINE parseJSONList #-}   instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Product f g) where@@ -1830,19 +1793,17 @@         pxl = liftParseJSONList p pl         py  = liftParseJSON p pl         pyl = liftParseJSONList p pl-    {-# INLINE liftParseJSON #-}  instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Product f g a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}   instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Sum f g) where-    liftParseJSON p pl (Object (H.toList -> [(key, value)]))+    liftParseJSON p pl (Object (KM.toList -> [(key, value)]))         | key == inl = InL <$> liftParseJSON p pl value <?> Key inl-        | key == inr = InR <$> liftParseJSON p pl value <?> Key inl+        | key == inr = InR <$> liftParseJSON p pl value <?> Key inr       where-        inl, inr :: Text+        inl, inr :: Key         inl = "InL"         inr = "InR" @@ -1850,11 +1811,9 @@         "parsing Sum failed, expected an object with a single property " ++         "where the property key should be either " ++         "\"InL\" or \"InR\""-    {-# INLINE liftParseJSON #-}  instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Sum f g a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}  ------------------------------------------------------------------------------- -- containers@@ -1864,21 +1823,17 @@     liftParseJSON p _ = withArray "Seq" $       fmap Seq.fromList .       Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a) => FromJSON (Seq.Seq a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}   instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where     parseJSON = fmap Set.fromList . parseJSON-    {-# INLINE parseJSON #-}   instance FromJSON IntSet.IntSet where     parseJSON = fmap IntSet.fromList . parseJSON-    {-# INLINE parseJSON #-}   instance FromJSON1 IntMap.IntMap where@@ -1886,29 +1841,39 @@       where         p'  = liftParseJSON2     parseJSON parseJSONList p pl         pl' = liftParseJSONList2 parseJSON parseJSONList p pl-    {-# INLINE liftParseJSON #-}  instance FromJSON a => FromJSON (IntMap.IntMap a) where     parseJSON = fmap IntMap.fromList . parseJSON-    {-# INLINE parseJSON #-}   instance (FromJSONKey k, Ord k) => FromJSON1 (M.Map k) where+    liftParseJSON :: forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (M.Map k a)     liftParseJSON p _ = case fromJSONKey of-        FromJSONKeyCoerce -> withObject "Map" $-            fmap (H.foldrWithKey (M.insert . unsafeCoerce) M.empty) . H.traverseWithKey (\k v -> p v <?> Key k)-        FromJSONKeyText f -> withObject "Map" $-            fmap (H.foldrWithKey (M.insert . f) M.empty) . H.traverseWithKey (\k v -> p v <?> Key k)+        FromJSONKeyCoerce -> withObject "Map ~Text" $ case Key.coercionToText of+            Nothing       -> text coerce+            Just Coercion -> case KM.coercionToMap of+                Nothing       -> text coerce+                Just Coercion -> uc . M.traverseWithKey (\k v -> p v <?> Key k) . KM.toMap+        FromJSONKeyText f -> withObject "Map" (text f)         FromJSONKeyTextParser f -> withObject "Map" $-            H.foldrWithKey (\k v m -> M.insert <$> f k <?> Key k <*> p v <?> Key k <*> m) (pure M.empty)+            KM.foldrWithKey (\k v m -> M.insert <$> f (Key.toText k) <?> Key k <*> p v <?> Key k <*> m) (pure M.empty)         FromJSONKeyValue f -> withArray "Map" $ \arr ->             fmap M.fromList . Tr.sequence .                 zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr-    {-# INLINE liftParseJSON #-}+      where+        uc :: Coercible Key k => Parser (M.Map Key a) -> Parser (M.Map k a)+        uc = unsafeCoerce +        text f = case KM.coercionToMap of+            Nothing       -> basic f+            Just Coercion -> fmap (mapKeyO (f . Key.toText)) . M.traverseWithKey (\k v -> p v <?> Key k) . KM.toMap+        {-# INLINE text #-}++        basic f = fmap (KM.foldrWithKey (M.insert . f . Key.toText) M.empty) . KM.traverseWithKey (\k v -> p v <?> Key k)+        {-# INLINE basic #-}+ instance (FromJSONKey k, Ord k, FromJSON v) => FromJSON (M.Map k v) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}   instance FromJSON1 Tree.Tree where@@ -1921,7 +1886,6 @@  instance (FromJSON v) => FromJSON (Tree.Tree v) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}  ------------------------------------------------------------------------------- -- uuid@@ -1942,27 +1906,22 @@ instance FromJSON1 Vector where     liftParseJSON p _ = withArray "Vector" $         V.mapM (uncurry $ parseIndexedJSON p) . V.indexed-    {-# INLINE liftParseJSON #-}  instance (FromJSON a) => FromJSON (Vector a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}   vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a) vectorParseJSON s = withArray s $ fmap V.convert . V.mapM (uncurry $ parseIndexedJSON parseJSON) . V.indexed-{-# INLINE vectorParseJSON #-}  instance (Storable a, FromJSON a) => FromJSON (VS.Vector a) where     parseJSON = vectorParseJSON "Data.Vector.Storable.Vector"  instance (VP.Prim a, FromJSON a) => FromJSON (VP.Vector a) where     parseJSON = vectorParseJSON "Data.Vector.Primitive.Vector"-    {-# INLINE parseJSON #-}  instance (VG.Vector VU.Vector a, FromJSON a) => FromJSON (VU.Vector a) where     parseJSON = vectorParseJSON "Data.Vector.Unboxed.Vector"-    {-# INLINE parseJSON #-}  ------------------------------------------------------------------------------- -- unordered-containers@@ -1970,35 +1929,52 @@  instance (Eq a, Hashable a, FromJSON a) => FromJSON (HashSet.HashSet a) where     parseJSON = fmap HashSet.fromList . parseJSON-    {-# INLINE parseJSON #-}   instance (FromJSONKey k, Eq k, Hashable k) => FromJSON1 (H.HashMap k) where+    liftParseJSON :: forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (H.HashMap k a)     liftParseJSON p _ = case fromJSONKey of-        FromJSONKeyCoerce -> withObject "HashMap ~Text" $-            uc . H.traverseWithKey (\k v -> p v <?> Key k)-        FromJSONKeyText f -> withObject "HashMap" $-            fmap (mapKey f) . H.traverseWithKey (\k v -> p v <?> Key k)+        FromJSONKeyCoerce -> withObject "HashMap ~Text" $ case Key.coercionToText of+            Nothing       -> text coerce+            Just Coercion -> case KM.coercionToHashMap of+                Nothing       -> text coerce+                Just Coercion -> uc . H.traverseWithKey (\k v -> p v <?> Key k) . KM.toHashMap+        FromJSONKeyText f -> withObject "HashMap" (text f)         FromJSONKeyTextParser f -> withObject "HashMap" $-            H.foldrWithKey (\k v m -> H.insert <$> f k <?> Key k <*> p v <?> Key k <*> m) (pure H.empty)+          H.foldrWithKey+            (\k v m -> H.insert <$> f (Key.toText k) <?> Key k <*> p v <?> Key k <*> m) (pure H.empty)+            . KM.toHashMap         FromJSONKeyValue f -> withArray "Map" $ \arr ->             fmap H.fromList . Tr.sequence .                 zipWith (parseIndexedJSONPair f p) [0..] . V.toList $ arr       where-        uc :: Parser (H.HashMap Text v) -> Parser (H.HashMap k v)+        uc :: Coercible Key k => Parser (H.HashMap Key a) -> Parser (H.HashMap k a)         uc = unsafeCoerce +        text f = case KM.coercionToHashMap of+            Nothing       -> basic f+            Just Coercion -> fmap (mapKey (f . Key.toText)) . H.traverseWithKey (\k v -> p v <?> Key k) . KM.toHashMap+        {-# INLINE text #-}++        basic f = fmap (KM.foldrWithKey (H.insert . f . Key.toText) H.empty) . KM.traverseWithKey (\k v -> p v <?> Key k)+        {-# INLINE basic #-}+ instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}  ------------------------------------------------------------------------------- -- aeson ------------------------------------------------------------------------------- +instance FromJSON Key where+    parseJSON = withText "Key" (pure . Key.fromText)++instance FromJSONKey Key where+    -- TODO: make me more efficient.+    fromJSONKey = FromJSONKeyText Key.fromText+ instance FromJSON Value where     parseJSON = pure-    {-# INLINE parseJSON #-}  instance FromJSON DotNetTime where     parseJSON = withText "DotNetTime" $ \t ->@@ -2007,7 +1983,6 @@         in case parseTimeM True defaultTimeLocale "/Date(%s%Q)/" (unpack t') of              Just d -> pure (DotNetTime d)              _      -> fail "could not parse .NET time"-    {-# INLINE parseJSON #-}  ------------------------------------------------------------------------------- -- primitive@@ -2080,7 +2055,6 @@ -- 'withScientific' if you want to allow larger inputs. instance FromJSON NominalDiffTime where     parseJSON = withBoundedScientific "NominalDiffTime" $ pure . realToFrac-    {-# INLINE parseJSON #-}   -- | This instance includes a bounds check to prevent maliciously@@ -2089,7 +2063,6 @@ -- 'withScientific' if you want to allow larger inputs. instance FromJSON DiffTime where     parseJSON = withBoundedScientific "DiffTime" $ pure . realToFrac-    {-# INLINE parseJSON #-}  instance FromJSON SystemTime where     parseJSON v = prependContext "SystemTime" $ do@@ -2157,113 +2130,86 @@  instance FromJSON1 Monoid.Dual where     liftParseJSON p _ = fmap Monoid.Dual . p-    {-# INLINE liftParseJSON #-}  instance FromJSON a => FromJSON (Monoid.Dual a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}   instance FromJSON1 Monoid.First where     liftParseJSON p p' = fmap Monoid.First . liftParseJSON p p'-    {-# INLINE liftParseJSON #-}  instance FromJSON a => FromJSON (Monoid.First a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}   instance FromJSON1 Monoid.Last where     liftParseJSON p p' = fmap Monoid.Last . liftParseJSON p p'-    {-# INLINE liftParseJSON #-}  instance FromJSON a => FromJSON (Monoid.Last a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}   instance FromJSON1 Semigroup.Min where     liftParseJSON p _ a = Semigroup.Min <$> p a-    {-# INLINE liftParseJSON #-}      liftParseJSONList _ p a = fmap Semigroup.Min <$> p a-    {-# INLINE liftParseJSONList #-}  instance (FromJSON a) => FromJSON (Semigroup.Min a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}      parseJSONList = liftParseJSONList parseJSON parseJSONList-    {-# INLINE parseJSONList #-}   instance FromJSON1 Semigroup.Max where     liftParseJSON p _ a = Semigroup.Max <$> p a-    {-# INLINE liftParseJSON #-}      liftParseJSONList _ p a = fmap Semigroup.Max <$> p a-    {-# INLINE liftParseJSONList #-}  instance (FromJSON a) => FromJSON (Semigroup.Max a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}      parseJSONList = liftParseJSONList parseJSON parseJSONList-    {-# INLINE parseJSONList #-}   instance FromJSON1 Semigroup.First where     liftParseJSON p _ a = Semigroup.First <$> p a-    {-# INLINE liftParseJSON #-}      liftParseJSONList _ p a = fmap Semigroup.First <$> p a-    {-# INLINE liftParseJSONList #-}  instance (FromJSON a) => FromJSON (Semigroup.First a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}      parseJSONList = liftParseJSONList parseJSON parseJSONList-    {-# INLINE parseJSONList #-}   instance FromJSON1 Semigroup.Last where     liftParseJSON p _ a = Semigroup.Last <$> p a-    {-# INLINE liftParseJSON #-}      liftParseJSONList _ p a = fmap Semigroup.Last <$> p a-    {-# INLINE liftParseJSONList #-}  instance (FromJSON a) => FromJSON (Semigroup.Last a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}      parseJSONList = liftParseJSONList parseJSON parseJSONList-    {-# INLINE parseJSONList #-}   instance FromJSON1 Semigroup.WrappedMonoid where     liftParseJSON p _ a = Semigroup.WrapMonoid <$> p a-    {-# INLINE liftParseJSON #-}      liftParseJSONList _ p a = fmap Semigroup.WrapMonoid <$> p a-    {-# INLINE liftParseJSONList #-}  instance (FromJSON a) => FromJSON (Semigroup.WrappedMonoid a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}      parseJSONList = liftParseJSONList parseJSON parseJSONList-    {-# INLINE parseJSONList #-} -+#if !MIN_VERSION_base(4,16,0) instance FromJSON1 Semigroup.Option where     liftParseJSON p p' = fmap Semigroup.Option . liftParseJSON p p'-    {-# INLINE liftParseJSON #-}  instance FromJSON a => FromJSON (Semigroup.Option a) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}+#endif  ------------------------------------------------------------------------------- -- data-fix@@ -2334,28 +2280,19 @@ -------------------------------------------------------------------------------  instance FromJSON1 Proxy where-    {-# INLINE liftParseJSON #-}-    liftParseJSON _ _ = fromNull "Proxy" Proxy+    liftParseJSON _ _ _ = pure Proxy  instance FromJSON (Proxy a) where-    {-# INLINE parseJSON #-}-    parseJSON = fromNull "Proxy" Proxy--fromNull :: String -> a -> Value -> Parser a-fromNull _ a Null = pure a-fromNull c _ v    = prependContext c (typeMismatch "Null" v)+    parseJSON _ = pure Proxy  instance FromJSON2 Tagged where     liftParseJSON2 _ _ p _ = fmap Tagged . p-    {-# INLINE liftParseJSON2 #-}  instance FromJSON1 (Tagged a) where     liftParseJSON p _ = fmap Tagged . p-    {-# INLINE liftParseJSON #-}  instance FromJSON b => FromJSON (Tagged a b) where     parseJSON = parseJSON1-    {-# INLINE parseJSON #-}  instance FromJSONKey b => FromJSONKey (Tagged a b) where     fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction b)@@ -2367,7 +2304,7 @@  -- | @since 1.5.1.0 instance (FromJSON a, FromJSON b) => FromJSON (These a b) where-    parseJSON = withObject "These a b" (p . H.toList)+    parseJSON = withObject "These a b" (p . KM.toList)       where         p [("This", a), ("That", b)] = These <$> parseJSON a <*> parseJSON b         p [("That", b), ("This", a)] = These <$> parseJSON a <*> parseJSON b@@ -2377,7 +2314,7 @@  -- | @since 1.5.1.0 instance FromJSON a => FromJSON1 (These a) where-    liftParseJSON pb _ = withObject "These a b" (p . H.toList)+    liftParseJSON pb _ = withObject "These a b" (p . KM.toList)       where         p [("This", a), ("That", b)] = These <$> parseJSON a <*> pb b         p [("That", b), ("This", a)] = These <$> parseJSON a <*> pb b@@ -2387,7 +2324,7 @@  -- | @since 1.5.1.0 instance FromJSON2 These where-    liftParseJSON2 pa _ pb _ = withObject "These a b" (p . H.toList)+    liftParseJSON2 pa _ pb _ = withObject "These a b" (p . KM.toList)       where         p [("This", a), ("That", b)] = These <$> pa a <*> pb b         p [("That", b), ("This", a)] = These <$> pa a <*> pb b@@ -2397,7 +2334,7 @@  -- | @since 1.5.1.0 instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (These1 f g) where-    liftParseJSON px pl = withObject "These1" (p . H.toList)+    liftParseJSON px pl = withObject "These1" (p . KM.toList)       where         p [("This", a), ("That", b)] = These1 <$> liftParseJSON px pl a <*> liftParseJSON px pl b         p [("That", b), ("This", a)] = These1 <$> liftParseJSON px pl a <*> liftParseJSON px pl b@@ -2436,15 +2373,12 @@                 <$> parseJSONElemAtIndex pA 0 t                 <*> parseJSONElemAtIndex pB 1 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 2"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a) => FromJSON1 ((,) a) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b) => FromJSON (a, b) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a) => FromJSON2 ((,,) a) where@@ -2456,15 +2390,12 @@                 <*> parseJSONElemAtIndex pB 1 t                 <*> parseJSONElemAtIndex pC 2 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 3"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b) => FromJSON1 ((,,) a b) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a, b, c) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b) => FromJSON2 ((,,,) a b) where@@ -2477,15 +2408,12 @@                 <*> parseJSONElemAtIndex pC 2 t                 <*> parseJSONElemAtIndex pD 3 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 4"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON1 ((,,,) a b c) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a, b, c, d) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON2 ((,,,,) a b c) where@@ -2499,15 +2427,12 @@                 <*> parseJSONElemAtIndex pD 3 t                 <*> parseJSONElemAtIndex pE 4 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 5"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON1 ((,,,,) a b c d) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON (a, b, c, d, e) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON2 ((,,,,,) a b c d) where@@ -2522,15 +2447,12 @@                 <*> parseJSONElemAtIndex pE 4 t                 <*> parseJSONElemAtIndex pF 5 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 6"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON1 ((,,,,,) a b c d e) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON (a, b, c, d, e, f) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e) => FromJSON2 ((,,,,,,) a b c d e) where@@ -2546,15 +2468,12 @@                 <*> parseJSONElemAtIndex pF 5 t                 <*> parseJSONElemAtIndex pG 6 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 7"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON1 ((,,,,,,) a b c d e f) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON (a, b, c, d, e, f, g) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f) => FromJSON2 ((,,,,,,,) a b c d e f) where@@ -2571,15 +2490,12 @@                 <*> parseJSONElemAtIndex pG 6 t                 <*> parseJSONElemAtIndex pH 7 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 8"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON1 ((,,,,,,,) a b c d e f g) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON (a, b, c, d, e, f, g, h) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g) => FromJSON2 ((,,,,,,,,) a b c d e f g) where@@ -2597,15 +2513,12 @@                 <*> parseJSONElemAtIndex pH 7 t                 <*> parseJSONElemAtIndex pI 8 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 9"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON1 ((,,,,,,,,) a b c d e f g h) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON (a, b, c, d, e, f, g, h, i) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h) => FromJSON2 ((,,,,,,,,,) a b c d e f g h) where@@ -2624,15 +2537,12 @@                 <*> parseJSONElemAtIndex pI 8 t                 <*> parseJSONElemAtIndex pJ 9 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 10"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON1 ((,,,,,,,,,) a b c d e f g h i) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON (a, b, c, d, e, f, g, h, i, j) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i) => FromJSON2 ((,,,,,,,,,,) a b c d e f g h i) where@@ -2652,15 +2562,12 @@                 <*> parseJSONElemAtIndex pJ 9 t                 <*> parseJSONElemAtIndex pK 10 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 11"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON (a, b, c, d, e, f, g, h, i, j, k) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j) => FromJSON2 ((,,,,,,,,,,,) a b c d e f g h i j) where@@ -2681,15 +2588,12 @@                 <*> parseJSONElemAtIndex pK 10 t                 <*> parseJSONElemAtIndex pL 11 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 12"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k) => FromJSON2 ((,,,,,,,,,,,,) a b c d e f g h i j k) where@@ -2711,15 +2615,12 @@                 <*> parseJSONElemAtIndex pL 11 t                 <*> parseJSONElemAtIndex pM 12 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 13"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l) => FromJSON2 ((,,,,,,,,,,,,,) a b c d e f g h i j k l) where@@ -2742,15 +2643,12 @@                 <*> parseJSONElemAtIndex pM 12 t                 <*> parseJSONElemAtIndex pN 13 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 14"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}   instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m) => FromJSON2 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m) where@@ -2774,12 +2672,9 @@                 <*> parseJSONElemAtIndex pN 13 t                 <*> parseJSONElemAtIndex pO 14 t             else fail $ "cannot unpack array of length " ++ show n ++ " into a tuple of length 15"-    {-# INLINE liftParseJSON2 #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n) => FromJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where     liftParseJSON = liftParseJSON2 parseJSON parseJSONList-    {-# INLINE liftParseJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e, FromJSON f, FromJSON g, FromJSON h, FromJSON i, FromJSON j, FromJSON k, FromJSON l, FromJSON m, FromJSON n, FromJSON o) => FromJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where     parseJSON = parseJSON2-    {-# INLINE parseJSON #-}

@@ -10,8 +10,6 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#include "overlapping-compat.h"- -- | -- Module:      Data.Aeson.Types.Generic -- Copyright:   (c) 2012-2016 Bryan O'Sullivan@@ -47,11 +45,7 @@ class IsRecord (f :: * -> *) isRecord | f -> isRecord  instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord-#if MIN_VERSION_base(4,9,0)-instance OVERLAPPING_ IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False-#else-instance OVERLAPPING_ IsRecord (M1 S NoSelector f) False-#endif+instance {-# OVERLAPPING #-} IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord instance IsRecord (K1 i c) True instance IsRecord Par1 True

@@ -29,6 +29,7 @@     (     -- * Core JSON types       Value(..)+    , Key     , Array     , emptyArray, isEmptyArray     , Pair@@ -86,16 +87,14 @@ import Prelude.Compat  import Control.Applicative (Alternative(..))-import Control.Arrow (first) import Control.DeepSeq (NFData(..)) import Control.Monad (MonadPlus(..), ap) import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)+import Data.Aeson.Key (Key) import Data.Data (Data) import Data.Foldable (foldl')-import Data.HashMap.Strict (HashMap) import Data.Hashable (Hashable(..))-import Data.List (intercalate, sortBy)-import Data.Ord (comparing)+import Data.List (intercalate) import Data.Scientific (Scientific) import Data.String (IsString(..)) import Data.Text (Text, pack, unpack)@@ -104,16 +103,17 @@ import Data.Typeable (Typeable) import Data.Vector (Vector) import GHC.Generics (Generic)+import Data.Aeson.KeyMap (KeyMap) import qualified Control.Monad as Monad import qualified Control.Monad.Fail as Fail-import qualified Data.HashMap.Strict as H-import qualified Data.Scientific as S import qualified Data.Vector as V import qualified Language.Haskell.TH.Syntax as TH+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KM  -- | Elements of a JSON path used to describe the location of an -- error.-data JSONPathElement = Key Text+data JSONPathElement = Key Key                        -- ^ JSON path element of a key into an object,                        -- \"object.key\".                      | Index {-# UNPACK #-} !Int@@ -351,7 +351,7 @@ {-# INLINE apP #-}  -- | A JSON \"object\" (key\/value map).-type Object = HashMap Text Value+type Object = KeyMap Value  -- | A JSON \"array\" (sequence). type Array = Vector Value@@ -385,7 +385,7 @@         $ showString "Array " . showsPrec 11 xs     showsPrec d (Object xs) = showParen (d > 10)         $ showString "Object (fromList "-        . showsPrec 11 (sortBy (comparing fst) (H.toList xs))+        . showsPrec 11 (KM.toAscList xs)         . showChar ')'  -- |@@ -436,20 +436,17 @@ instance Hashable Value where     hashWithSalt = hashValue --- @since 0.11.0.0+-- | @since 0.11.0.0 instance TH.Lift Value where-    lift Null = [| Null |]-    lift (Bool b) = [| Bool b |]-    lift (Number n) = [| Number (S.scientific c e) |]-      where-        c = S.coefficient n-        e = S.base10Exponent n+    lift Null       = [| Null |]+    lift (Bool b)   = [| Bool b |]+    lift (Number n) = [| Number n |]     lift (String t) = [| String (pack s) |]       where s = unpack t-    lift (Array a) = [| Array (V.fromList a') |]+    lift (Array a)  = [| Array (V.fromList a') |]       where a' = V.toList a-    lift (Object o) = [| Object (H.fromList . map (first pack) $ o') |]-      where o' = map (first unpack) . H.toList $ o+    lift (Object o) = [| Object o |]+ #if MIN_VERSION_template_haskell(2,17,0)     liftTyped = TH.unsafeCodeCoerce . TH.lift #elif MIN_VERSION_template_haskell(2,16,0)@@ -468,7 +465,7 @@  -- | The empty object. emptyObject :: Value-emptyObject = Object H.empty+emptyObject = Object KM.empty  -- | Run a 'Parser'. parse :: (a -> Parser b) -> a -> Result b@@ -512,11 +509,11 @@     format pfx (Index idx:parts) = format (pfx ++ "[" ++ show idx ++ "]") parts     format pfx (Key key:parts)   = format (pfx ++ formatKey key) parts -    formatKey :: Text -> String+    formatKey :: Key -> String     formatKey key        | isIdentifierKey strKey = "." ++ strKey        | otherwise              = "['" ++ escapeKey strKey ++ "']"-      where strKey = unpack key+      where strKey = Key.toString key      isIdentifierKey :: String -> Bool     isIdentifierKey []     = False@@ -531,12 +528,12 @@     escapeChar c    = [c]  -- | A key\/value pair for an 'Object'.-type Pair = (Text, Value)+type Pair = (Key, Value)  -- | Create a 'Value' from a list of name\/value 'Pair's.  If duplicate--- keys arise, earlier keys and their associated values win.+-- keys arise, later keys and their associated values win. object :: [Pair] -> Value-object = Object . H.fromList+object = Object . KM.fromList {-# INLINE object #-}  -- | Add JSON Path context to a parser

@@ -14,9 +14,6 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#include "overlapping-compat.h"-#include "incoherent-compat.h"- -- TODO: Drop this when we remove support for Data.Attoparsec.Number {-# OPTIONS_GHC -fno-warn-deprecations #-} @@ -42,6 +39,7 @@     , ToJSONKey(..)     , ToJSONKeyFunction(..)     , toJSONKeyText+    , toJSONKeyKey     , contramapToJSONKeyFunction      , GToJSONKey()@@ -63,9 +61,11 @@ import Control.Monad.ST (ST) import Data.Aeson.Encoding (Encoding, Encoding', Series, dict, emptyArray_) import Data.Aeson.Encoding.Internal ((>*<))-import Data.Aeson.Internal.Functions (mapHashKeyVal, mapKeyVal)+import Data.Aeson.Internal.Functions (mapKeyVal, mapKeyValO) import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize) import Data.Aeson.Types.Internal+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as TM import Data.Attoparsec.Number (Number(..)) import Data.Bits (unsafeShiftR) import Data.DList (DList)@@ -102,10 +102,10 @@ import GHC.Generics import Numeric.Natural (Natural) import qualified Data.Aeson.Encoding as E-import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding)+import qualified Data.Aeson.Encoding.Internal as E (InArray, comma, econcat, retagEncoding, key) import qualified Data.ByteString.Lazy as L import qualified Data.DList as DList-#if MIN_VERSION_dlist(1,0,0) && __GLASGOW_HASKELL__ >=800+#if MIN_VERSION_dlist(1,0,0) import qualified Data.DList.DNonEmpty as DNE #endif import qualified Data.Fix as F@@ -144,13 +144,12 @@  toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)-{-# INLINE toJSONPair #-}  realFloatToJSON :: RealFloat a => a -> Value realFloatToJSON d-    | isNaN d || isInfinite d = Null-    | otherwise = Number $ Scientific.fromFloatDigits d-{-# INLINE realFloatToJSON #-}+    | isNaN d      = Null+    | isInfinite d = if d > 0 then "+inf" else "-inf"+    | otherwise    = Number $ Scientific.fromFloatDigits d  ------------------------------------------------------------------------------- -- Generics@@ -313,15 +312,12 @@      toEncoding :: a -> Encoding     toEncoding = E.value . toJSON-    {-# INLINE toEncoding #-}      toJSONList :: [a] -> Value     toJSONList = listValue toJSON-    {-# INLINE toJSONList #-}      toEncodingList :: [a] -> Encoding     toEncodingList = listEncoding toEncoding-    {-# INLINE toEncodingList #-}  ------------------------------------------------------------------------------- -- Object key-value pairs@@ -329,7 +325,7 @@  -- | A key-value pair for encoding a JSON object. class KeyValue kv where-    (.=) :: ToJSON v => Text -> v -> kv+    (.=) :: ToJSON v => Key -> v -> kv     infixr 8 .=  instance KeyValue Series where@@ -340,11 +336,11 @@     name .= value = (name, toJSON value)     {-# INLINE (.=) #-} --- | Constructs a singleton 'H.HashMap'. For calling functions that+-- | Constructs a singleton 'TM.KeyMap'. For calling functions that --   demand an 'Object' for constructing objects. To be used in --   conjunction with 'mconcat'. Prefer to use 'object' where possible. instance KeyValue Object where-    name .= value = H.singleton name (toJSON value)+    name .= value = TM.singleton name (toJSON value)     {-# INLINE (.=) #-}  -------------------------------------------------------------------------------@@ -482,7 +478,7 @@     toJSONKeyList = ToJSONKeyValue toJSON toEncoding  data ToJSONKeyFunction a-    = ToJSONKeyText !(a -> Text) !(a -> Encoding' Text)+    = ToJSONKeyText !(a -> Key) !(a -> Encoding' Key)       -- ^ key is encoded to string, produces object     | ToJSONKeyValue !(a -> Value) !(a -> Encoding)       -- ^ key is encoded to value, produces array@@ -496,14 +492,21 @@ --         myKeyToText = Text.pack . show -- or showt from text-show -- @ toJSONKeyText :: (a -> Text) -> ToJSONKeyFunction a-toJSONKeyText f = ToJSONKeyText f (E.text . f)+toJSONKeyText f = toJSONKeyKey (Key.fromText . f) +-- |+--+-- @since 2.0.0.0+toJSONKeyKey :: (a -> Key) -> ToJSONKeyFunction a+toJSONKeyKey f = ToJSONKeyText f (E.key . f)+ -- | TODO: should this be exported?-toJSONKeyTextEnc :: (a -> Encoding' Text) -> ToJSONKeyFunction a+toJSONKeyTextEnc :: (a -> Encoding' Key) -> ToJSONKeyFunction a toJSONKeyTextEnc e = ToJSONKeyText tot e  where     -- TODO: dropAround is also used in stringEncoding, which is unfortunate atm-    tot = T.dropAround (== '"')+    tot = Key.fromText+        . T.dropAround (== '"')         . T.decodeLatin1         . L.toStrict         . E.encodingToLazyByteString@@ -536,7 +539,7 @@ -- @ genericToJSONKey :: (Generic a, GToJSONKey (Rep a))            => JSONKeyOptions -> ToJSONKeyFunction a-genericToJSONKey opts = toJSONKeyText (pack . keyModifier opts . getConName . from)+genericToJSONKey opts = toJSONKeyKey (Key.fromString . keyModifier opts . getConName . from)  class    GetConName f => GToJSONKey f instance GetConName f => GToJSONKey f@@ -681,10 +684,8 @@  instance ToJSON1 [] where     liftToJSON _ to' = to'-    {-# INLINE liftToJSON #-}      liftToEncoding _ to' = to'-    {-# INLINE liftToEncoding #-}  instance (ToJSON a) => ToJSON [a] where     {-# SPECIALIZE instance ToJSON String #-}@@ -693,16 +694,14 @@     {-# SPECIALIZE instance ToJSON [Object] #-}      toJSON = toJSON1-    {-# INLINE toJSON #-}      toEncoding = toEncoding1-    {-# INLINE toEncoding #-}  ------------------------------------------------------------------------------- -- Generic toJSON / toEncoding ------------------------------------------------------------------------------- -instance OVERLAPPABLE_ (GToJSON' enc arity a) => GToJSON' enc arity (M1 i c a) where+instance {-# OVERLAPPABLE #-} (GToJSON' enc arity a) => GToJSON' enc arity (M1 i c a) where     -- Meta-information, which is not handled elsewhere, is ignored:     gToJSON opts targs = gToJSON opts targs . unM1     {-# INLINE gToJSON #-}@@ -860,6 +859,7 @@         | allNullaryToStringTag opts = Tagged . fromString                                      . constructorTagModifier opts . getConName         | otherwise = Tagged . nonAllNullarySumToJSON opts targs+    {-# INLINE sumToJSON #-}  instance ( TaggedObject                     enc arity f          , SumToJSON' ObjectWithSingleField enc arity f@@ -868,6 +868,7 @@          ) => SumToJSON enc arity f False   where     sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs+    {-# INLINE sumToJSON #-}  nonAllNullarySumToJSON :: ( TaggedObject                     enc arity f                           , SumToJSON' ObjectWithSingleField enc arity f@@ -879,7 +880,7 @@     case sumEncoding opts of        TaggedObject{..}      ->-        taggedObject opts targs tagFieldName contentsFieldName+        taggedObject opts targs (Key.fromString tagFieldName) (Key.fromString contentsFieldName)        ObjectWithSingleField ->         (unTagged :: Tagged ObjectWithSingleField enc -> enc)@@ -892,6 +893,7 @@       UntaggedValue         ->         (unTagged :: Tagged UntaggedValue enc -> enc)           . sumToJSON' opts targs+{-# INLINE nonAllNullarySumToJSON #-}  -------------------------------------------------------------------------------- @@ -908,7 +910,7 @@  class TaggedObject enc arity f where     taggedObject :: Options -> ToArgs enc arity a-                 -> String -> String+                 -> Key -> Key                  -> f a -> enc  instance ( TaggedObject enc arity a@@ -919,6 +921,7 @@         taggedObject opts targs tagFieldName contentsFieldName x     taggedObject opts targs tagFieldName contentsFieldName (R1 x) =         taggedObject opts targs tagFieldName contentsFieldName x+    {-# INLINE taggedObject #-}  instance ( IsRecord                      a isRecord          , TaggedObject' enc pairs arity a isRecord@@ -937,10 +940,11 @@         contents =           (unTagged :: Tagged isRecord pairs -> pairs) .             taggedObject' opts targs contentsFieldName . unM1+    {-# INLINE taggedObject #-}  class TaggedObject' enc pairs arity f isRecord where     taggedObject' :: Options -> ToArgs enc arity a-                  -> String -> f a -> Tagged isRecord pairs+                  -> Key -> f a -> Tagged isRecord pairs  instance ( GToJSON' enc arity f          , KeyValuePair enc pairs@@ -948,14 +952,17 @@   where     taggedObject' opts targs contentsFieldName =         Tagged . (contentsFieldName `pair`) . gToJSON opts targs+    {-# INLINE taggedObject' #-} -instance OVERLAPPING_ Monoid pairs => TaggedObject' enc pairs arity U1 False where+instance {-# OVERLAPPING #-} Monoid pairs => TaggedObject' enc pairs arity U1 False where     taggedObject' _ _ _ _ = Tagged mempty+    {-# INLINE taggedObject' #-}  instance ( RecordToPairs enc pairs arity f          ) => TaggedObject' enc pairs arity f True   where     taggedObject' opts targs _ = Tagged . recordToPairs opts targs+    {-# INLINE taggedObject' #-}  -------------------------------------------------------------------------------- @@ -966,13 +973,16 @@ instance (GetConName a, GetConName b) => GetConName (a :+: b) where     getConName (L1 x) = getConName x     getConName (R1 x) = getConName x+    {-# INLINE getConName #-}  instance (Constructor c) => GetConName (C1 c a) where     getConName = conName+    {-# INLINE getConName #-}  -- For genericToJSONKey instance GetConName a => GetConName (D1 d a) where     getConName (M1 x) = getConName x+    {-# INLINE getConName #-}  -------------------------------------------------------------------------------- @@ -994,6 +1004,7 @@   where     sumToJSON' opts targs (L1 x) = sumToJSON' opts targs x     sumToJSON' opts targs (R1 x) = sumToJSON' opts targs x+    {-# INLINE sumToJSON' #-}  -------------------------------------------------------------------------------- @@ -1007,6 +1018,7 @@                                    $ conName (undefined :: t c a p)       VM.unsafeWrite mv 1 $ gToJSON opts targs x       return mv+    {-# INLINE sumToJSON' #-}  -------------------------------------------------------------------------------- @@ -1019,6 +1031,7 @@       [ toEncoding (constructorTagModifier opts (conName (undefined :: t c a p)))       , gToJSON opts targs x       ]+    {-# INLINE sumToJSON' #-}  -------------------------------------------------------------------------------- @@ -1039,7 +1052,7 @@       . consToJSON' opts targs     {-# INLINE consToJSON #-} -instance OVERLAPPING_+instance {-# OVERLAPPING #-}          ( RecordToPairs enc pairs arity (S1 s f)          , FromPairs enc pairs          , GToJSON' enc arity f@@ -1090,7 +1103,7 @@     recordToPairs = fieldToPair     {-# INLINE recordToPairs #-} -instance INCOHERENT_+instance {-# INCOHERENT #-}     ( Selector s     , GToJSON' enc arity (K1 i (Maybe a))     , KeyValuePair enc pairs@@ -1102,7 +1115,8 @@     recordToPairs opts targs m1 = fieldToPair opts targs m1     {-# INLINE recordToPairs #-} -instance INCOHERENT_+#if !MIN_VERSION_base(4,16,0)+instance {-# INCOHERENT #-}     ( Selector s     , GToJSON' enc arity (K1 i (Maybe a))     , KeyValuePair enc pairs@@ -1114,6 +1128,7 @@         unwrap :: S1 s (K1 i (Semigroup.Option a)) p -> S1 s (K1 i (Maybe a)) p         unwrap (M1 (K1 (Semigroup.Option a))) = M1 (K1 a)     {-# INLINE recordToPairs #-}+#endif  fieldToPair :: (Selector s                , GToJSON' enc arity a@@ -1121,7 +1136,7 @@             => Options -> ToArgs enc arity p             -> S1 s a p -> pairs fieldToPair opts targs m1 =-  let key   = fieldLabelModifier opts (selName m1)+  let key   = Key.fromString $ fieldLabelModifier opts (selName m1)       value = gToJSON opts targs (unM1 m1)   in key `pair` value {-# INLINE fieldToPair #-}@@ -1149,7 +1164,7 @@           ixR  = ix  + lenL     {-# INLINE writeProduct #-} -instance OVERLAPPABLE_ (GToJSON' Value arity a) => WriteProduct arity a where+instance {-# OVERLAPPABLE #-} (GToJSON' Value arity a) => WriteProduct arity a where     writeProduct opts targs mv ix _ =       VM.unsafeWrite mv ix . gToJSON opts targs     {-# INLINE writeProduct #-}@@ -1172,7 +1187,7 @@       encodeProduct opts targs b     {-# INLINE encodeProduct #-} -instance OVERLAPPABLE_ (GToJSON' Encoding arity a) => EncodeProduct arity a where+instance {-# OVERLAPPABLE #-} (GToJSON' Encoding arity a) => EncodeProduct arity a where     encodeProduct opts targs a = E.retagEncoding $ gToJSON opts targs a     {-# INLINE encodeProduct #-} @@ -1188,24 +1203,27 @@     sumToJSON' opts targs =       Tagged . fromPairs . (typ `pair`) . gToJSON opts targs         where-          typ = constructorTagModifier opts $+          typ = Key.fromString $ constructorTagModifier opts $                          conName (undefined :: t c a p)+    {-# INLINE sumToJSON' #-}  -------------------------------------------------------------------------------- -instance OVERLAPPABLE_+instance {-# OVERLAPPABLE #-}     ( ConsToJSON enc arity a     ) => SumToJSON' UntaggedValue enc arity (C1 c a)   where     sumToJSON' opts targs = Tagged . gToJSON opts targs+    {-# INLINE sumToJSON' #-} -instance OVERLAPPING_+instance {-# OVERLAPPING #-}     ( Constructor c     , FromString enc     ) => SumToJSON' UntaggedValue enc arity (C1 c U1)   where     sumToJSON' opts _ _ = Tagged . fromString $         constructorTagModifier opts $ conName (undefined :: t c U1 p)+    {-# INLINE sumToJSON' #-}  ------------------------------------------------------------------------------- -- Instances@@ -1217,24 +1235,15 @@  instance ToJSON2 Const where     liftToJSON2 t _ _ _ (Const x) = t x-    {-# INLINE liftToJSON2 #-}-     liftToEncoding2 t _ _ _ (Const x) = t x-    {-# INLINE liftToEncoding2 #-}  instance ToJSON a => ToJSON1 (Const a) where     liftToJSON _ _ (Const x) = toJSON x-    {-# INLINE liftToJSON #-}-     liftToEncoding _ _ (Const x) = toEncoding x-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (Const a b) where     toJSON (Const x) = toJSON x-    {-# INLINE toJSON #-}-     toEncoding (Const x) = toEncoding x-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSONKey a) => ToJSONKey (Const a b) where     toJSONKey = contramap getConst toJSONKey@@ -1243,58 +1252,37 @@ instance ToJSON1 Maybe where     liftToJSON t _ (Just a) = t a     liftToJSON _  _ Nothing  = Null-    {-# INLINE liftToJSON #-}      liftToEncoding t _ (Just a) = t a     liftToEncoding _  _ Nothing  = E.null_-    {-# INLINE liftToEncoding #-}  instance (ToJSON a) => ToJSON (Maybe a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSON2 Either where-    liftToJSON2  toA _ _toB _ (Left a)  = Object $ H.singleton "Left"  (toA a)-    liftToJSON2 _toA _  toB _ (Right b) = Object $ H.singleton "Right" (toB b)-    {-# INLINE liftToJSON2 #-}+    liftToJSON2  toA _ _toB _ (Left a)  = Object $ TM.singleton "Left"  (toA a)+    liftToJSON2 _toA _  toB _ (Right b) = Object $ TM.singleton "Right" (toB b)      liftToEncoding2  toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a-     liftToEncoding2 _toA _ toB _ (Right b) = E.pairs $ E.pair "Right" $ toB b-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a) => ToJSON1 (Either a) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}-     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where     toJSON = toJSON2-    {-# INLINE toJSON #-}-     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance ToJSON Void where     toJSON = absurd-    {-# INLINE toJSON #-}-     toEncoding = absurd-    {-# INLINE toEncoding #-} - instance ToJSON Bool where     toJSON = Bool-    {-# INLINE toJSON #-}-     toEncoding = E.bool-    {-# INLINE toEncoding #-}  instance ToJSONKey Bool where     toJSONKey = toJSONKeyText $ \x -> if x then "true" else "false"@@ -1312,265 +1300,178 @@  instance ToJSON () where     toJSON _ = emptyArray-    {-# INLINE toJSON #-}-     toEncoding _ = emptyArray_-    {-# INLINE toEncoding #-}   instance ToJSON Char where     toJSON = String . T.singleton-    {-# INLINE toJSON #-}-     toJSONList = String . T.pack-    {-# INLINE toJSONList #-}      toEncoding = E.string . (:[])-    {-# INLINE toEncoding #-}-     toEncodingList = E.string-    {-# INLINE toEncodingList #-}   instance ToJSON Double where     toJSON = realFloatToJSON-    {-# INLINE toJSON #-}-     toEncoding = E.double-    {-# INLINE toEncoding #-}  instance ToJSONKey Double where     toJSONKey = toJSONKeyTextEnc E.doubleText-    {-# INLINE toJSONKey #-}   instance ToJSON Number where     toJSON (D d) = toJSON d     toJSON (I i) = toJSON i-    {-# INLINE toJSON #-}      toEncoding (D d) = toEncoding d     toEncoding (I i) = toEncoding i-    {-# INLINE toEncoding #-}   instance ToJSON Float where     toJSON = realFloatToJSON-    {-# INLINE toJSON #-}-     toEncoding = E.float-    {-# INLINE toEncoding #-}  instance ToJSONKey Float where     toJSONKey = toJSONKeyTextEnc E.floatText-    {-# INLINE toJSONKey #-}   instance (ToJSON a, Integral a) => ToJSON (Ratio a) where     toJSON r = object [ "numerator"   .= numerator   r                       , "denominator" .= denominator r                       ]-    {-# INLINE toJSON #-}      toEncoding r = E.pairs $         "numerator" .= numerator r <>         "denominator" .= denominator r-    {-# INLINE toEncoding #-}   instance HasResolution a => ToJSON (Fixed a) where     toJSON = Number . realToFrac-    {-# INLINE toJSON #-}-     toEncoding = E.scientific . realToFrac-    {-# INLINE toEncoding #-}  instance HasResolution a => ToJSONKey (Fixed a) where     toJSONKey = toJSONKeyTextEnc (E.scientificText . realToFrac)-    {-# INLINE toJSONKey #-} - instance ToJSON Int where     toJSON = Number . fromIntegral-    {-# INLINE toJSON #-}-     toEncoding = E.int-    {-# INLINE toEncoding #-}  instance ToJSONKey Int where     toJSONKey = toJSONKeyTextEnc E.intText-    {-# INLINE toJSONKey #-}   instance ToJSON Integer where     toJSON = Number . fromInteger-    {-# INLINE toJSON #-}-     toEncoding = E.integer-    {-# INLINE toEncoding #-}  instance ToJSONKey Integer where     toJSONKey = toJSONKeyTextEnc E.integerText-    {-# INLINE toJSONKey #-}   instance ToJSON Natural where     toJSON = toJSON . toInteger-    {-# INLINE toJSON #-}-     toEncoding = toEncoding . toInteger-    {-# INLINE toEncoding #-}  instance ToJSONKey Natural where     toJSONKey = toJSONKeyTextEnc (E.integerText . toInteger)-    {-# INLINE toJSONKey #-}   instance ToJSON Int8 where     toJSON = Number . fromIntegral-    {-# INLINE toJSON #-}-     toEncoding = E.int8-    {-# INLINE toEncoding #-}  instance ToJSONKey Int8 where     toJSONKey = toJSONKeyTextEnc E.int8Text-    {-# INLINE toJSONKey #-}   instance ToJSON Int16 where     toJSON = Number . fromIntegral-    {-# INLINE toJSON #-}-     toEncoding = E.int16-    {-# INLINE toEncoding #-}  instance ToJSONKey Int16 where     toJSONKey = toJSONKeyTextEnc E.int16Text-    {-# INLINE toJSONKey #-}   instance ToJSON Int32 where     toJSON = Number . fromIntegral-    {-# INLINE toJSON #-}-     toEncoding = E.int32-    {-# INLINE toEncoding #-}  instance ToJSONKey Int32 where     toJSONKey = toJSONKeyTextEnc E.int32Text-    {-# INLINE toJSONKey #-}   instance ToJSON Int64 where     toJSON = Number . fromIntegral-    {-# INLINE toJSON #-}-     toEncoding = E.int64-    {-# INLINE toEncoding #-}  instance ToJSONKey Int64 where     toJSONKey = toJSONKeyTextEnc E.int64Text-    {-# INLINE toJSONKey #-}  instance ToJSON Word where     toJSON = Number . fromIntegral-    {-# INLINE toJSON #-}-     toEncoding = E.word-    {-# INLINE toEncoding #-}  instance ToJSONKey Word where     toJSONKey = toJSONKeyTextEnc E.wordText-    {-# INLINE toJSONKey #-}   instance ToJSON Word8 where     toJSON = Number . fromIntegral-    {-# INLINE toJSON #-}-     toEncoding = E.word8-    {-# INLINE toEncoding #-}  instance ToJSONKey Word8 where     toJSONKey = toJSONKeyTextEnc E.word8Text-    {-# INLINE toJSONKey #-}   instance ToJSON Word16 where     toJSON = Number . fromIntegral-    {-# INLINE toJSON #-}-     toEncoding = E.word16-    {-# INLINE toEncoding #-}  instance ToJSONKey Word16 where     toJSONKey = toJSONKeyTextEnc E.word16Text-    {-# INLINE toJSONKey #-}   instance ToJSON Word32 where     toJSON = Number . fromIntegral-    {-# INLINE toJSON #-}-     toEncoding = E.word32-    {-# INLINE toEncoding #-}  instance ToJSONKey Word32 where     toJSONKey = toJSONKeyTextEnc E.word32Text-    {-# INLINE toJSONKey #-}   instance ToJSON Word64 where     toJSON = Number . fromIntegral-    {-# INLINE toJSON #-}-     toEncoding = E.word64-    {-# INLINE toEncoding #-}  instance ToJSONKey Word64 where     toJSONKey = toJSONKeyTextEnc E.word64Text-    {-# INLINE toJSONKey #-}  instance ToJSON CTime where     toJSON (CTime i) = toJSON i-    {-# INLINE toJSON #-}-     toEncoding (CTime i) = toEncoding i-    {-# INLINE toEncoding #-}  instance ToJSON Text where     toJSON = String-    {-# INLINE toJSON #-}-     toEncoding = E.text-    {-# INLINE toEncoding #-}  instance ToJSONKey Text where     toJSONKey = toJSONKeyText id-    {-# INLINE toJSONKey #-}   instance ToJSON LT.Text where     toJSON = String . LT.toStrict-    {-# INLINE toJSON #-}-     toEncoding = E.lazyText-    {-# INLINE toEncoding #-}  instance ToJSONKey LT.Text where-    toJSONKey = toJSONKeyText LT.toStrict+    toJSONKey = toJSONKeyText (LT.toStrict)   instance ToJSON Version where     toJSON = toJSON . showVersion-    {-# INLINE toJSON #-}-     toEncoding = toEncoding . showVersion-    {-# INLINE toEncoding #-}  instance ToJSONKey Version where-    toJSONKey = toJSONKeyText (T.pack . showVersion)+    toJSONKey = toJSONKeyKey (Key.fromString . showVersion)  ------------------------------------------------------------------------------- -- semigroups NonEmpty@@ -1578,17 +1479,11 @@  instance ToJSON1 NonEmpty where     liftToJSON t _ = listValue t . NE.toList-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ = listEncoding t . NE.toList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a) => ToJSON (NonEmpty a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}  ------------------------------------------------------------------------------- -- scientific@@ -1596,10 +1491,7 @@  instance ToJSON Scientific where     toJSON = Number-    {-# INLINE toJSON #-}-     toEncoding = E.scientific-    {-# INLINE toEncoding #-}  instance ToJSONKey Scientific where     toJSONKey = toJSONKeyTextEnc E.scientificText@@ -1610,34 +1502,22 @@  instance ToJSON1 DList.DList where     liftToJSON t _ = listValue t . toList-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ = listEncoding t . toList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a) => ToJSON (DList.DList a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-} -#if MIN_VERSION_dlist(1,0,0) && __GLASGOW_HASKELL__ >=800+#if MIN_VERSION_dlist(1,0,0) -- | @since 1.5.3.0 instance ToJSON1 DNE.DNonEmpty where     liftToJSON t _ = listValue t . DNE.toList-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ = listEncoding t . DNE.toList-    {-# INLINE liftToEncoding #-}  -- | @since 1.5.3.0 instance (ToJSON a) => ToJSON (DNE.DNonEmpty a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-} #endif  -------------------------------------------------------------------------------@@ -1646,29 +1526,17 @@  instance ToJSON1 Identity where     liftToJSON t _ (Identity a) = t a-    {-# INLINE liftToJSON #-}-     liftToJSONList _ tl xs = tl (map runIdentity xs)-    {-# INLINE liftToJSONList #-}      liftToEncoding t _ (Identity a) = t a-    {-# INLINE liftToEncoding #-}-     liftToEncodingList _ tl xs = tl (map runIdentity xs)-    {-# INLINE liftToEncodingList #-}  instance (ToJSON a) => ToJSON (Identity a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toJSONList = liftToJSONList toJSON toJSONList-    {-# INLINE toJSONList #-}      toEncoding = toEncoding1-    {-# INLINE toEncoding #-}-     toEncodingList = liftToEncodingList toEncoding toEncodingList-    {-# INLINE toEncodingList #-}  instance (ToJSONKey a) => ToJSONKey (Identity a) where     toJSONKey = contramapToJSONKeyFunction runIdentity toJSONKey@@ -1680,38 +1548,27 @@       where         g = liftToJSON tv tvl         gl = liftToJSONList tv tvl-    {-# INLINE liftToJSON #-}      liftToJSONList te tel xs = liftToJSONList g gl (map getCompose xs)       where         g = liftToJSON te tel         gl = liftToJSONList te tel-    {-# INLINE liftToJSONList #-}      liftToEncoding te tel (Compose x) = liftToEncoding g gl x       where         g = liftToEncoding te tel         gl = liftToEncodingList te tel-    {-# INLINE liftToEncoding #-}      liftToEncodingList te tel xs = liftToEncodingList g gl (map getCompose xs)       where         g = liftToEncoding te tel         gl = liftToEncodingList te tel-    {-# INLINE liftToEncodingList #-}  instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toJSONList = liftToJSONList toJSON toJSONList-    {-# INLINE toJSONList #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}-     toEncodingList = liftToEncodingList toEncoding toEncodingList-    {-# INLINE toEncodingList #-}   instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Product f g) where@@ -1731,24 +1588,18 @@  instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}  instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Sum f g) where-    liftToJSON tv tvl (InL x) = Object $ H.singleton "InL" (liftToJSON tv tvl x)-    liftToJSON tv tvl (InR y) = Object $ H.singleton "InR" (liftToJSON tv tvl y)+    liftToJSON tv tvl (InL x) = Object $ TM.singleton "InL" (liftToJSON tv tvl x)+    liftToJSON tv tvl (InR y) = Object $ TM.singleton "InR" (liftToJSON tv tvl y)      liftToEncoding te tel (InL x) = E.pairs $ E.pair "InL" $ liftToEncoding te tel x     liftToEncoding te tel (InR y) = E.pairs $ E.pair "InR" $ liftToEncoding te tel y  instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}  ------------------------------------------------------------------------------- -- containers@@ -1756,83 +1607,57 @@  instance ToJSON1 Seq.Seq where     liftToJSON t _ = listValue t . toList-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ = listEncoding t . toList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a) => ToJSON (Seq.Seq a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSON1 Set.Set where     liftToJSON t _ = listValue t . Set.toList-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ = listEncoding t . Set.toList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a) => ToJSON (Set.Set a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSON IntSet.IntSet where     toJSON = toJSON . IntSet.toList-    {-# INLINE toJSON #-}-     toEncoding = toEncoding . IntSet.toList-    {-# INLINE toEncoding #-} - instance ToJSON1 IntMap.IntMap where     liftToJSON t tol = liftToJSON to' tol' . IntMap.toList       where         to'  = liftToJSON2     toJSON toJSONList t tol         tol' = liftToJSONList2 toJSON toJSONList t tol-    {-# INLINE liftToJSON #-}      liftToEncoding t tol = liftToEncoding to' tol' . IntMap.toList       where         to'  = liftToEncoding2     toEncoding toEncodingList t tol         tol' = liftToEncodingList2 toEncoding toEncodingList t tol-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (IntMap.IntMap a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSONKey k => ToJSON1 (M.Map k) where     liftToJSON g _ = case toJSONKey of-        ToJSONKeyText f _ -> Object . mapHashKeyVal f g+        ToJSONKeyText f _ -> Object . TM.fromMap . mapKeyValO f g         ToJSONKeyValue  f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList-    {-# INLINE liftToJSON #-}      liftToEncoding g _ = case toJSONKey of         ToJSONKeyText _ f -> dict f g M.foldrWithKey         ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . M.toList       where         pairEncoding f (a, b) = E.list id [f a, g b]-    {-# INLINE liftToEncoding #-}   instance (ToJSON v, ToJSONKey k) => ToJSON (M.Map k v) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSON1 Tree.Tree where@@ -1843,7 +1668,6 @@          to' = liftToJSON go (listValue go)         tol' = liftToJSONList go (listValue go)-    {-# INLINE liftToJSON #-}      liftToEncoding t tol = go       where@@ -1852,14 +1676,10 @@          to' = liftToEncoding go (listEncoding go)         tol' = liftToEncodingList go (listEncoding go)-    {-# INLINE liftToEncoding #-}  instance (ToJSON v) => ToJSON (Tree.Tree v) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}  ------------------------------------------------------------------------------- -- uuid@@ -1870,7 +1690,7 @@     toEncoding = E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes  instance ToJSONKey UUID.UUID where-    toJSONKey = ToJSONKeyText UUID.toText $+    toJSONKey = ToJSONKeyText (Key.fromText . UUID.toText) $         E.unsafeToEncoding . EB.quote . B.byteString . UUID.toASCIIBytes  -------------------------------------------------------------------------------@@ -1879,19 +1699,13 @@  instance ToJSON1 Vector where     liftToJSON t _ = Array . V.map t-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ =  listEncoding t . V.toList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a) => ToJSON (Vector a) where     {-# SPECIALIZE instance ToJSON Array #-}      toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}  encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding encodeVector = listEncoding toEncoding . VG.toList@@ -1903,26 +1717,17 @@  instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where     toJSON = vectorToJSON-    {-# INLINE toJSON #-}-     toEncoding = encodeVector-    {-# INLINE toEncoding #-}   instance (VP.Prim a, ToJSON a) => ToJSON (VP.Vector a) where     toJSON = vectorToJSON-    {-# INLINE toJSON #-}-     toEncoding = encodeVector-    {-# INLINE toEncoding #-}   instance (VG.Vector VU.Vector a, ToJSON a) => ToJSON (VU.Vector a) where     toJSON = vectorToJSON-    {-# INLINE toJSON #-}-     toEncoding = encodeVector-    {-# INLINE toEncoding #-}  ------------------------------------------------------------------------------- -- unordered-containers@@ -1930,52 +1735,58 @@  instance ToJSON1 HashSet.HashSet where     liftToJSON t _ = listValue t . HashSet.toList-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ = listEncoding t . HashSet.toList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a) => ToJSON (HashSet.HashSet a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSONKey k => ToJSON1 (H.HashMap k) where     liftToJSON g _ = case toJSONKey of-        ToJSONKeyText f _ -> Object . mapKeyVal f g-        ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList-    {-# INLINE liftToJSON #-}+        ToJSONKeyText f _ -> Object . TM.fromHashMap . mapKeyVal f g+        ToJSONKeyValue f _+          -> Array . V.fromList . map (toJSONPair f g) . H.toList -    -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> H.HashMap k a -> Encoding+    -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> TM.HashMap k a -> Encoding     liftToEncoding g _ = case toJSONKey of         ToJSONKeyText _ f -> dict f g H.foldrWithKey         ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList       where         pairEncoding f (a, b) = E.list id [f a, g b]-    {-# INLINE liftToEncoding #-}  instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where+    toJSON = toJSON1+    toEncoding = toEncoding1++-------------------------------------------------------------------------------+-- Data.Aeson.KeyMap+-------------------------------------------------------------------------------++instance ToJSON1 TM.KeyMap where+    liftToJSON g _ = Object . fmap g+    liftToEncoding g _ = dict E.key g TM.foldrWithKey++instance (ToJSON v) => ToJSON (TM.KeyMap v) where     {-# SPECIALIZE instance ToJSON Object #-}      toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}  ------------------------------------------------------------------------------- -- aeson ------------------------------------------------------------------------------- +instance ToJSON Key where+    toJSON = toJSON . Key.toText+    toEncoding = E.key++instance ToJSONKey Key where+    toJSONKey = ToJSONKeyText id E.key+ instance ToJSON Value where     toJSON a = a-    {-# INLINE toJSON #-}-     toEncoding = E.value-    {-# INLINE toEncoding #-}  instance ToJSON DotNetTime where     toJSON = toJSON . dotNetTime@@ -2075,18 +1886,12 @@  instance ToJSON NominalDiffTime where     toJSON = Number . realToFrac-    {-# INLINE toJSON #-}-     toEncoding = E.scientific . realToFrac-    {-# INLINE toEncoding #-}   instance ToJSON DiffTime where     toJSON = Number . realToFrac-    {-# INLINE toJSON #-}-     toEncoding = E.scientific . realToFrac-    {-# INLINE toEncoding #-}  -- | Encoded as number instance ToJSON SystemTime where@@ -2155,136 +1960,84 @@  instance ToJSON1 Monoid.Dual where     liftToJSON t _ = t . Monoid.getDual-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ = t . Monoid.getDual-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (Monoid.Dual a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSON1 Monoid.First where     liftToJSON t to' = liftToJSON t to' . Monoid.getFirst-    {-# INLINE liftToJSON #-}-     liftToEncoding t to' = liftToEncoding t to' . Monoid.getFirst-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (Monoid.First a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSON1 Monoid.Last where     liftToJSON t to' = liftToJSON t to' . Monoid.getLast-    {-# INLINE liftToJSON #-}-     liftToEncoding t to' = liftToEncoding t to' . Monoid.getLast-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (Monoid.Last a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSON1 Semigroup.Min where     liftToJSON t _ (Semigroup.Min x) = t x-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ (Semigroup.Min x) = t x-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (Semigroup.Min a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSON1 Semigroup.Max where     liftToJSON t _ (Semigroup.Max x) = t x-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ (Semigroup.Max x) = t x-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (Semigroup.Max a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}  instance ToJSON1 Semigroup.First where     liftToJSON t _ (Semigroup.First x) = t x-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ (Semigroup.First x) = t x-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (Semigroup.First a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSON1 Semigroup.Last where     liftToJSON t _ (Semigroup.Last x) = t x-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ (Semigroup.Last x) = t x-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (Semigroup.Last a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}   instance ToJSON1 Semigroup.WrappedMonoid where     liftToJSON t _ (Semigroup.WrapMonoid x) = t x-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ (Semigroup.WrapMonoid x) = t x-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (Semigroup.WrappedMonoid a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}  +#if !MIN_VERSION_base(4,16,0) instance ToJSON1 Semigroup.Option where     liftToJSON t to' = liftToJSON t to' . Semigroup.getOption-    {-# INLINE liftToJSON #-}-     liftToEncoding t to' = liftToEncoding t to' . Semigroup.getOption-    {-# INLINE liftToEncoding #-}  instance ToJSON a => ToJSON (Semigroup.Option a) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}+#endif  ------------------------------------------------------------------------------- -- data-fix@@ -2370,39 +2123,24 @@  instance ToJSON1 Proxy where     liftToJSON _ _ _ = Null-    {-# INLINE liftToJSON #-}-     liftToEncoding _ _ _ = E.null_-    {-# INLINE liftToEncoding #-}  instance ToJSON (Proxy a) where     toJSON _ = Null-    {-# INLINE toJSON #-}-     toEncoding _ = E.null_-    {-# INLINE toEncoding #-}   instance ToJSON2 Tagged where     liftToJSON2 _ _ t _ (Tagged x) = t x-    {-# INLINE liftToJSON2 #-}-     liftToEncoding2 _ _ t _ (Tagged x) = t x-    {-# INLINE liftToEncoding2 #-}  instance ToJSON1 (Tagged a) where     liftToJSON t _ (Tagged x) = t x-    {-# INLINE liftToJSON #-}-     liftToEncoding t _ (Tagged x) = t x-    {-# INLINE liftToEncoding #-}  instance ToJSON b => ToJSON (Tagged a b) where     toJSON = toJSON1-    {-# INLINE toJSON #-}-     toEncoding = toEncoding1-    {-# INLINE toEncoding #-}  instance ToJSONKey b => ToJSONKey (Tagged a b) where     toJSONKey = contramapToJSONKeyFunction unTagged toJSONKey@@ -2468,7 +2206,7 @@ instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSONKey (a,b,c,d)  instance ToJSONKey Char where-    toJSONKey = ToJSONKeyText T.singleton (E.string . (:[]))+    toJSONKey = toJSONKeyText T.singleton     toJSONKeyList = toJSONKeyText T.pack  instance (ToJSONKey a, ToJSON a) => ToJSONKey [a] where@@ -2484,22 +2222,16 @@         VM.unsafeWrite mv 0 (toA a)         VM.unsafeWrite mv 1 (toB b)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toA _ toB _ (a, b) = E.list id [toA a, toB b]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a) => ToJSON1 ((,) a) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b) => ToJSON (a, b) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a) => ToJSON2 ((,,) a) where     liftToJSON2 toB _ toC _ (a, b, c) = Array $ V.create $ do@@ -2508,26 +2240,20 @@         VM.unsafeWrite mv 1 (toB b)         VM.unsafeWrite mv 2 (toC c)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toB _ toC _ (a, b, c) = E.list id       [ toEncoding a       , toB b       , toC c       ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b) => ToJSON1 ((,,) a b) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a, b, c) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b) => ToJSON2 ((,,,) a b) where     liftToJSON2 toC _ toD _ (a, b, c, d) = Array $ V.create $ do@@ -2537,7 +2263,6 @@         VM.unsafeWrite mv 2 (toC c)         VM.unsafeWrite mv 3 (toD d)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toC _ toD _ (a, b, c, d) = E.list id       [ toEncoding a@@ -2545,19 +2270,14 @@       , toC c       , toD d       ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON1 ((,,,) a b c) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a, b, c, d) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON2 ((,,,,) a b c) where     liftToJSON2 toD _ toE _ (a, b, c, d, e) = Array $ V.create $ do@@ -2568,7 +2288,6 @@         VM.unsafeWrite mv 3 (toD d)         VM.unsafeWrite mv 4 (toE e)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toD _ toE _ (a, b, c, d, e) = E.list id       [ toEncoding a@@ -2577,19 +2296,14 @@       , toD d       , toE e       ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON1 ((,,,,) a b c d) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON (a, b, c, d, e) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON2 ((,,,,,) a b c d) where     liftToJSON2 toE _ toF _ (a, b, c, d, e, f) = Array $ V.create $ do@@ -2601,7 +2315,6 @@         VM.unsafeWrite mv 4 (toE e)         VM.unsafeWrite mv 5 (toF f)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toE _ toF _ (a, b, c, d, e, f) = E.list id       [ toEncoding a@@ -2611,19 +2324,14 @@       , toE e       , toF f       ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON1 ((,,,,,) a b c d e) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON (a, b, c, d, e, f) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e) => ToJSON2 ((,,,,,,) a b c d e) where     liftToJSON2 toF _ toG _ (a, b, c, d, e, f, g) = Array $ V.create $ do@@ -2636,7 +2344,6 @@         VM.unsafeWrite mv 5 (toF f)         VM.unsafeWrite mv 6 (toG g)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toF _ toG _ (a, b, c, d, e, f, g) = E.list id         [ toEncoding a@@ -2647,19 +2354,14 @@         , toF f         , toG g         ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON1 ((,,,,,,) a b c d e f) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON (a, b, c, d, e, f, g) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f) => ToJSON2 ((,,,,,,,) a b c d e f) where     liftToJSON2 toG _ toH _ (a, b, c, d, e, f, g, h) = Array $ V.create $ do@@ -2673,7 +2375,6 @@         VM.unsafeWrite mv 6 (toG g)         VM.unsafeWrite mv 7 (toH h)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toG _ toH _ (a, b, c, d, e, f, g, h) = E.list id         [ toEncoding a@@ -2685,19 +2386,14 @@         , toG g         , toH h         ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON1 ((,,,,,,,) a b c d e f g) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON (a, b, c, d, e, f, g, h) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g) => ToJSON2 ((,,,,,,,,) a b c d e f g) where     liftToJSON2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = Array $ V.create $ do@@ -2712,7 +2408,6 @@         VM.unsafeWrite mv 7 (toH h)         VM.unsafeWrite mv 8 (toI i)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toH _ toI _ (a, b, c, d, e, f, g, h, i) = E.list id         [ toEncoding a@@ -2725,19 +2420,14 @@         , toH h         , toI i         ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON1 ((,,,,,,,,) a b c d e f g h) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON (a, b, c, d, e, f, g, h, i) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h) => ToJSON2 ((,,,,,,,,,) a b c d e f g h) where     liftToJSON2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = Array $ V.create $ do@@ -2753,7 +2443,6 @@         VM.unsafeWrite mv 8 (toI i)         VM.unsafeWrite mv 9 (toJ j)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toI _ toJ _ (a, b, c, d, e, f, g, h, i, j) = E.list id         [ toEncoding a@@ -2767,19 +2456,14 @@         , toI i         , toJ j         ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON1 ((,,,,,,,,,) a b c d e f g h i) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON (a, b, c, d, e, f, g, h, i, j) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i) => ToJSON2 ((,,,,,,,,,,) a b c d e f g h i) where     liftToJSON2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = Array $ V.create $ do@@ -2796,7 +2480,6 @@         VM.unsafeWrite mv 9 (toJ j)         VM.unsafeWrite mv 10 (toK k)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toJ _ toK _ (a, b, c, d, e, f, g, h, i, j, k) = E.list id         [ toEncoding a@@ -2811,19 +2494,14 @@         , toJ j         , toK k         ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON1 ((,,,,,,,,,,) a b c d e f g h i j) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON (a, b, c, d, e, f, g, h, i, j, k) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j) => ToJSON2 ((,,,,,,,,,,,) a b c d e f g h i j) where     liftToJSON2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = Array $ V.create $ do@@ -2841,7 +2519,6 @@         VM.unsafeWrite mv 10 (toK k)         VM.unsafeWrite mv 11 (toL l)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toK _ toL _ (a, b, c, d, e, f, g, h, i, j, k, l) = E.list id         [ toEncoding a@@ -2857,19 +2534,14 @@         , toK k         , toL l         ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON1 ((,,,,,,,,,,,) a b c d e f g h i j k) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k) => ToJSON2 ((,,,,,,,,,,,,) a b c d e f g h i j k) where     liftToJSON2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = Array $ V.create $ do@@ -2888,7 +2560,6 @@         VM.unsafeWrite mv 11 (toL l)         VM.unsafeWrite mv 12 (toM m)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toL _ toM _ (a, b, c, d, e, f, g, h, i, j, k, l, m) = E.list id         [ toEncoding a@@ -2905,19 +2576,14 @@         , toL l         , toM m         ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON1 ((,,,,,,,,,,,,) a b c d e f g h i j k l) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l) => ToJSON2 ((,,,,,,,,,,,,,) a b c d e f g h i j k l) where     liftToJSON2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = Array $ V.create $ do@@ -2937,7 +2603,6 @@         VM.unsafeWrite mv 12 (toM m)         VM.unsafeWrite mv 13 (toN n)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toM _ toN _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = E.list id         [ toEncoding a@@ -2955,19 +2620,14 @@         , toM m         , toN n         ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON1 ((,,,,,,,,,,,,,) a b c d e f g h i j k l m) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m) => ToJSON2 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m) where     liftToJSON2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = Array $ V.create $ do@@ -2988,7 +2648,6 @@         VM.unsafeWrite mv 13 (toN n)         VM.unsafeWrite mv 14 (toO o)         return mv-    {-# INLINE liftToJSON2 #-}      liftToEncoding2 toN _ toO _ (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = E.list id         [ toEncoding a@@ -3007,19 +2666,14 @@         , toN n         , toO o         ]-    {-# INLINE liftToEncoding2 #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n) => ToJSON1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) where     liftToJSON = liftToJSON2 toJSON toJSONList-    {-# INLINE liftToJSON #-}     liftToEncoding = liftToEncoding2 toEncoding toEncodingList-    {-# INLINE liftToEncoding #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e, ToJSON f, ToJSON g, ToJSON h, ToJSON i, ToJSON j, ToJSON k, ToJSON l, ToJSON m, ToJSON n, ToJSON o) => ToJSON (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where     toJSON = toJSON2-    {-# INLINE toJSON #-}     toEncoding = toEncoding2-    {-# INLINE toEncoding #-}  -------------------------------------------------------------------------------- @@ -3029,18 +2683,22 @@  instance (a ~ Value) => FromPairs (Encoding' a) Series where   fromPairs = E.pairs+  {-# INLINE fromPairs #-}  instance FromPairs Value (DList Pair) where   fromPairs = object . toList+  {-# INLINE fromPairs #-}  -- | Like 'KeyValue' but the value is already converted to JSON -- ('Value' or 'Encoding'), and the result actually represents lists of pairs -- so it can be readily concatenated. class Monoid kv => KeyValuePair v kv where-    pair :: String -> v -> kv+    pair :: Key -> v -> kv  instance (v ~ Value) => KeyValuePair v (DList Pair) where-    pair k v = DList.singleton (pack k .= v)+    pair k v = DList.singleton (k .= v)+    {-# INLINE pair #-}  instance (e ~ Encoding) => KeyValuePair e Series where-    pair = E.pairStr+    pair = E.pair+    {-# INLINE pair #-}

@@ -6,10 +6,10 @@ module Encoders (module Encoders) where  import Prelude.Compat-import Data.Text (Text)  import Data.Aeson.TH import Data.Aeson.Types+import qualified Data.Aeson.Key as Key import Options import Types @@ -100,14 +100,14 @@ keyOptions :: JSONKeyOptions keyOptions = defaultJSONKeyOptions { keyModifier = ('k' :) } -gNullaryToJSONKey :: Nullary -> Either String Text+gNullaryToJSONKey :: Nullary -> Either String Key gNullaryToJSONKey x = case genericToJSONKey keyOptions of   ToJSONKeyText p _ -> Right (p x)   _ -> Left "Should be a ToJSONKeyText" -gNullaryFromJSONKey :: Text -> Parser Nullary+gNullaryFromJSONKey :: Key -> Parser Nullary gNullaryFromJSONKey t = case genericFromJSONKey keyOptions of-  FromJSONKeyTextParser p -> p t+  FromJSONKeyTextParser p -> p (Key.toText t)   _ -> fail "Not a TextParser"  --------------------------------------------------------------------------------

@@ -13,19 +13,21 @@ import Control.Applicative (empty) import Control.Monad import Data.Aeson.Types+import qualified Data.Aeson.KeyMap as KM import Data.Function (on) import Data.Time (ZonedTime(..), TimeZone(..)) import Data.Time.Clock (UTCTime(..)) import Functions import Test.QuickCheck (Arbitrary(..), elements,  oneof, sized, Gen, chooseInt, shuffle) import Types+import qualified Data.Aeson.Key as Key import qualified Data.DList as DList import qualified Data.Vector as V import qualified Data.HashMap.Strict as HM + import Data.Orphans () import Test.QuickCheck.Instances ()-import Data.Hashable.Time ()  -- "System" types. @@ -167,6 +169,9 @@ instance Arbitrary a => Arbitrary (DList.DList a) where     arbitrary = DList.fromList <$> arbitrary +instance Arbitrary Key where+    arbitrary = Key.fromText <$> arbitrary+ instance Arbitrary Value where     arbitrary = sized arb where         arb :: Int -> Gen Value@@ -186,7 +191,7 @@          obj n = do             pars <- arbPartition (n - 1)-            fmap (Object . HM.fromList) (traverse pair pars)+            fmap (Object . KM.fromList) (traverse pair pars)          pair n = do             k <- arbitrary

@@ -12,6 +12,8 @@ import qualified Data.Aeson.Internal as I import Data.Aeson.Parser (value) import Data.Aeson.Types+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KM import Data.HashMap.Strict (HashMap) import Data.Hashable (Hashable) import Data.Int (Int8)@@ -123,7 +125,7 @@     result :: Result (I.JSONPath, String)     result = parse (const parser) () -    jsonPath = map (I.Key . T.pack) path+    jsonPath = map (I.Key . Key.fromString) path  -- | Perform a structural comparison of the results of two encoding -- methods. Compares decoded values to account for HashMap-driven@@ -178,8 +180,8 @@ is2ElemArray _         = False  isTaggedObjectValue :: Value -> Bool-isTaggedObjectValue (Object obj) = "tag"      `H.member` obj &&-                                   "contents" `H.member` obj+isTaggedObjectValue (Object obj) = "tag"      `KM.member` obj &&+                                   "contents" `KM.member` obj isTaggedObjectValue _            = False  isNullaryTaggedObject :: Value -> Bool@@ -189,11 +191,11 @@ isTaggedObject = checkValue isTaggedObject'  isTaggedObject' :: Value -> Bool-isTaggedObject' (Object obj) = "tag" `H.member` obj+isTaggedObject' (Object obj) = "tag" `KM.member` obj isTaggedObject' _            = False  isObjectWithSingleField :: Value -> Bool-isObjectWithSingleField (Object obj) = H.size obj == 1+isObjectWithSingleField (Object obj) = KM.size obj == 1 isObjectWithSingleField _            = False  -- | is untaggedValue of EitherTextInt

@@ -109,6 +109,8 @@         (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int)    , example "nan :: Double" "null"  (Approx $ 0/0 :: Approx Double)+  , example "+inf :: Double" "\"+inf\"" (Approx $ 1/0 :: Approx Double)+  , example "-inf :: Double" "\"-inf\"" (Approx $ -1/0 :: Approx Double)    , example "Ordering LT" "\"LT\"" LT   , example "Ordering EQ" "\"EQ\"" EQ@@ -130,8 +132,8 @@    -- Three separate cases, as ordering in HashMap is not defined   , example "HashMap Float Int, NaN" "{\"NaN\":1}"  (Approx $ HM.singleton (0/0) 1 :: Approx (HM.HashMap Float Int))-  , example "HashMap Float Int, Infinity" "{\"Infinity\":1}"  (HM.singleton (1/0) 1 :: HM.HashMap Float Int)-  , example "HashMap Float Int, +Infinity" "{\"-Infinity\":1}"  (HM.singleton (negate 1/0) 1 :: HM.HashMap Float Int)+  , example "HashMap Float Int, Infinity" "{\"+inf\":1}"  (HM.singleton (1/0) 1 :: HM.HashMap Float Int)+  , example "HashMap Float Int, +Infinity" "{\"-inf\":1}"  (HM.singleton (negate 1/0) 1 :: HM.HashMap Float Int)    -- Functors   , example "Identity Int" "1"  (pure 1 :: Identity Int)@@ -258,12 +260,10 @@     $ F.unfoldNu F.unFix $ F.Fix (S.These True (F.Fix (S.That (F.Fix (S.This False)))))   ] +-- encodings which clash (like infinities prior aeson-2.0) jsonEncodingExamples :: [Example] jsonEncodingExamples =   [-  -- infinities cannot be recovered, null is decoded as NaN-    example "inf :: Double" "null" (Approx $ 1/0 :: Approx Double)-  , example "-inf :: Double" "null" (Approx $ -1/0 :: Approx Double)   ]  jsonDecodingExamples :: [Example]

@@ -38,6 +38,7 @@   ( Options(..), Result(Success, Error), ToJSON(..)   , Value(Array, Bool, Null, Number, Object, String), camelTo, camelTo2   , defaultOptions, formatPath, formatRelativePath, omitNothingFields, parse)+import qualified Data.Aeson.KeyMap as KM import Data.Attoparsec.ByteString (Parser, parseOnly) import Data.Char (toUpper) import Data.Either.Compat (isLeft, isRight)@@ -63,7 +64,6 @@ import qualified Data.ByteString.Base16.Lazy as LBase16 import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.HashSet as HashSet-import qualified Data.HashMap.Lazy as HashMap import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.Encoding as LT@@ -76,60 +76,8 @@ import Data.Aeson.Parser.UnescapeFFI () import Data.Aeson.Parser.UnescapePure () -tests :: TestTree-tests = testGroup "unit" [-    testGroup "SerializationFormatSpec" SerializationFormatSpec.tests-  , testGroup "ErrorMessages" ErrorMessages.tests-  , testGroup "camelCase" [-      testCase "camelTo" $ roundTripCamel "aName"-    , testCase "camelTo" $ roundTripCamel "another"-    , testCase "camelTo" $ roundTripCamel "someOtherName"-    , testCase "camelTo" $-        assertEqual "" "camel_apicase" (camelTo '_' "CamelAPICase")-    , testCase "camelTo2" $ roundTripCamel2 "aName"-    , testCase "camelTo2" $ roundTripCamel2 "another"-    , testCase "camelTo2" $ roundTripCamel2 "someOtherName"-    , testCase "camelTo2" $-        assertEqual "" "camel_api_case" (camelTo2 '_' "CamelAPICase")-    ]-  , testGroup "encoding" [-      testCase "goodProducer" goodProducer-    ]-  , testGroup "utctime" [-      testCase "good" utcTimeGood-    , testCase "bad"  utcTimeBad-    ]-  , testGroup "formatError" [-      testCase "example 1" formatErrorExample-    ]-  , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark-  , testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws-  , testGroup "Object construction" $ fmap (testCase "-") objectConstruction-  , testGroup "Issue #351" $ fmap (testCase "-") issue351-  , testGroup "Nullary constructors" $ fmap (testCase "-") nullaryConstructors-  , testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions-  , testCase "PR #455" pr455-  , testCase "Unescape string (PR #477)" unescapeString-  , testCase "Show Options" showOptions-  , testGroup "SingleMaybeField" singleMaybeField-  , testCase "withEmbeddedJSON" withEmbeddedJSONTest-  , testCase "SingleFieldCon" singleFieldCon-  , testGroup "UnknownFields" unknownFields-  , testGroup "Ordering of object keys" keyOrdering-  , testCase "Ratio with denominator 0" ratioDenominator0-  , testCase "Rational parses number"   rationalNumber-  , testCase "Big rational"             bigRationalDecoding-  , testCase "Small rational"           smallRationalDecoding-  , testCase "Big scientific exponent" bigScientificExponent-  , testCase "Big integer decoding" bigIntegerDecoding-  , testCase "Big natural decading" bigNaturalDecoding-  , testCase "Big integer key decoding" bigIntegerKeyDecoding-  , testGroup "QQ.Simple"-    [ testCase "example" $-      assertEqual "" (object ["foo" .= True]) [aesonQQ| {"foo": true } |]-    ]-  ] + roundTripCamel :: String -> Assertion roundTripCamel name = assertEqual "" name (camelFrom '_' $ camelTo '_' name) @@ -389,12 +337,8 @@ -- Comparison between bytestring and text encoders ------------------------------------------------------------------------------ -ioTests :: IO [TestTree]-ioTests = do-  enc <- encoderComparisonTests-  js <- jsonTestSuite-  return [enc, js] + encoderComparisonTests :: IO TestTree encoderComparisonTests = do   encoderTests <- forM testFiles $ \file0 -> do@@ -427,6 +371,7 @@  -- A regression test for: https://github.com/bos/aeson/issues/293 data MyRecord = MyRecord {_field1 :: Maybe Int, _field2 :: Maybe Bool}+deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord  data MyRecord2 = MyRecord2 {_field3 :: Maybe Int, _field4 :: Maybe Bool}   deriving Generic@@ -522,6 +467,8 @@  -- A regression test for: https://github.com/bos/aeson/pull/455 data Foo a = FooNil | FooCons (Foo Int)+deriveToJSON  defaultOptions ''Foo+deriveToJSON1 defaultOptions ''Foo  pr455 :: Assertion pr455 = assertEqual "FooCons FooNil"@@ -548,6 +495,7 @@  newtype SingleMaybeField = SingleMaybeField { smf :: Maybe Int }   deriving (Eq, Show, Generic)+deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField  singleMaybeField :: [TestTree] singleMaybeField = do@@ -589,14 +537,21 @@  newtype UnknownFields = UnknownFields { knownField :: Int }   deriving (Eq, Show, Generic)+deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFields+ newtype UnknownFieldsTag = UnknownFieldsTag { tag :: Int }   deriving (Eq, Show, Generic)+deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag+ newtype UnknownFieldsUnaryTagged = UnknownFieldsUnaryTagged { knownFieldUnaryTagged :: Int }   deriving (Eq, Show, Generic)+deriveJSON defaultOptions{tagSingleConstructors=True,rejectUnknownFields=True} ''UnknownFieldsUnaryTagged+ data UnknownFieldsSum   = UnknownFields1 { knownField1 :: Int }   | UnknownFields2 { knownField2 :: Int }   deriving (Eq, Show, Generic)+deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum  unknownFields :: [TestTree] unknownFields = concat@@ -669,26 +624,26 @@ keyOrdering =   [ testParser "json" json       "{\"k\":true,\"k\":false}" $-      Right (Object (HashMap.fromList [("k", Bool True)]))+      Right (Object (KM.fromList [("k", Bool True)]))   , testParser "jsonLast" jsonLast       "{\"k\":true,\"k\":false}" $-      Right (Object (HashMap.fromList [("k", Bool False)]))+      Right (Object (KM.fromList [("k", Bool False)]))   , testParser "jsonAccum" jsonAccum       "{\"k\":true,\"k\":false}" $-      Right (Object (HashMap.fromList [("k", Array (Vector.fromList [Bool True, Bool False]))]))+      Right (Object (KM.fromList [("k", Array (Vector.fromList [Bool True, Bool False]))]))   , testParser "jsonNoDup" jsonNoDup       "{\"k\":true,\"k\":false}" $       Left "Failed reading: found duplicate key: \"k\""    , testParser "json'" json'       "{\"k\":true,\"k\":false}" $-      Right (Object (HashMap.fromList [("k", Bool True)]))+      Right (Object (KM.fromList [("k", Bool True)]))   , testParser "jsonLast'" jsonLast'       "{\"k\":true,\"k\":false}" $-      Right (Object (HashMap.fromList [("k", Bool False)]))+      Right (Object (KM.fromList [("k", Bool False)]))   , testParser "jsonAccum'" jsonAccum'       "{\"k\":true,\"k\":false}" $-      Right (Object (HashMap.fromList [("k", Array (Vector.fromList [Bool True, Bool False]))]))+      Right (Object (KM.fromList [("k", Array (Vector.fromList [Bool True, Bool False]))]))   , testParser "jsonNoDup'" jsonNoDup'       "{\"k\":true,\"k\":false}" $       Left "Failed reading: found duplicate key: \"k\""@@ -753,17 +708,68 @@ type family Fam757 :: * -> * type instance Fam757 = Maybe newtype Newtype757 a = MkNewtype757 (Fam757 a)--deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord--deriveToJSON  defaultOptions ''Foo-deriveToJSON1 defaultOptions ''Foo+deriveToJSON1 defaultOptions ''Newtype757 -deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField+-------------------------------------------------------------------------------+-- Tests trees+------------------------------------------------------------------------------- -deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFields-deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsTag-deriveJSON defaultOptions{tagSingleConstructors=True,rejectUnknownFields=True} ''UnknownFieldsUnaryTagged-deriveJSON defaultOptions{rejectUnknownFields=True} ''UnknownFieldsSum+ioTests :: IO [TestTree]+ioTests = do+  enc <- encoderComparisonTests+  js <- jsonTestSuite+  return [enc, js] -deriveToJSON1 defaultOptions ''Newtype757+tests :: TestTree+tests = testGroup "unit" [+    testGroup "SerializationFormatSpec" SerializationFormatSpec.tests+  , testGroup "ErrorMessages" ErrorMessages.tests+  , testGroup "camelCase" [+      testCase "camelTo" $ roundTripCamel "aName"+    , testCase "camelTo" $ roundTripCamel "another"+    , testCase "camelTo" $ roundTripCamel "someOtherName"+    , testCase "camelTo" $+        assertEqual "" "camel_apicase" (camelTo '_' "CamelAPICase")+    , testCase "camelTo2" $ roundTripCamel2 "aName"+    , testCase "camelTo2" $ roundTripCamel2 "another"+    , testCase "camelTo2" $ roundTripCamel2 "someOtherName"+    , testCase "camelTo2" $+        assertEqual "" "camel_api_case" (camelTo2 '_' "CamelAPICase")+    ]+  , testGroup "encoding" [+      testCase "goodProducer" goodProducer+    ]+  , testGroup "utctime" [+      testCase "good" utcTimeGood+    , testCase "bad"  utcTimeBad+    ]+  , testGroup "formatError" [+      testCase "example 1" formatErrorExample+    ]+  , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark+  , testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws+  , testGroup "Object construction" $ fmap (testCase "-") objectConstruction+  , testGroup "Issue #351" $ fmap (testCase "-") issue351+  , testGroup "Nullary constructors" $ fmap (testCase "-") nullaryConstructors+  , testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions+  , testCase "PR #455" pr455+  , testCase "Unescape string (PR #477)" unescapeString+  , testCase "Show Options" showOptions+  , testGroup "SingleMaybeField" singleMaybeField+  , testCase "withEmbeddedJSON" withEmbeddedJSONTest+  , testCase "SingleFieldCon" singleFieldCon+  , testGroup "UnknownFields" unknownFields+  , testGroup "Ordering of object keys" keyOrdering+  , testCase "Ratio with denominator 0" ratioDenominator0+  , testCase "Rational parses number"   rationalNumber+  , testCase "Big rational"             bigRationalDecoding+  , testCase "Small rational"           smallRationalDecoding+  , testCase "Big scientific exponent" bigScientificExponent+  , testCase "Big integer decoding" bigIntegerDecoding+  , testCase "Big natural decading" bigNaturalDecoding+  , testCase "Big integer key decoding" bigIntegerKeyDecoding+  , testGroup "QQ.Simple"+    [ testCase "example" $+      assertEqual "" (object ["foo" .= True]) [aesonQQ| {"foo": true } |]+    ]+  ]