openapi-hs 4.1.0 → 5.0.0

raw patch · 18 files changed

+1674/−522 lines, 18 filesdep +deepseqdep −insert-ordered-containersdep −optics-coredep −optics-thdep ~lensPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

Dependencies removed: insert-ordered-containers, optics-core, optics-th

Dependency ranges changed: lens

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• LICENSE +5/−0
• LICENSES/insert-ordered-containers-BSD-3-Clause.txt +30/−0
• MIGRATION_4_TO_5.md +85/−0
• README.md +6/−9
• openapi-hs.cabal +29/−22
• src/Data/HashMap/InsOrd/Compat/Internal.hs +46/−0
• src/Data/HashMap/Strict/InsOrd/Compat.hs +105/−105
• src/Data/HashMap/Strict/InsOrd/Compat/Impl.hs +646/−0
• src/Data/HashSet/InsOrd/Compat.hs +365/−0
• src/Data/OpenApi.hs +1/−3
• src/Data/OpenApi/Internal.hs +1/−1
• src/Data/OpenApi/Internal/AesonUtils.hs +1/−1
• src/Data/OpenApi/Operation.hs +1/−1
• src/Data/OpenApi/Optics.hs +0/−379
• test/Data/HashMap/Strict/InsOrd/CompatSpec.hs +181/−0
• test/Data/HashSet/InsOrdSpec.hs +154/−0
• test/Data/OpenApiSpec.hs +1/−1

@@ -1,3 +1,20 @@+5.0.0+-----++- **Breaking:** removed `Data.OpenApi.Optics` and its overloaded-label accessors. Use the+  `lens` accessors in `Data.OpenApi.Lens`, which remain re-exported from `Data.OpenApi`.+- **Breaking:** code that imported `Data.HashSet.InsOrd` to construct OpenAPI tag sets must now+  import `Data.HashSet.InsOrd.Compat` from `openapi-hs`.+- **Breaking:** code that used `Data.HashMap.Strict.InsOrd` for OpenAPI map fields must switch to+  `Data.HashMap.Strict.InsOrd.Compat`.+- Removed the `optics-core`, `optics-th`, and `insert-ordered-containers` dependencies; the+  resolved plan also drops `optics-extra` and `indexed-profunctors`. The insertion-ordered map+  and set implementations are vendored from `insert-ordered-containers-0.3.0` under+  BSD-3-Clause.+- Raised the `lens` lower bound to `5.3.3`, the earliest release verified with the supported+  GHC 9.12 line. GHC 9.14 resolves to `lens-5.3.6` because earlier releases do not permit its+  `template-haskell` version.+ 4.1.0 ----- 

@@ -27,3 +27,8 @@ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++The modules Data.HashMap.InsOrd.Compat.Internal,+Data.HashMap.Strict.InsOrd.Compat.Impl, and Data.HashSet.InsOrd.Compat contain+code derived from insert-ordered-containers-0.3.0. The complete upstream+BSD-3-Clause notice is in LICENSES/insert-ordered-containers-BSD-3-Clause.txt.

@@ -0,0 +1,30 @@+Copyright (c) 2015, Oleg Grenrus++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Oleg Grenrus nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,85 @@+# Migrating from `openapi-hs` 4 to 5++`openapi-hs` 5.0.0 removes its `optics` interface and the external+`insert-ordered-containers` dependency. The `lens` interface remains the supported way to read+and update OpenAPI records. This guide covers the source changes needed by downstream users.++## Replace optics labels with lens accessors++Version 4 generated both overloaded `optics` labels and ordinary `lens` accessors. Version 5+removes `Data.OpenApi.Optics`, so remove that import and use the accessors re-exported by+`Data.OpenApi`:++```haskell+-- Before (openapi-hs 4)+{-# LANGUAGE OverloadedLabels #-}+import Data.OpenApi+import Data.OpenApi.Optics ()+import Optics.Core++schemaType = view #type schema+updated = set (#schema % #type) (Just (OpenApiTypeSingle OpenApiString)) namedSchema+```++```haskell+-- After (openapi-hs 5)+import Control.Lens+import Data.OpenApi++schemaType = view type_ schema+updated = set (schema . type_) (Just (OpenApiTypeSingle OpenApiString)) namedSchema+```++`lens` accessors compose with ordinary `(.)`; the removed `optics` labels composed with `%`.+Fields whose ordinary names collide with Haskell keywords, Prelude names, or other accessors+have a trailing underscore. Common migrations are `#type` to `type_`, `#default` to `default_`,+`#maximum` to `maximum_`, and `#minimum` to `minimum_`. Other examples include `enum_`,+`const_`, `if_`, `then_`, `else_`, `contains_`, and `id_`.++Remove `optics-core` and `optics-th` from your own dependencies only when your code has no+independent use for them.++## Use the compat insertion-ordered map++OpenAPI map fields use the public compat map from this package. Change direct imports from the+external package:++```haskell+-- Before+import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap+```++```haskell+-- After+import Data.HashMap.Strict.InsOrd.Compat qualified as InsOrdHashMap+```++Functions such as `empty`, `fromList`, `insert`, `insertWith`, `unionWith`, and `lookup` retain+the same names. The compat map intentionally compares equality without considering insertion+order and encodes string-like keys as a JSON object in insertion order.++## Use the compat insertion-ordered set++OpenAPI tag fields now use a set exposed directly by `openapi-hs`:++```haskell+-- Before+import Data.HashSet.InsOrd qualified as InsOrdHashSet+```++```haskell+-- After+import Data.HashSet.InsOrd.Compat qualified as InsOrdHashSet+```++The set keeps its non-optics public instances, including `NFData`, `NFData1`, `ToJSON`,+`FromJSON`, and the `lens` `Ixed`, `At`, and `Contains` instances.++Remove `insert-ordered-containers` from your own dependencies only when no other part of your+application still imports it independently.++## Compiler and lens bounds++Version 5 requires `lens >=5.3.3 && <5.4`. The lower bound is verified with GHC 9.12. On GHC+9.14, the solver selects `lens-5.3.6`, the first release in this range that permits GHC 9.14's+`template-haskell` version.

@@ -32,7 +32,7 @@   `PathItem`. - **Schema validation** that understands the new 3.1 keywords. - **`ToSchema` derivation** to generate schemas from your Haskell types via `GHC.Generics`.-- **`lens` and `optics`** accessors for ergonomic reads and updates.+- **`lens` accessors** for ergonomic reads and updates. - **3.0 → 3.1 migration helpers** for documents you don't control yet.  ## Installation@@ -117,21 +117,18 @@ For validating an arbitrary JSON `Value` against a specific `Schema`, use `validateJSON :: Definitions Schema -> Schema -> Value -> [ValidationError]`. -## Lenses and optics+## Lenses -Every record field has a generated accessor in both the-[`lens`](https://hackage.haskell.org/package/lens) and-[`optics`](https://hackage.haskell.org/package/optics) styles. Import whichever you prefer:+Every record field has a generated accessor from+[`lens`](https://hackage.haskell.org/package/lens), re-exported by the umbrella module:  ```haskell-import Data.OpenApi             -- lens accessors (Data.OpenApi.Lens)--- or-import Data.OpenApi.Optics      -- optics labels (#type, #properties, …)+import Data.OpenApi -- lens accessors (Data.OpenApi.Lens) ```  A few field lenses are suffixed with `_` to avoid clashing with reserved words or `Prelude` names: `type_`, `enum_`, `minimum_`, `maximum_`, `default_`, `const_`, `if_`, `then_`, `else_`,-`contains_`, `id_`. The corresponding optics labels keep the bare name (`#type`, `#const`, …).+`contains_`, `id_`.  ## Migrating from OpenAPI 3.0 

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               openapi-hs-version:            4.1.0+version:            5.0.0 synopsis:           OpenAPI 3.1 data model category:           Web, OpenApi description:@@ -19,12 +19,17 @@ maintainer:         nadeem@gmail.com copyright:   (c) 2015-2016, GetShopTV, (c) 2020, Biocad, (c) 2026, Nadeem Bitar+  (c) 2015, Oleg Grenrus  build-type:         Simple-extra-source-files: examples/*.hs+extra-source-files:+  examples/*.hs+  LICENSES/insert-ordered-containers-BSD-3-Clause.txt+ extra-doc-files:   CHANGELOG.md   MIGRATION_3.0_TO_3.1.md+  MIGRATION_4_TO_5.md   README.md  tested-with:        GHC ==9.12.4 || ==9.14.1@@ -33,6 +38,7 @@   hs-source-dirs:     src   exposed-modules:     Data.HashMap.Strict.InsOrd.Compat+    Data.HashSet.InsOrd.Compat     Data.OpenApi     Data.OpenApi.Aeson.Compat     Data.OpenApi.Declare@@ -46,14 +52,16 @@     Data.OpenApi.Lens     Data.OpenApi.Migration     Data.OpenApi.Operation-    Data.OpenApi.Optics     Data.OpenApi.ParamSchema     Data.OpenApi.Schema     Data.OpenApi.Schema.Generator     Data.OpenApi.Schema.Validation     Data.OpenApi.SchemaOptions -  -- internal modules+  other-modules:+    Data.HashMap.InsOrd.Compat.Internal+    Data.HashMap.Strict.InsOrd.Compat.Impl+   -- GHC boot libraries   build-depends:     , base              >=4.11.1.0 && <4.23@@ -69,28 +77,25 @@    -- other dependencies   build-depends:-    , aeson                      >=2.0.1.0  && <2.3-    , aeson-pretty               >=0.8.7    && <0.9-    , base-compat-batteries      >=0.11.1   && <0.16-    , cookie                     >=0.4.3    && <0.6-    , generics-sop               >=0.5.1.0  && <0.6-    , hashable                   >=1.2.7.0  && <1.6-    , http-media                 >=0.8.0.0  && <0.9-    , insert-ordered-containers  >=0.2.3    && <0.4-    , lens                       >=4.16.1   && <5.4-    , optics-core                >=0.2      && <0.5-    , optics-th                  >=0.2      && <0.5-    , QuickCheck                 >=2.10.1   && <2.19-    , scientific                 >=0.3.6.2  && <0.4-    , unordered-containers       >=0.2.9.0  && <0.3-    , uuid-types                 >=1.0.3    && <1.1-    , vector                     >=0.12.0.1 && <0.14+    , aeson                  >=2.0.1.0  && <2.3+    , aeson-pretty           >=0.8.7    && <0.9+    , base-compat-batteries  >=0.11.1   && <0.16+    , cookie                 >=0.4.3    && <0.6+    , deepseq                >=1.4.4    && <1.6+    , generics-sop           >=0.5.1.0  && <0.6+    , hashable               >=1.2.7.0  && <1.6+    , http-media             >=0.8.0.0  && <0.9+    , lens                   >=5.3.3    && <5.4+    , QuickCheck             >=2.10.1   && <2.19+    , scientific             >=0.3.6.2  && <0.4+    , unordered-containers   >=0.2.9.0  && <0.3+    , uuid-types             >=1.0.3    && <1.1+    , vector                 >=0.12.0.1 && <0.14    default-language:   GHC2024   default-extensions:     DefaultSignatures     FunctionalDependencies-    OverloadedLabels     OverloadedStrings     PackageImports     RecordWildCards@@ -113,8 +118,8 @@     , base-compat-batteries     , bytestring     , containers+    , deepseq     , hashable-    , insert-ordered-containers     , lens     , mtl     , openapi-hs@@ -135,6 +140,8 @@   -- https://github.com/haskell/cabal/issues/3708   build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.12   other-modules:+    Data.HashMap.Strict.InsOrd.CompatSpec+    Data.HashSet.InsOrdSpec     Data.OpenApi.CommonTestTypes     Data.OpenApi.MigrationSpec     Data.OpenApi.ParamSchemaSpec

@@ -0,0 +1,46 @@+{-# LANGUAGE GADTs #-}++-- | Vendored from @insert-ordered-containers-0.3.0@.+--+-- Copyright (c) 2015-2026 Oleg Grenrus+-- Licensed under BSD-3-Clause; see+-- @LICENSES/insert-ordered-containers-BSD-3-Clause.txt@.+module Data.HashMap.InsOrd.Compat.Internal where++import Control.Applicative ((<**>))+import Prelude hiding (filter, foldr, lookup, map, null)++-------------------------------------------------------------------------------+-- SortedAp+-------------------------------------------------------------------------------++-- Sort using insertion sort+-- Hopefully it's fast enough for where we need it+-- otherwise: https://gist.github.com/treeowl/9621f58d55fe0c4f9162be0e074b1b29+-- http://elvishjerricco.github.io/2017/03/23/applicative-sorting.html also related++-- Free applicative which re-orders effects+-- Mostly from Edward Kmett's `free` package.+data SortedAp f a where+  Pure :: a -> SortedAp f a+  SortedAp :: !Int -> f a -> SortedAp f (a -> b) -> SortedAp f b++instance Functor (SortedAp f) where+  fmap f (Pure a) = Pure (f a)+  fmap f (SortedAp i x y) = SortedAp i x ((f .) <$> y)++instance Applicative (SortedAp f) where+  pure = Pure+  Pure f <*> y = fmap f y+  -- This is different from real Ap+  f <*> Pure y = fmap ($ y) f+  f@(SortedAp i x y) <*> z@(SortedAp j u v)+    | i < j = SortedAp i x (flip <$> y <*> z)+    | otherwise = SortedAp j u ((.) <$> f <*> v)++liftSortedAp :: Int -> f a -> SortedAp f a+liftSortedAp i x = SortedAp i x (Pure id)++retractSortedAp :: (Applicative f) => SortedAp f a -> f a+retractSortedAp (Pure x) = pure x+retractSortedAp (SortedAp _ f x) = f <**> retractSortedAp x

@@ -1,7 +1,6 @@ -- Ported from GetShopTV/swagger2 (pull request #262) to apply the same -- insert-ordered-containers-0.3 compatibility fix to openapi3. -- Credit for the design and implementation belongs to the swagger2 authors.-{-# LANGUAGE CPP #-}  -- | -- Module:      Data.HashMap.Strict.InsOrd.Compat@@ -145,127 +144,114 @@   ) where -#if !MIN_VERSION_insert_ordered_containers(0,3,0)-import Prelude hiding (null, lookup, map, foldl', foldr, filter)-import Data.HashMap.Strict.InsOrd-#else-import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap--import Prelude hiding (null, size, member, lookup, lookupDefault, map, foldl', filter)-import qualified Prelude--import qualified Data.Aeson as A-import qualified Data.Aeson.Encoding as E-import           Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap--import qualified GHC.Exts as Exts--import Data.Data                       (Data)-import Data.Foldable                   (Foldable (foldMap))-import Data.Hashable                   (Hashable (..))--import qualified Control.Lens        as Lens import Control.Lens-       (At (..), Index, Iso, IxValue, Ixed (..), Traversal, _1, _2, iso, (<&>))--import qualified Optics.Core         as Optics+  ( At (..),+    Index,+    Iso,+    IxValue,+    Ixed (..),+    Traversal,+    iso,+    (<&>),+    _1,+    _2,+  )+import Control.Lens qualified as Lens+import Data.Aeson qualified as A+import Data.Aeson.Encoding qualified as E+import Data.Data (Data)+import Data.Foldable (Foldable (foldMap))+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.HashMap.Strict.InsOrd.Compat.Impl qualified as InsOrdHashMap+import Data.Hashable (Hashable (..))+import GHC.Exts qualified as Exts+import Prelude hiding (filter, foldl', lookup, lookupDefault, map, member, null, size)+import Prelude qualified -newtype InsOrdHashMap k v = InsOrdHashMap { unCompatInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap k v }+newtype InsOrdHashMap k v = InsOrdHashMap {unCompatInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap k v}   deriving stock (Show, Read, Data, Functor, Foldable, Traversable)   deriving newtype (Semigroup, Monoid)  instance (Eq k, Eq v) => Eq (InsOrdHashMap k v) where-    a == b = toHashMap a == toHashMap b+  a == b = toHashMap a == toHashMap b  instance (Eq k, Hashable k) => Exts.IsList (InsOrdHashMap k v) where-    type Item (InsOrdHashMap k v) = Exts.Item (InsOrdHashMap.InsOrdHashMap k v)-    fromList = InsOrdHashMap . InsOrdHashMap.fromList-    toList   = InsOrdHashMap.toList . unCompatInsOrdHashMap+  type Item (InsOrdHashMap k v) = Exts.Item (InsOrdHashMap.InsOrdHashMap k v)+  fromList = InsOrdHashMap . InsOrdHashMap.fromList+  toList = InsOrdHashMap.toList . unCompatInsOrdHashMap  ------------------------------------------------------------------------------- -- Aeson -------------------------------------------------------------------------------  instance (A.ToJSONKey k) => A.ToJSON1 (InsOrdHashMap k) where-    liftToJSON _ t _ = case A.toJSONKey :: A.ToJSONKeyFunction k of-      A.ToJSONKeyText f _ -> A.object . fmap (\(k, v) -> (f k, t v)) . toList-      A.ToJSONKeyValue f _ -> A.toJSON . fmap (\(k,v) -> A.toJSON (f k, t v)) . toList+  liftToJSON _ t _ = case A.toJSONKey :: A.ToJSONKeyFunction k of+    A.ToJSONKeyText f _ -> A.object . fmap (\(k, v) -> (f k, t v)) . toList+    A.ToJSONKeyValue f _ -> A.toJSON . fmap (\(k, v) -> A.toJSON (f k, t v)) . toList -    liftToEncoding o t _ = case A.toJSONKey :: A.ToJSONKeyFunction k of-      A.ToJSONKeyText _ f ->  E.dict f t foldrWithKey-      A.ToJSONKeyValue _ f -> E.list (A.liftToEncoding2 (const False) f (E.list f) o t (E.list t)) . toList+  liftToEncoding o t _ = case A.toJSONKey :: A.ToJSONKeyFunction k of+    A.ToJSONKeyText _ f -> E.dict f t foldrWithKey+    A.ToJSONKeyValue _ f -> E.list (A.liftToEncoding2 (const False) f (E.list f) o t (E.list t)) . toList  instance (A.ToJSONKey k, A.ToJSON v) => A.ToJSON (InsOrdHashMap k v) where-    toJSON = A.toJSON1-    toEncoding = A.toEncoding1+  toJSON = A.toJSON1+  toEncoding = A.toEncoding1  -------------------------------------------------------------------------------  instance (Eq k, Hashable k, A.FromJSONKey k) => A.FromJSON1 (InsOrdHashMap k) where-    liftParseJSON o p pl v = fromList . HashMap.toList <$> A.liftParseJSON o p pl v+  liftParseJSON o p pl v = fromList . HashMap.toList <$> A.liftParseJSON o p pl v  instance (Eq k, Hashable k, A.FromJSONKey k, A.FromJSON v) => A.FromJSON (InsOrdHashMap k v) where-    parseJSON = A.parseJSON1+  parseJSON = A.parseJSON1  ------------------------------------------------------------------------------- -- indexed-traversals ------------------------------------------------------------------------------- -instance (Eq k, Hashable k) => Optics.FunctorWithIndex k (InsOrdHashMap k) where-    imap = mapWithKey-instance (Eq k, Hashable k) => Optics.FoldableWithIndex k (InsOrdHashMap k) where-    ifoldMap = foldMapWithKey-    ifoldr   = foldrWithKey-instance (Eq k, Hashable k) => Optics.TraversableWithIndex k (InsOrdHashMap k) where-    itraverse = traverseWithKey+instance (Eq k, Hashable k) => Lens.FunctorWithIndex k (InsOrdHashMap k) where+  imap = mapWithKey +instance (Eq k, Hashable k) => Lens.FoldableWithIndex k (InsOrdHashMap k) where+  ifoldMap = foldMapWithKey+  ifoldr = foldrWithKey++instance (Eq k, Hashable k) => Lens.TraversableWithIndex k (InsOrdHashMap k) where+  itraverse = traverseWithKey+ ------------------------------------------------------------------------------- -- Lens -------------------------------------------------------------------------------  type instance Index (InsOrdHashMap k v) = k+ type instance IxValue (InsOrdHashMap k v) = v  instance (Eq k, Hashable k) => Ixed (InsOrdHashMap k v) where-    ix k f m = ixImpl k pure f m-    {-# INLINABLE ix #-}+  ix k f m = ixImpl k pure f m+  {-# INLINEABLE ix #-} -ixImpl-  :: (Eq k, Hashable k, Functor f)-  => k-  -> (InsOrdHashMap k v -> f (InsOrdHashMap k v))-  -> (v -> f v)-  -> InsOrdHashMap k v-  -> f (InsOrdHashMap k v)+ixImpl ::+  (Eq k, Hashable k, Functor f) =>+  k ->+  (InsOrdHashMap k v -> f (InsOrdHashMap k v)) ->+  (v -> f v) ->+  InsOrdHashMap k v ->+  f (InsOrdHashMap k v) ixImpl k point f m = case lookup k m of-    Just v  -> f v <&> \v' -> insert k v' m-    Nothing -> point m+  Just v -> f v <&> \v' -> insert k v' m+  Nothing -> point m {-# INLINE ixImpl #-}  instance (Eq k, Hashable k) => At (InsOrdHashMap k a) where-    at k f m = f mv <&> \r -> case r of-        Nothing -> maybe m (const (delete k m)) mv-        Just v' -> insert k v' m-      where mv = lookup k m-    {-# INLINABLE at #-}------------------------------------------------------------------------------------ Optics----------------------------------------------------------------------------------type instance Optics.Index (InsOrdHashMap k v) = k-type instance Optics.IxValue (InsOrdHashMap k v) = v--instance (Eq k, Hashable k) => Optics.Ixed (InsOrdHashMap k v) where-    ix k = Optics.atraversalVL $ \point f m -> ixImpl k point f m-    {-# INLINE ix #-}--instance (Eq k, Hashable k) => Optics.At (InsOrdHashMap k a) where-    at k = Optics.lensVL $ \f m -> Lens.at k f m-    {-# INLINE at #-}---------------------------------------------------------------------------------+  at k f m =+    f mv <&> \r -> case r of+      Nothing -> maybe m (const (delete k m)) mv+      Just v' -> insert k v' m+    where+      mv = lookup k m+  {-# INLINEABLE at #-}  -- | This is a slight lie, as roundtrip doesn't preserve ordering. hashMap :: Iso (InsOrdHashMap k a) (InsOrdHashMap k b) (HashMap k a) (HashMap k b)@@ -275,17 +261,21 @@ unorderedTraversal = hashMap . traverse  -------------------------------------------------------------------------------+ -- * Construction+ -------------------------------------------------------------------------------  empty :: InsOrdHashMap k v empty = InsOrdHashMap InsOrdHashMap.empty -singleton :: Hashable k => k -> v -> InsOrdHashMap k v+singleton :: (Hashable k) => k -> v -> InsOrdHashMap k v singleton k v = InsOrdHashMap (InsOrdHashMap.singleton k v)  -------------------------------------------------------------------------------+ -- * Basic interface+ -------------------------------------------------------------------------------  null :: InsOrdHashMap k v -> Bool@@ -294,55 +284,57 @@ size :: InsOrdHashMap k v -> Int size = InsOrdHashMap.size . unCompatInsOrdHashMap -insert :: Hashable k => k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v+insert :: (Hashable k) => k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v insert k v = InsOrdHashMap . InsOrdHashMap.insert k v . unCompatInsOrdHashMap -insertWith :: Hashable k => (v -> v -> v) -> k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v+insertWith :: (Hashable k) => (v -> v -> v) -> k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v insertWith f k v = InsOrdHashMap . InsOrdHashMap.insertWith f k v . unCompatInsOrdHashMap -delete :: Hashable k => k -> InsOrdHashMap k v -> InsOrdHashMap k v+delete :: (Hashable k) => k -> InsOrdHashMap k v -> InsOrdHashMap k v delete k = InsOrdHashMap . InsOrdHashMap.delete k . unCompatInsOrdHashMap -adjust :: Hashable k => (v -> v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v+adjust :: (Hashable k) => (v -> v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v adjust f k = InsOrdHashMap . InsOrdHashMap.adjust f k . unCompatInsOrdHashMap -update :: Hashable k => (v -> Maybe v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v+update :: (Hashable k) => (v -> Maybe v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v update f k = InsOrdHashMap . InsOrdHashMap.update f k . unCompatInsOrdHashMap -alter :: Hashable k => (Maybe v -> Maybe v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v+alter :: (Hashable k) => (Maybe v -> Maybe v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v alter f k = InsOrdHashMap . InsOrdHashMap.alter f k . unCompatInsOrdHashMap -member :: Hashable k => k -> InsOrdHashMap k v -> Bool+member :: (Hashable k) => k -> InsOrdHashMap k v -> Bool member k = InsOrdHashMap.member k . unCompatInsOrdHashMap -lookup :: Hashable k => k -> InsOrdHashMap k v -> Maybe v+lookup :: (Hashable k) => k -> InsOrdHashMap k v -> Maybe v lookup k = InsOrdHashMap.lookup k . unCompatInsOrdHashMap -lookupDefault :: Hashable k => v -> k -> InsOrdHashMap k v -> v+lookupDefault :: (Hashable k) => v -> k -> InsOrdHashMap k v -> v lookupDefault k def = InsOrdHashMap.lookupDefault k def . unCompatInsOrdHashMap  -- * Combine -union :: Hashable k => InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v+union :: (Hashable k) => InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v union m1 m2 = InsOrdHashMap (InsOrdHashMap.union (unCompatInsOrdHashMap m1) (unCompatInsOrdHashMap m2)) -unionWith :: Hashable k => (v -> v -> v) -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v+unionWith :: (Hashable k) => (v -> v -> v) -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v unionWith f m1 m2 = InsOrdHashMap (InsOrdHashMap.unionWith f (unCompatInsOrdHashMap m1) (unCompatInsOrdHashMap m2)) -unionWithKey :: Hashable k => (k -> v -> v -> v) -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v+unionWithKey :: (Hashable k) => (k -> v -> v -> v) -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v unionWithKey f m1 m2 = InsOrdHashMap (InsOrdHashMap.unionWithKey f (unCompatInsOrdHashMap m1) (unCompatInsOrdHashMap m2)) -unions :: Hashable k => [InsOrdHashMap k v] -> InsOrdHashMap k v+unions :: (Hashable k) => [InsOrdHashMap k v] -> InsOrdHashMap k v unions = InsOrdHashMap . InsOrdHashMap.unions . Prelude.map unCompatInsOrdHashMap  -------------------------------------------------------------------------------+ -- * Transformations+ -------------------------------------------------------------------------------  map :: (v -> v) -> InsOrdHashMap k v -> InsOrdHashMap k v map f = InsOrdHashMap . InsOrdHashMap.map f . unCompatInsOrdHashMap -mapKeys :: Hashable k => (k -> k) -> InsOrdHashMap k v -> InsOrdHashMap k v+mapKeys :: (Hashable k) => (k -> k) -> InsOrdHashMap k v -> InsOrdHashMap k v mapKeys f = InsOrdHashMap . InsOrdHashMap.mapKeys f . unCompatInsOrdHashMap  traverseKeys :: (Applicative f, Hashable k) => (k -> f k) -> InsOrdHashMap k v -> f (InsOrdHashMap k v)@@ -363,23 +355,27 @@ unorderedTraverseWithKey f = fmap InsOrdHashMap . InsOrdHashMap.unorderedTraverseWithKey f . unCompatInsOrdHashMap  -------------------------------------------------------------------------------+ -- * Difference and intersection+ ------------------------------------------------------------------------------- -difference :: Hashable k => InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v+difference :: (Hashable k) => InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v difference m1 m2 = InsOrdHashMap (InsOrdHashMap.difference (unCompatInsOrdHashMap m1) (unCompatInsOrdHashMap m2)) -intersection :: Hashable k => InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v+intersection :: (Hashable k) => InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v intersection m1 m2 = InsOrdHashMap (InsOrdHashMap.intersection (unCompatInsOrdHashMap m1) (unCompatInsOrdHashMap m2)) -intersectionWith :: Hashable k => (v -> v -> v) -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v+intersectionWith :: (Hashable k) => (v -> v -> v) -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v intersectionWith f m1 m2 = InsOrdHashMap (InsOrdHashMap.intersectionWith f (unCompatInsOrdHashMap m1) (unCompatInsOrdHashMap m2)) -intersectionWithKey :: Hashable k => (k -> v -> v -> v) -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v+intersectionWithKey :: (Hashable k) => (k -> v -> v -> v) -> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v intersectionWithKey f m1 m2 = InsOrdHashMap (InsOrdHashMap.intersectionWithKey f (unCompatInsOrdHashMap m1) (unCompatInsOrdHashMap m2))  -------------------------------------------------------------------------------+ -- * Folds+ -------------------------------------------------------------------------------  foldl' :: (a -> v -> a) -> a -> InsOrdHashMap k v -> a@@ -388,7 +384,7 @@ foldlWithKey' :: (a -> k -> v -> a) -> a -> InsOrdHashMap k v -> a foldlWithKey' f z = InsOrdHashMap.foldlWithKey' f z . unCompatInsOrdHashMap -foldMapWithKey :: Monoid m => (k -> v -> m) -> InsOrdHashMap k v -> m+foldMapWithKey :: (Monoid m) => (k -> v -> m) -> InsOrdHashMap k v -> m foldMapWithKey f = InsOrdHashMap.foldMapWithKey f . unCompatInsOrdHashMap  foldrWithKey :: (k -> v -> a -> a) -> a -> InsOrdHashMap k v -> a@@ -396,14 +392,16 @@  -- ** Unordered -unorderedFoldMap :: Monoid m => (v -> m) -> InsOrdHashMap k v -> m+unorderedFoldMap :: (Monoid m) => (v -> m) -> InsOrdHashMap k v -> m unorderedFoldMap f = InsOrdHashMap.unorderedFoldMap f . unCompatInsOrdHashMap -unorderedFoldMapWithKey :: Monoid m => (k -> v -> m) -> InsOrdHashMap k v -> m+unorderedFoldMapWithKey :: (Monoid m) => (k -> v -> m) -> InsOrdHashMap k v -> m unorderedFoldMapWithKey f = InsOrdHashMap.unorderedFoldMapWithKey f . unCompatInsOrdHashMap  -------------------------------------------------------------------------------+ -- * Filter+ -------------------------------------------------------------------------------  filter :: (v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v@@ -419,7 +417,9 @@ mapMaybeWithKey f = InsOrdHashMap . InsOrdHashMap.mapMaybeWithKey f . unCompatInsOrdHashMap  -------------------------------------------------------------------------------+ -- * Conversions+ -------------------------------------------------------------------------------  keys :: InsOrdHashMap k v -> [k]@@ -431,7 +431,7 @@ toRevList :: InsOrdHashMap k v -> [(k, v)] toRevList = InsOrdHashMap.toRevList . unCompatInsOrdHashMap -fromList :: Hashable k => [(k, v)] -> InsOrdHashMap k v+fromList :: (Hashable k) => [(k, v)] -> InsOrdHashMap k v fromList = InsOrdHashMap . InsOrdHashMap.fromList  toList :: InsOrdHashMap k v -> [(k, v)]@@ -444,10 +444,10 @@ fromHashMap = InsOrdHashMap . InsOrdHashMap.fromHashMap  -------------------------------------------------------------------------------+ -- * Debugging+ -------------------------------------------------------------------------------  valid :: (Eq k, Hashable k) => InsOrdHashMap k v -> Bool valid = InsOrdHashMap.valid . unCompatInsOrdHashMap--#endif

@@ -0,0 +1,646 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}++-- | Vendored from @insert-ordered-containers-0.3.0@.+--+-- Copyright (c) 2015-2026 Oleg Grenrus+-- Licensed under BSD-3-Clause; see+-- @LICENSES/insert-ordered-containers-BSD-3-Clause.txt@.+--+-- 'InsOrdHashMap' is like 'HashMap', but it folds and traverses in insertion order.+-- This module interface mimics "Data.HashMap.Strict", with some additions.+module Data.HashMap.Strict.InsOrd.Compat.Impl+  ( InsOrdHashMap,++    -- * Construction+    empty,+    singleton,++    -- * Basic interface+    null,+    size,+    member,+    lookup,+    lookupDefault,+    insert,+    insertWith,+    delete,+    adjust,+    update,+    alter,++    -- * Combine+    union,+    unionWith,+    unionWithKey,+    unions,++    -- * Transformations+    map,+    mapKeys,+    traverseKeys,+    mapWithKey,+    traverseWithKey,++    -- ** Unordered+    unorderedTraverse,+    unorderedTraverseWithKey,++    -- * Difference and intersection+    difference,+    intersection,+    intersectionWith,+    intersectionWithKey,++    -- * Folds+    foldl',+    foldlWithKey',+    foldr,+    foldrWithKey,+    foldMapWithKey,++    -- ** Unordered+    unorderedFoldMap,+    unorderedFoldMapWithKey,++    -- * Filter+    filter,+    filterWithKey,+    mapMaybe,+    mapMaybeWithKey,++    -- * Conversions+    keys,+    elems,+    toList,+    toRevList,+    fromList,+    toHashMap,+    fromHashMap,++    -- * Lenses+    hashMap,+    unorderedTraversal,++    -- * Debugging+    valid,+  )+where++import Control.Applicative (Applicative, Const (..))+import Control.Arrow (first, second)+import Control.Lens+  ( At (..),+    FoldableWithIndex (..),+    FunctorWithIndex (..),+    Index,+    Iso,+    IxValue,+    Ixed (..),+    TraversableWithIndex (..),+    Traversal,+    iso,+    (<&>),+    _1,+    _2,+  )+import Control.Monad.Trans.State.Strict (State, runState, state)+import Data.Data (Data)+import Data.Foldable (Foldable (foldMap))+import Data.Foldable qualified as F+import Data.HashMap.InsOrd.Compat.Internal+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.Hashable (Hashable (..))+import Data.List (nub, sortBy)+import Data.Maybe (fromMaybe)+import Data.Monoid (Monoid, mempty)+import Data.Ord (comparing)+import Data.Semigroup (Semigroup (..))+import Data.Traversable (Traversable (traverse))+import GHC.Exts qualified as Exts+import Text.ParserCombinators.ReadPrec (prec)+import Text.Read+  ( Lexeme (..),+    Read (..),+    lexP,+    parens,+    readListPrecDefault,+  )+import Text.Show (Show (..), showParen, showString)+import Prelude+  ( Bool (..),+    Eq,+    Functor,+    Int,+    Maybe (..),+    all,+    const,+    flip,+    fmap,+    fst,+    maybe,+    otherwise,+    pure,+    return,+    snd,+    uncurry,+    ($),+    (&&),+    (+),+    (.),+    (<),+    (<$>),+    (==),+    (>),+    (>=),+    (>>=),+    (||),+  )++-------------------------------------------------------------------------------+-- Strict Pair Int a+-------------------------------------------------------------------------------++data P a = P !Int !a+  deriving (Functor, Foldable, Traversable, Data)++getPK :: P a -> Int+getPK (P i _) = i+{-# INLINEABLE getPK #-}++getPV :: P a -> a+getPV (P _ a) = a+{-# INLINEABLE getPV #-}++incPK :: Int -> P a -> P a+incPK i (P j x) = P (i + j) x+{-# INLINEABLE incPK #-}++instance (Eq a) => Eq (P a) where+  P _ a == P _ b = a == b++instance (Show a) => Show (P a) where+  showsPrec d (P _ x) = showsPrec d x++instance (Hashable a) => Hashable (P a) where+  hashWithSalt salt (P _ x) = hashWithSalt salt x++-------------------------------------------------------------------------------+-- InsOrdHashMap+-------------------------------------------------------------------------------++-- | 'HashMap' which tries its best to remember insertion order of elements.+data InsOrdHashMap k v = InsOrdHashMap+  { _getIndex :: !Int,+    getInsOrdHashMap :: !(HashMap k (P v))+  }+  deriving (Functor, Data)++instance (Eq k, Eq v) => Eq (InsOrdHashMap k v) where+  a == b = toList a == toList b++instance (Show k, Show v) => Show (InsOrdHashMap k v) where+  showsPrec d m =+    showParen (d > 10) $+      showString "fromList " . showsPrec 11 (toList m)++instance (Eq k, Hashable k, Read k, Read v) => Read (InsOrdHashMap k v) where+  readPrec = parens $ prec 10 $ do+    Ident "fromList" <- lexP+    xs <- readPrec+    return (fromList xs)++  readListPrec = readListPrecDefault++instance (Eq k, Hashable k) => Semigroup (InsOrdHashMap k v) where+  (<>) = union++instance (Eq k, Hashable k) => Monoid (InsOrdHashMap k v) where+  mempty = empty++-- We cannot derive this, as we want to ordered folding and traversing+instance Foldable (InsOrdHashMap k) where+  -- in newer base only+  -- length = length . getInsOrdHashMap+  foldMap f = foldMap (f . snd) . toList++  null = null+  toList = elems+  length = size++instance Traversable (InsOrdHashMap k) where+  traverse f m = traverseWithKey (\_ -> f) m++-- | @hashWithSalt salt . toHashMap = hashWithSalt salt@.+instance (Hashable k, Hashable v) => Hashable (InsOrdHashMap k v) where+  hashWithSalt salt (InsOrdHashMap _ m) =+    hashWithSalt salt m++instance (Eq k, Hashable k) => Exts.IsList (InsOrdHashMap k v) where+  type Item (InsOrdHashMap k v) = (k, v)+  fromList = fromList+  toList = toList++-------------------------------------------------------------------------------+-- indexed-traversals+-------------------------------------------------------------------------------++instance (Eq k, Hashable k) => FunctorWithIndex k (InsOrdHashMap k) where+  imap = mapWithKey++instance (Eq k, Hashable k) => FoldableWithIndex k (InsOrdHashMap k) where+  ifoldMap = foldMapWithKey+  ifoldr = foldrWithKey++instance (Eq k, Hashable k) => TraversableWithIndex k (InsOrdHashMap k) where+  itraverse = traverseWithKey++-------------------------------------------------------------------------------+-- Lens+-------------------------------------------------------------------------------++type instance Index (InsOrdHashMap k v) = k++type instance IxValue (InsOrdHashMap k v) = v++instance (Eq k, Hashable k) => Ixed (InsOrdHashMap k v) where+  ix k f m = ixImpl k pure f m+  {-# INLINEABLE ix #-}++ixImpl ::+  (Eq k, Hashable k, Functor f) =>+  k ->+  (InsOrdHashMap k v -> f (InsOrdHashMap k v)) ->+  (v -> f v) ->+  InsOrdHashMap k v ->+  f (InsOrdHashMap k v)+ixImpl k point f m = case lookup k m of+  Just v -> f v <&> \v' -> insert k v' m+  Nothing -> point m+{-# INLINE ixImpl #-}++instance (Eq k, Hashable k) => At (InsOrdHashMap k a) where+  at k f m =+    f mv <&> \r -> case r of+      Nothing -> maybe m (const (delete k m)) mv+      Just v' -> insert k v' m+    where+      mv = lookup k m+  {-# INLINEABLE at #-}++-- | This is a slight lie, as roundtrip doesn't preserve ordering.+hashMap :: Iso (InsOrdHashMap k a) (InsOrdHashMap k b) (HashMap k a) (HashMap k b)+hashMap = iso toHashMap fromHashMap++unorderedTraversal :: Traversal (InsOrdHashMap k a) (InsOrdHashMap k b) a b+unorderedTraversal = hashMap . traverse++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++empty :: InsOrdHashMap k v+empty = InsOrdHashMap 0 HashMap.empty+{-# INLINEABLE empty #-}++singleton :: (Hashable k) => k -> v -> InsOrdHashMap k v+singleton k v = InsOrdHashMap 1 (HashMap.singleton k (P 0 v))+{-# INLINEABLE singleton #-}++-------------------------------------------------------------------------------+-- Basic interface+-------------------------------------------------------------------------------++null :: InsOrdHashMap k v -> Bool+null = HashMap.null . getInsOrdHashMap+{-# INLINEABLE null #-}++size :: InsOrdHashMap k v -> Int+size = HashMap.size . getInsOrdHashMap+{-# INLINEABLE size #-}++member :: (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool+member k = HashMap.member k . getInsOrdHashMap+{-# INLINEABLE member #-}++lookup :: (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v+lookup k = fmap getPV . HashMap.lookup k . getInsOrdHashMap+{-# INLINEABLE lookup #-}++lookupDefault ::+  (Eq k, Hashable k) =>+  -- | Default value to return.+  v ->+  k ->+  InsOrdHashMap k v ->+  v+lookupDefault def k m = fromMaybe def $ lookup k m+{-# INLINEABLE lookupDefault #-}++delete :: (Eq k, Hashable k) => k -> InsOrdHashMap k v -> InsOrdHashMap k v+delete k (InsOrdHashMap i m) = InsOrdHashMap i $ HashMap.delete k m+{-# INLINEABLE delete #-}++insert :: (Eq k, Hashable k) => k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v+insert = insertWith const+{-# INLINEABLE insert #-}++insertWith ::+  (Eq k, Hashable k) =>+  (v -> v -> v) -> k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v+insertWith f k v = alter (Just . maybe v (f v)) k+{-# INLINEABLE insertWith #-}++adjust ::+  (Eq k, Hashable k) =>+  (v -> v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v+adjust f = alter (fmap f)+{-# INLINEABLE adjust #-}++update ::+  (Eq k, Hashable k) =>+  (a -> Maybe a) -> k -> InsOrdHashMap k a -> InsOrdHashMap k a+update f = alter (>>= f)+{-# INLINEABLE update #-}++alter ::+  (Eq k, Hashable k) =>+  (Maybe v -> Maybe v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v+alter f k insm@(InsOrdHashMap j m) =+  case HashMap.lookup k m of+    Nothing -> case f Nothing of+      Nothing -> insm+      Just v -> InsOrdHashMap (j + 1) (HashMap.insert k (P j v) m)+    Just (P i v) -> case f (Just v) of+      Nothing -> InsOrdHashMap j (HashMap.delete k m)+      Just u -> InsOrdHashMap j (HashMap.insert k (P i u) m)+{-# INLINEABLE alter #-}++-------------------------------------------------------------------------------+-- Combine+-------------------------------------------------------------------------------++-- | The union of two maps.  If a key occurs in both maps,+-- the provided function (first argument) will be used to compute the result.+--+-- Ordered traversal will go thru keys in the first map first.+unionWith ::+  (Eq k, Hashable k) =>+  (v -> v -> v) ->+  InsOrdHashMap k v ->+  InsOrdHashMap k v ->+  InsOrdHashMap k v+unionWith f (InsOrdHashMap i a) (InsOrdHashMap j b) =+  mk $ HashMap.unionWith f' a b'+  where+    -- the threshold is arbitrary, it meant to amortise need for packing of indices+    mk+      | i > 0xfffff || j >= 0xfffff = fromHashMapP+      | otherwise = InsOrdHashMap (i + j)+    b' = fmap (incPK i) b+    f' (P ii x) (P _ y) = P ii (f x y)++unionWithKey ::+  (Eq k, Hashable k) =>+  (k -> v -> v -> v) ->+  InsOrdHashMap k v ->+  InsOrdHashMap k v ->+  InsOrdHashMap k v+unionWithKey f (InsOrdHashMap i a) (InsOrdHashMap j b) =+  InsOrdHashMap (i + j) $ HashMap.unionWithKey f' a b'+  where+    b' = fmap (incPK i) b+    f' k (P ii x) (P _ y) = P ii (f k x y)++union ::+  (Eq k, Hashable k) =>+  InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v+union = unionWith const++unions ::+  (Eq k, Hashable k, Foldable f) =>+  f (InsOrdHashMap k v) -> InsOrdHashMap k v+unions = F.foldl' union empty++-------------------------------------------------------------------------------+-- Transformations+-------------------------------------------------------------------------------++-- | Order preserving mapping of keys.+mapKeys :: (Eq k', Hashable k') => (k -> k') -> InsOrdHashMap k v -> InsOrdHashMap k' v+mapKeys f (InsOrdHashMap i m) =+  InsOrdHashMap i $+    HashMap.fromList . fmap (first f) . HashMap.toList $+      m++traverseKeys ::+  (Eq k', Hashable k', Applicative f) =>+  (k -> f k') -> InsOrdHashMap k v -> f (InsOrdHashMap k' v)+traverseKeys f (InsOrdHashMap i m) =+  InsOrdHashMap i . HashMap.fromList+    <$> (traverse . _1) f (HashMap.toList m)++map :: (v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2+map = fmap++mapWithKey :: (k -> v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2+mapWithKey f (InsOrdHashMap i m) =+  InsOrdHashMap i $ HashMap.mapWithKey f' m+  where+    f' k (P j x) = P j (f k x)++foldMapWithKey :: (Monoid m) => (k -> a -> m) -> InsOrdHashMap k a -> m+foldMapWithKey f = foldMap (uncurry f) . toList++traverseWithKey :: (Applicative f) => (k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b)+traverseWithKey f (InsOrdHashMap n m) =+  InsOrdHashMap n+    <$> retractSortedAp+      (HashMap.traverseWithKey (\k (P i v) -> liftSortedAp i (P i <$> f k v)) m)++-------------------------------------------------------------------------------+-- Unordered+-------------------------------------------------------------------------------++-- | More efficient than 'foldMap', when folding in insertion order is not important.+unorderedFoldMap :: (Monoid m) => (a -> m) -> InsOrdHashMap k a -> m+unorderedFoldMap f (InsOrdHashMap _ m) = foldMap (f . getPV) m++-- | More efficient than 'foldMapWithKey', when folding in insertion order is not important.+unorderedFoldMapWithKey :: (Monoid m) => (k -> a -> m) -> InsOrdHashMap k a -> m+unorderedFoldMapWithKey f m =+  getConst (unorderedTraverseWithKey (\k a -> Const (f k a)) m)++-- | More efficient than 'traverse', when traversing in insertion order is not important.+unorderedTraverse :: (Applicative f) => (a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b)+unorderedTraverse f (InsOrdHashMap i m) =+  InsOrdHashMap i <$> (traverse . traverse) f m++-- | More efficient than `traverseWithKey`, when traversing in insertion order is not important.+unorderedTraverseWithKey :: (Applicative f) => (k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b)+unorderedTraverseWithKey f (InsOrdHashMap i m) =+  InsOrdHashMap i <$> HashMap.traverseWithKey f' m+  where+    f' k (P j x) = P j <$> f k x++-------------------------------------------------------------------------------+-- Difference and intersection+-------------------------------------------------------------------------------++difference ::+  (Eq k, Hashable k) =>+  InsOrdHashMap k v -> InsOrdHashMap k w -> InsOrdHashMap k v+difference (InsOrdHashMap i a) (InsOrdHashMap _ b) =+  InsOrdHashMap i $ HashMap.difference a b++intersection ::+  (Eq k, Hashable k) =>+  InsOrdHashMap k v -> InsOrdHashMap k w -> InsOrdHashMap k v+intersection = intersectionWith const++intersectionWith ::+  (Eq k, Hashable k) =>+  (v1 -> v2 -> v3) ->+  InsOrdHashMap k v1 ->+  InsOrdHashMap k v2 ->+  InsOrdHashMap k v3+intersectionWith f = intersectionWithKey (\_ -> f)++intersectionWithKey ::+  (Eq k, Hashable k) =>+  (k -> v1 -> v2 -> v3) ->+  InsOrdHashMap k v1 ->+  InsOrdHashMap k v2 ->+  InsOrdHashMap k v3+intersectionWithKey f (InsOrdHashMap i a) (InsOrdHashMap _ b) =+  InsOrdHashMap i $ HashMap.intersectionWithKey f' a b+  where+    f' k (P j x) (P _ y) = P j (f k x y)++-------------------------------------------------------------------------------+-- Folds+-------------------------------------------------------------------------------++foldl' :: (a -> v -> a) -> a -> InsOrdHashMap k v -> a+foldl' f x = F.foldl' f' x . toList+  where+    f' a (_, v) = f a v++foldlWithKey' :: (a -> k -> v -> a) -> a -> InsOrdHashMap k v -> a+foldlWithKey' f x = F.foldl' f' x . toList+  where+    f' a (k, v) = f a k v++foldr :: (v -> a -> a) -> a -> InsOrdHashMap k v -> a+foldr f x = F.foldr f' x . toList+  where+    f' (_, v) a = f v a++foldrWithKey :: (k -> v -> a -> a) -> a -> InsOrdHashMap k v -> a+foldrWithKey f x = F.foldr f' x . toList+  where+    f' (k, v) a = f k v a++-------------------------------------------------------------------------------+-- Filter+-------------------------------------------------------------------------------++filter :: (v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v+filter f (InsOrdHashMap i m) =+  InsOrdHashMap i $ HashMap.filter (f . getPV) m++filterWithKey :: (k -> v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v+filterWithKey f (InsOrdHashMap i m) =+  InsOrdHashMap i $ HashMap.filterWithKey f' m+  where+    f' k (P _ x) = f k x++mapMaybe :: (v1 -> Maybe v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2+mapMaybe f (InsOrdHashMap i m) = InsOrdHashMap i $ HashMap.mapMaybe f' m+  where+    f' (P j x) = P j <$> f x++mapMaybeWithKey :: (k -> v1 -> Maybe v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2+mapMaybeWithKey f (InsOrdHashMap i m) =+  InsOrdHashMap i $ HashMap.mapMaybeWithKey f' m+  where+    f' k (P j x) = P j <$> f k x++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++keys :: InsOrdHashMap k v -> [k]+keys = fmap fst . toList+{-# INLINEABLE keys #-}++elems :: InsOrdHashMap k v -> [v]+elems = fmap snd . toList+{-# INLINEABLE elems #-}++fromList :: forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v+fromList =+  mk+    . flip runState 0+    . (traverse . _2) newP+  where+    mk :: ([(k, P v)], Int) -> InsOrdHashMap k v+    mk (m, i) = InsOrdHashMap i (HashMap.fromList m)++toList :: InsOrdHashMap k v -> [(k, v)]+toList =+  fmap (second getPV)+    . sortBy (comparing (getPK . snd))+    . HashMap.toList+    . getInsOrdHashMap++toRevList :: InsOrdHashMap k v -> [(k, v)]+toRevList =+  fmap (second getPV)+    . sortBy (flip $ comparing (getPK . snd))+    . HashMap.toList+    . getInsOrdHashMap++fromHashMap :: HashMap k v -> InsOrdHashMap k v+fromHashMap = mk . flip runState 0 . traverse newP+  where+    mk (m, i) = InsOrdHashMap i m++toHashMap :: InsOrdHashMap k v -> HashMap k v+toHashMap (InsOrdHashMap _ m) = fmap getPV m++-------------------------------------------------------------------------------+-- Internal+-------------------------------------------------------------------------------++-- TODO: more efficient way is to do two traversals+-- - collect the indexes+-- - pack the indexes (Map old new)+-- - traverse second time, changing the indexes+fromHashMapP :: HashMap k (P v) -> InsOrdHashMap k v+fromHashMapP = mk . flip runState 0 . retractSortedAp . traverse f+  where+    mk (m, i) = InsOrdHashMap i m+    f (P i v) = liftSortedAp i (newP v)++-- | Test if the internal map structure is valid.+valid :: InsOrdHashMap k v -> Bool+valid (InsOrdHashMap i m) = indexesDistinct && indexesSmaller+  where+    indexes :: [Int]+    indexes = getPK <$> HashMap.elems m++    indexesDistinct = indexes == nub indexes+    indexesSmaller = all (< i) indexes++newP :: a -> State Int (P a)+newP x = state $ \s -> (P s x, s + 1)

@@ -0,0 +1,365 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}++-- | Vendored from @insert-ordered-containers-0.3.0@.+--+-- Copyright (c) 2015-2026 Oleg Grenrus+-- Licensed under BSD-3-Clause; see+-- @LICENSES/insert-ordered-containers-BSD-3-Clause.txt@.+--+-- 'InsOrdHashSet' is like 'HashSet', but it folds in insertion order.+-- This module interface mimics "Data.HashSet", with some additions.+module Data.HashSet.InsOrd.Compat+  ( InsOrdHashSet,++    -- * Construction+    empty,+    singleton,++    -- * Basic interface+    null,+    size,+    member,+    insert,+    delete,++    -- * Combine+    union,++    -- * Transformations+    map,++    -- ** Unordered++    -- * Difference and intersection+    difference,+    intersection,++    -- * Folds++    -- ** Unordered++    -- * Filter+    filter,++    -- * Conversions+    toList,+    fromList,+    toHashSet,+    fromHashSet,++    -- * Lenses+    hashSet,++    -- * Debugging+    valid,+  )+where++import Control.Arrow (first)+import Control.DeepSeq (NFData (..))+import Control.DeepSeq qualified as NF+import Control.Lens+  ( At (..),+    Contains (..),+    Index,+    Iso',+    IxValue,+    Ixed (..),+    iso,+    (<&>),+  )+import Control.Lens qualified as Lens+import Control.Monad.Trans.State.Strict (State, runState, state)+import Data.Aeson qualified as A+import Data.Data (Data)+import Data.Foldable (Foldable (foldMap), all)+import Data.Foldable qualified+import Data.HashMap.InsOrd.Compat.Internal+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.HashSet (HashSet)+import Data.HashSet qualified as HashSet+import Data.Hashable (Hashable (..))+import Data.List (nub, sortBy)+import Data.Monoid (Monoid (..))+import Data.Ord (comparing)+import Data.Semigroup (Semigroup (..))+import Data.Traversable (Traversable (traverse))+import GHC.Exts qualified as Exts+import Text.ParserCombinators.ReadPrec (prec)+import Text.Read+  ( Lexeme (..),+    Read (..),+    lexP,+    parens,+    readListPrecDefault,+  )+import Text.Show (Show (..), showParen, showString)+import Prelude+  ( Bool,+    Eq ((==)),+    Int,+    Maybe (..),+    const,+    flip,+    fmap,+    fst,+    maybe,+    otherwise,+    return,+    snd,+    ($),+    (&&),+    (+),+    (.),+    (<),+    (<$),+    (<$>),+    (>),+    (>=),+    (||),+  )++-------------------------------------------------------------------------------+-- InsOrdHashSet+-------------------------------------------------------------------------------++-- | 'HashSet' which tries its best to remember insertion order of elements.+data InsOrdHashSet k = InsOrdHashSet+  { _getIndex :: !Int,+    getInsOrdHashSet :: !(HashMap k Int)+  }+  deriving (Data)++-- | @since 0.2.5+instance (NFData k) => NFData (InsOrdHashSet k) where+  rnf (InsOrdHashSet _ hs) = rnf hs++-- | @since 0.2.5+instance NF.NFData1 InsOrdHashSet where+  liftRnf rnf1 (InsOrdHashSet _ m) = NF.liftRnf2 rnf1 rnf m++instance (Eq k) => Eq (InsOrdHashSet k) where+  InsOrdHashSet _ a == InsOrdHashSet _ b = a == b++instance (Show k) => Show (InsOrdHashSet k) where+  showsPrec d m =+    showParen (d > 10) $+      showString "fromList " . showsPrec 11 (toList m)++instance (Eq k, Hashable k, Read k) => Read (InsOrdHashSet k) where+  readPrec = parens $ prec 10 $ do+    Ident "fromList" <- lexP+    xs <- readPrec+    return (fromList xs)++  readListPrec = readListPrecDefault++instance (Eq k, Hashable k) => Semigroup (InsOrdHashSet k) where+  (<>) = union++instance (Eq k, Hashable k) => Monoid (InsOrdHashSet k) where+  mempty = empty++instance Foldable InsOrdHashSet where+  -- in newer base only+  -- length = length . getInsOrdHashSet+  foldMap f = foldMap f . toList++  null = null+  toList = toList+  length = size++-- | @'hashWithSalt' salt . 'toHashSet' = 'hashWithSalt' salt@.+instance (Hashable k) => Hashable (InsOrdHashSet k) where+  hashWithSalt salt (InsOrdHashSet _ m) =+    hashWithSalt salt m++instance (Eq k, Hashable k) => Exts.IsList (InsOrdHashSet k) where+  type Item (InsOrdHashSet k) = k+  fromList = fromList+  toList = toList++-------------------------------------------------------------------------------+-- Aeson+-------------------------------------------------------------------------------++instance (A.ToJSON a) => A.ToJSON (InsOrdHashSet a) where+  toJSON = A.toJSON . toList+  toEncoding = A.toEncoding . toList++instance (Eq a, Hashable a, A.FromJSON a) => A.FromJSON (InsOrdHashSet a) where+  parseJSON v = fromList <$> A.parseJSON v++-------------------------------------------------------------------------------+-- Lens+-------------------------------------------------------------------------------++type instance Index (InsOrdHashSet a) = a++type instance IxValue (InsOrdHashSet a) = ()++instance (Eq k, Hashable k) => Ixed (InsOrdHashSet k) where+  ix k f (InsOrdHashSet i m) = InsOrdHashSet i <$> ix k (\j -> j <$ f ()) m+  {-# INLINE ix #-}++instance (Eq k, Hashable k) => At (InsOrdHashSet k) where+  at k f m =+    f mv <&> \r -> case r of+      Nothing -> maybe m (const (delete k m)) mv+      Just () -> insert k m+    where+      mv = if member k m then Just () else Nothing+  {-# INLINE at #-}++instance (Eq a, Hashable a) => Contains (InsOrdHashSet a) where+  contains k f s =+    f (member k s) <&> \b ->+      if b then insert k s else delete k s+  {-# INLINE contains #-}++-- | This is a slight lie, as roundtrip doesn't preserve ordering.+hashSet :: Iso' (InsOrdHashSet a) (HashSet a)+hashSet = iso toHashSet fromHashSet++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++empty :: InsOrdHashSet k+empty = InsOrdHashSet 0 HashMap.empty+{-# INLINEABLE empty #-}++singleton :: (Hashable k) => k -> InsOrdHashSet k+singleton k = InsOrdHashSet 1 (HashMap.singleton k 0)+{-# INLINEABLE singleton #-}++-------------------------------------------------------------------------------+-- Basic interface+-------------------------------------------------------------------------------++null :: InsOrdHashSet k -> Bool+null = HashMap.null . getInsOrdHashSet+{-# INLINEABLE null #-}++size :: InsOrdHashSet k -> Int+size = HashMap.size . getInsOrdHashSet+{-# INLINEABLE size #-}++member :: (Eq k, Hashable k) => k -> InsOrdHashSet k -> Bool+member k = HashMap.member k . getInsOrdHashSet+{-# INLINEABLE member #-}++insert :: (Eq k, Hashable k) => k -> InsOrdHashSet k -> InsOrdHashSet k+insert k (InsOrdHashSet i m) = InsOrdHashSet (i + 1) (HashMap.insert k i m)++delete :: (Eq k, Hashable k) => k -> InsOrdHashSet k -> InsOrdHashSet k+delete k (InsOrdHashSet i m) = InsOrdHashSet i (HashMap.delete k m)++-------------------------------------------------------------------------------+-- Combine+-------------------------------------------------------------------------------++union ::+  (Eq k, Hashable k) =>+  InsOrdHashSet k -> InsOrdHashSet k -> InsOrdHashSet k+union (InsOrdHashSet i a) (InsOrdHashSet j b) =+  mk $ HashMap.union a b'+  where+    mk+      | i >= 0xfffff || j >= 0xfffff = fromHashMapInt+      | otherwise = InsOrdHashSet (i + j)++    b' = fmap (\k -> k + i + 1) b++-------------------------------------------------------------------------------+-- Transformations+-------------------------------------------------------------------------------++map :: (Hashable b, Eq b) => (a -> b) -> InsOrdHashSet a -> InsOrdHashSet b+map f (InsOrdHashSet i m) =+  InsOrdHashSet i $+    HashMap.fromList . fmap (first f) . HashMap.toList $+      m++-------------------------------------------------------------------------------+-- Difference and intersection+-------------------------------------------------------------------------------++difference :: (Eq a, Hashable a) => InsOrdHashSet a -> InsOrdHashSet a -> InsOrdHashSet a+difference (InsOrdHashSet i a) (InsOrdHashSet _ b) =+  InsOrdHashSet i $ HashMap.difference a b++intersection :: (Eq a, Hashable a) => InsOrdHashSet a -> InsOrdHashSet a -> InsOrdHashSet a+intersection (InsOrdHashSet i a) (InsOrdHashSet _ b) =+  InsOrdHashSet i $ HashMap.intersection a b++-------------------------------------------------------------------------------+-- Filter+-------------------------------------------------------------------------------++filter :: (a -> Bool) -> InsOrdHashSet a -> InsOrdHashSet a+filter p (InsOrdHashSet i m) =+  InsOrdHashSet i $+    HashMap.filterWithKey (\k _ -> p k) m++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++fromList :: (Eq k, Hashable k) => [k] -> InsOrdHashSet k+fromList = mk . flip runState 0 . traverse newInt+  where+    mk (m, i) = InsOrdHashSet i (HashMap.fromList m)++toList :: InsOrdHashSet k -> [k]+toList =+  fmap fst+    . sortBy (comparing snd)+    . HashMap.toList+    . getInsOrdHashSet++fromHashSet :: HashSet k -> InsOrdHashSet k+fromHashSet = mk . flip runState 0 . traverse (const newInt') . HashSet.toMap+  where+    mk (m, i) = InsOrdHashSet i m++toHashSet :: InsOrdHashSet k -> HashSet k+toHashSet (InsOrdHashSet _ m) =+  HashMap.keysSet m++-------------------------------------------------------------------------------+-- Internal+-------------------------------------------------------------------------------++fromHashMapInt :: HashMap k Int -> InsOrdHashSet k+fromHashMapInt = mk . flip runState 0 . retractSortedAp . traverse f+  where+    mk (m, i) = InsOrdHashSet i m+    f i = liftSortedAp i newInt'++newInt :: a -> State Int (a, Int)+newInt a = state $ \s -> ((a, s), s + 1)++newInt' :: State Int Int+newInt' = state $ \s -> (s, s + 1)++-------------------------------------------------------------------------------+-- Valid+-------------------------------------------------------------------------------++-- | Test if the internal map structure is valid.+valid :: InsOrdHashSet a -> Bool+valid (InsOrdHashSet i m) = indexesDistinct && indexesSmaller+  where+    indexes :: [Int]+    indexes = HashMap.elems m++    indexesDistinct = indexes == nub indexes+    indexesSmaller = all (< i) indexes

@@ -34,7 +34,6 @@      -- * Re-exports     module Data.OpenApi.Lens,-    module Data.OpenApi.Optics,     module Data.OpenApi.Operation,     module Data.OpenApi.ParamSchema,     module Data.OpenApi.Schema,@@ -134,7 +133,6 @@ import Data.OpenApi.Internal import Data.OpenApi.Lens import Data.OpenApi.Operation-import Data.OpenApi.Optics () import Data.OpenApi.ParamSchema import Data.OpenApi.Schema import Data.OpenApi.Schema.Validation@@ -215,7 +213,7 @@  -- $lens ----- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.OpenApi.Optics".+-- Note: all accessors live in "Data.OpenApi.Lens" and are re-exported here. -- -- Since @'OpenApi'@ has a fairly complex structure, lenses and prisms are used -- to work comfortably with it. In combination with @'Monoid'@ instances, lenses

@@ -35,7 +35,7 @@ import Data.HashMap.Strict qualified as HashMap import Data.HashMap.Strict.InsOrd.Compat (InsOrdHashMap) import Data.HashMap.Strict.InsOrd.Compat qualified as InsOrdHashMap-import Data.HashSet.InsOrd (InsOrdHashSet)+import Data.HashSet.InsOrd.Compat (InsOrdHashSet) import Data.Hashable (Hashable (..)) import Data.Map (Map) import Data.Map qualified as Map

@@ -35,7 +35,7 @@ import Data.Char (isUpper, toLower) import Data.Foldable (foldl', traverse_) import Data.HashMap.Strict.InsOrd.Compat qualified as InsOrd-import Data.HashSet.InsOrd qualified as InsOrdHS+import Data.HashSet.InsOrd.Compat qualified as InsOrdHS import Data.OpenApi.Aeson.Compat (deleteKey, insertKey, keyToString, lookupKey, objectToList, stringToKey) import Data.Set qualified as Set import Data.Text (Text)

@@ -34,7 +34,7 @@ import Control.Lens import Data.Data.Lens import Data.HashMap.Strict.InsOrd.Compat qualified as InsOrdHashMap-import Data.HashSet.InsOrd qualified as InsOrdHS+import Data.HashSet.InsOrd.Compat qualified as InsOrdHS import Data.List.Compat import Data.Maybe (mapMaybe) import Data.OpenApi.Declare

@@ -1,379 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}---- |--- Module:      Data.OpenApi.Optics--- Maintainer:  Andrzej Rybczak <andrzej@rybczak.net>--- Stability:   experimental------ Lenses and prisms for the <https://hackage.haskell.org/package/optics optics>--- library.------ >>> import Data.Aeson--- >>> import Optics.Core--- >>> :set -XOverloadedLabels--- >>> import qualified Data.ByteString.Lazy.Char8 as BSL--- >>> import qualified Data.HashMap.Strict.InsOrd.Compat as IOHM------ Example from the "Data.OpenApi" module using @optics@:------ >>> :{--- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)---   & #components % #schemas .~ IOHM.fromList [ ("User", mempty & #type ?~ OpenApiString) ]---   & #paths .~---     IOHM.fromList [ ("/user", mempty & #get ?~ (mempty---         & at 200 ?~ ("OK" & #_Inline % #content % at "application/json" ?~ (mempty & #schema ?~ Ref (Reference "User")))---         & at 404 ?~ "User info not found")) ]--- :}--- {---     "components": {---         "schemas": {---             "User": {---                 "type": "string"---             }---         }---     },---     "info": {---         "title": "",---         "version": ""---     },---     "openapi": "3.1.0",---     "paths": {---         "/user": {---             "get": {---                 "responses": {---                     "200": {---                         "content": {---                             "application/json": {---                                 "schema": {---                                     "$ref": "#/components/schemas/User"---                                 }---                             }---                         },---                         "description": "OK"---                     },---                     "404": {---                         "description": "User info not found"---                     }---                 }---             }---         }---     }--- }------ For convenience optics are defined as /labels/. It means that field accessor--- names can be overloaded for different types. One such common field is--- @#description@. Many components of an OpenAPI specification can have--- descriptions, and you can use the same name for them:------ >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & #description .~ "No content"--- {---     "description": "No content"--- }--- >>> :{--- BSL.putStrLn $ encodePretty $ (mempty :: Schema)---   & #type        ?~ OpenApiBoolean---   & #description ?~ "To be or not to be"--- :}--- {---     "description": "To be or not to be",---     "type": "boolean"--- }------ Additionally, to simplify working with @'Response'@, both @'Operation'@ and--- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:------ >>> :{--- BSL.putStrLn $ encodePretty $ (mempty :: Operation)---   & at 404 ?~ "Not found"--- :}--- {---     "responses": {---         "404": {---             "description": "Not found"---         }---     }--- }-module Data.OpenApi.Optics () where--import Data.Aeson (Value)-import Data.OpenApi.Internal-import Data.OpenApi.Internal.Utils-import Data.Scientific (Scientific)-import Data.Text (Text)-import Optics.Core-import Optics.TH---- Lenses--makeFieldLabels ''OpenApi-makeFieldLabels ''Components-makeFieldLabels ''Server-makeFieldLabels ''ServerVariable-makeFieldLabels ''RequestBody-makeFieldLabels ''MediaTypeObject-makeFieldLabels ''Info-makeFieldLabels ''Contact-makeFieldLabels ''License-makeFieldLabels ''PathItem-makeFieldLabels ''Tag-makeFieldLabels ''Operation-makeFieldLabels ''Param-makeFieldLabels ''Header-makeFieldLabels ''Schema-makeFieldLabels ''NamedSchema-makeFieldLabels ''Xml-makeFieldLabels ''Responses-makeFieldLabels ''Response-makeFieldLabels ''SecurityScheme-makeFieldLabels ''ApiKeyParams-makeFieldLabels ''OAuth2ImplicitFlow-makeFieldLabels ''OAuth2PasswordFlow-makeFieldLabels ''OAuth2ClientCredentialsFlow-makeFieldLabels ''OAuth2AuthorizationCodeFlow-makeFieldLabels ''OAuth2Flow-makeFieldLabels ''OAuth2Flows-makeFieldLabels ''ExternalDocs-makeFieldLabels ''Encoding-makeFieldLabels ''Example-makeFieldLabels ''Discriminator-makeFieldLabels ''Link---- Prisms--makePrismLabels ''SecuritySchemeType-makePrismLabels ''Referenced---- OpenApiItems prisms--instance-  ( a ~ Bool,-    b ~ Bool-  ) =>-  LabelOptic-    "_OpenApiItemsBoolean"-    A_Review-    OpenApiItems-    OpenApiItems-    a-    b-  where-  labelOptic = unto (\x -> OpenApiItemsBoolean x)-  {-# INLINE labelOptic #-}--instance-  ( a ~ Referenced Schema,-    b ~ Referenced Schema-  ) =>-  LabelOptic-    "_OpenApiItemsObject"-    A_Review-    OpenApiItems-    OpenApiItems-    a-    b-  where-  labelOptic = unto (\x -> OpenApiItemsObject x)-  {-# INLINE labelOptic #-}---- =============================================================--- More helpful instances for easier access to schema properties--type instance Index Responses = HttpStatusCode--type instance Index Operation = HttpStatusCode--type instance IxValue Responses = Referenced Response--type instance IxValue Operation = Referenced Response--instance Ixed Responses where-  ix n = #responses % ix n-  {-# INLINE ix #-}--instance At Responses where-  at n = #responses % at n-  {-# INLINE at #-}--instance Ixed Operation where-  ix n = #responses % ix n-  {-# INLINE ix #-}--instance At Operation where-  at n = #responses % at n-  {-# INLINE at #-}---- #type--instance-  ( a ~ Maybe OpenApiTypeValue,-    b ~ Maybe OpenApiTypeValue-  ) =>-  LabelOptic "type" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #type-  {-# INLINE labelOptic #-}---- #default--instance-  ( a ~ Maybe Value,-    b ~ Maybe Value-  ) =>-  LabelOptic "default" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #default-  {-# INLINE labelOptic #-}---- #format--instance-  ( a ~ Maybe Format,-    b ~ Maybe Format-  ) =>-  LabelOptic "format" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #format-  {-# INLINE labelOptic #-}---- #items--instance-  ( a ~ Maybe OpenApiItems,-    b ~ Maybe OpenApiItems-  ) =>-  LabelOptic "items" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #items-  {-# INLINE labelOptic #-}---- #maximum--instance-  ( a ~ Maybe Scientific,-    b ~ Maybe Scientific-  ) =>-  LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #maximum-  {-# INLINE labelOptic #-}---- #exclusiveMaximum--instance-  ( a ~ Maybe Scientific,-    b ~ Maybe Scientific-  ) =>-  LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #exclusiveMaximum-  {-# INLINE labelOptic #-}---- #minimum--instance-  ( a ~ Maybe Scientific,-    b ~ Maybe Scientific-  ) =>-  LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #minimum-  {-# INLINE labelOptic #-}---- #exclusiveMinimum--instance-  ( a ~ Maybe Scientific,-    b ~ Maybe Scientific-  ) =>-  LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #exclusiveMinimum-  {-# INLINE labelOptic #-}---- #maxLength--instance-  ( a ~ Maybe Integer,-    b ~ Maybe Integer-  ) =>-  LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #maxLength-  {-# INLINE labelOptic #-}---- #minLength--instance-  ( a ~ Maybe Integer,-    b ~ Maybe Integer-  ) =>-  LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #minLength-  {-# INLINE labelOptic #-}---- #pattern--instance-  ( a ~ Maybe Text,-    b ~ Maybe Text-  ) =>-  LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #pattern-  {-# INLINE labelOptic #-}---- #maxItems--instance-  ( a ~ Maybe Integer,-    b ~ Maybe Integer-  ) =>-  LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #maxItems-  {-# INLINE labelOptic #-}---- #minItems--instance-  ( a ~ Maybe Integer,-    b ~ Maybe Integer-  ) =>-  LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #minItems-  {-# INLINE labelOptic #-}---- #uniqueItems--instance-  ( a ~ Maybe Bool,-    b ~ Maybe Bool-  ) =>-  LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #uniqueItems-  {-# INLINE labelOptic #-}---- #enum--instance-  ( a ~ Maybe [Value],-    b ~ Maybe [Value]-  ) =>-  LabelOptic "enum" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #enum-  {-# INLINE labelOptic #-}---- #multipleOf--instance-  ( a ~ Maybe Scientific,-    b ~ Maybe Scientific-  ) =>-  LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b-  where-  labelOptic = #schema % #multipleOf-  {-# INLINE labelOptic #-}

@@ -0,0 +1,181 @@+module Data.HashMap.Strict.InsOrd.CompatSpec where++import Control.Lens (at, ix, (%~), (&), (.~), (?~))+import Control.Monad.State.Strict (runState, state)+import Data.Aeson (eitherDecode, encode)+import Data.ByteString.Lazy.Char8 qualified as BSL+import Data.HashMap.Strict qualified as HashMap+import Data.HashMap.Strict.InsOrd.Compat qualified as InsOrd+import Data.Word (Word8)+import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck+import Test.QuickCheck.Function (Fun (..))++data Operation+  = FromList [(Word8, Int)]+  | Empty+  | Singleton Word8 Int+  | Insert Word8 Int Operation+  | Delete Word8 Operation+  | Alter Word8 (Fun (Maybe Int) (Maybe Int)) Operation+  | Union Operation Operation+  | Difference Operation Operation+  | Intersection Operation Operation+  | Filter (Fun Int Bool) Operation+  deriving (Show)++instance Arbitrary Operation where+  arbitrary = sized gen+    where+      terminals =+        [ FromList <$> arbitrary,+          pure Empty,+          Singleton <$> arbitrary <*> arbitrary+        ]+      gen 0 = oneof terminals+      gen n =+        oneof $+          terminals+            <> [ Insert <$> arbitrary <*> arbitrary <*> smaller,+                 Delete <$> arbitrary <*> smaller,+                 Alter <$> arbitrary <*> arbitrary <*> smaller,+                 Union <$> half <*> half,+                 Difference <$> half <*> half,+                 Intersection <$> half <*> half,+                 Filter <$> arbitrary <*> smaller+               ]+        where+          smaller = gen (n - 1)+          half = gen (n `div` 2)++evalInsOrd :: Operation -> InsOrd.InsOrdHashMap Word8 Int+evalInsOrd operation = case operation of+  FromList pairs -> InsOrd.fromList pairs+  Empty -> InsOrd.empty+  Singleton key value -> InsOrd.singleton key value+  Insert key value rest -> InsOrd.insert key value (evalInsOrd rest)+  Delete key rest -> InsOrd.delete key (evalInsOrd rest)+  Alter key (Fun _ f) rest -> InsOrd.alter f key (evalInsOrd rest)+  Union left right -> InsOrd.union (evalInsOrd left) (evalInsOrd right)+  Difference left right -> InsOrd.difference (evalInsOrd left) (evalInsOrd right)+  Intersection left right -> InsOrd.intersection (evalInsOrd left) (evalInsOrd right)+  Filter (Fun _ predicate) rest -> InsOrd.filter predicate (evalInsOrd rest)++evalHashMap :: Operation -> HashMap.HashMap Word8 Int+evalHashMap operation = case operation of+  FromList pairs -> HashMap.fromList pairs+  Empty -> HashMap.empty+  Singleton key value -> HashMap.singleton key value+  Insert key value rest -> HashMap.insert key value (evalHashMap rest)+  Delete key rest -> HashMap.delete key (evalHashMap rest)+  Alter key (Fun _ f) rest -> HashMap.alter f key (evalHashMap rest)+  Union left right -> HashMap.union (evalHashMap left) (evalHashMap right)+  Difference left right -> HashMap.difference (evalHashMap left) (evalHashMap right)+  Intersection left right -> HashMap.intersection (evalHashMap left) (evalHashMap right)+  Filter (Fun _ predicate) rest -> HashMap.filter predicate (evalHashMap rest)++prop_operationModel :: Operation -> Property+prop_operationModel operation =+  let actual = evalInsOrd operation+   in counterexample (show (InsOrd.toList actual)) $+        conjoin+          [ InsOrd.toHashMap actual === evalHashMap operation,+            property (InsOrd.valid actual)+          ]++prop_mapKeysModel :: [(Word8, Int)] -> Fun Word8 Word8 -> Property+prop_mapKeysModel pairs (Fun _ f) =+  let input = InsOrd.fromList pairs+      actual = InsOrd.mapKeys f input+      expected = HashMap.fromList [(f key, value) | (key, value) <- HashMap.toList (InsOrd.toHashMap input)]+   in conjoin+        [ InsOrd.toHashMap actual === expected,+          property (InsOrd.valid actual)+        ]++spec :: Spec+spec = do+  describe "operation model" $ do+    prop "matches Data.HashMap.Strict and preserves valid" prop_operationModel+    prop "matches HashMap collision semantics in mapKeys" prop_mapKeysModel++  describe "ordered map behavior" $ do+    it "keeps the last duplicate at the end" $+      InsOrd.toList (InsOrd.fromList [("a", 1 :: Int), ("b", 2), ("a", 3)])+        `shouldBe` [("b", 2), ("a", 3)]++    it "uses left-biased union and appends right-only keys" $+      InsOrd.toList+        ( InsOrd.union+            (InsOrd.fromList [("a", 1 :: Int), ("b", 2)])+            (InsOrd.fromList [("b", 9), ("c", 3)])+        )+        `shouldBe` [("a", 1), ("b", 2), ("c", 3)]++    it "combines existing values with insertWith" $+      InsOrd.toList (InsOrd.insertWith (+) "a" (4 :: Int) (InsOrd.fromList [("a", 3), ("b", 2)]))+        `shouldBe` [("a", 7), ("b", 2)]++    it "combines unions with their key and preserves union order" $+      InsOrd.toList+        ( InsOrd.unionWithKey+            (\key left right -> key <> ":" <> left <> right)+            (InsOrd.fromList [("a", "L"), ("b", "L")])+            (InsOrd.fromList [("b", "R"), ("c", "R")])+        )+        `shouldBe` [("a", "L"), ("b", "b:LR"), ("c", "R")]++    it "filters and transforms with mapMaybeWithKey in insertion order" $+      InsOrd.toList+        ( InsOrd.mapMaybeWithKey+            (\key value -> if key == "b" then Nothing else Just (value * 10))+            (InsOrd.fromList [("a", 1 :: Int), ("b", 2), ("c", 3)])+        )+        `shouldBe` [("a", 10), ("c", 30)]++    it "folds and traverses in insertion order" $ do+      let input = InsOrd.fromList [("b", 1 :: Int), ("a", 2), ("c", 3)]+          folded = InsOrd.foldrWithKey (\key value rest -> (key, value) : rest) [] input+          (traversed, visited) =+            runState+              (InsOrd.traverseWithKey (\key value -> state (\keys -> (value + 1, keys <> [key]))) input)+              []+      folded `shouldBe` InsOrd.toList input+      visited `shouldBe` ["b", "a", "c"]+      InsOrd.toList traversed `shouldBe` [("b", 2), ("a", 3), ("c", 4)]++    it "supports lens ix and at operations" $ do+      let input = InsOrd.fromList [("a", 1 :: Int), ("b", 2)]+      InsOrd.toList (input & ix "a" %~ (+ 10)) `shouldBe` [("a", 11), ("b", 2)]+      InsOrd.toList (input & at "b" .~ Nothing) `shouldBe` [("a", 1)]+      InsOrd.toList (input & at "c" ?~ 3) `shouldBe` [("a", 1), ("b", 2), ("c", 3)]++    it "round-trips through Show and Read with order intact" $ do+      let input = InsOrd.fromList [('b', 1 :: Int), ('a', 2)]+          output = read (show input) :: InsOrd.InsOrdHashMap Char Int+      InsOrd.toList output `shouldBe` InsOrd.toList input++    it "keeps order-insensitive compat equality" $ do+      let left = InsOrd.fromList [("a", 1 :: Int), ("b", 2)]+          right = InsOrd.fromList [("b", 2), ("a", 1)]+      left `shouldBe` right+      InsOrd.toList left `shouldNotBe` InsOrd.toList right++  describe "JSON compatibility" $ do+    it "encodes as an insertion-ordered object" $+      encode (InsOrd.fromList [("b", 1 :: Int), ("a", 2)])+        `shouldBe` BSL.pack "{\"b\":1,\"a\":2}"++    it "round-trips map contents semantically" $ do+      let input = InsOrd.fromList [("b", 1 :: Int), ("a", 2)]+          decoded = eitherDecode (encode input) :: Either String (InsOrd.InsOrdHashMap String Int)+      fmap InsOrd.toHashMap decoded `shouldBe` Right (InsOrd.toHashMap input)++  describe "upstream regressions" $+    it "avoids insertion-index overflow after repeated unions" $ do+      let base = InsOrd.fromList (zip "hello" "world")+          expanded = iterate (\value -> InsOrd.union value value) base !! 64+          final = InsOrd.insert '!' '!' expanded+      InsOrd.elems final `shouldBe` "wold!"+      InsOrd.valid final `shouldBe` True

@@ -0,0 +1,154 @@+module Data.HashSet.InsOrdSpec where++import Control.DeepSeq (force, rnf)+import Control.DeepSeq qualified as NF+import Control.Exception (evaluate)+import Control.Lens (at, contains, ix, (&), (.~), (?~), (^?))+import Data.Aeson (eitherDecode, encode)+import Data.ByteString.Lazy.Char8 qualified as BSL+import Data.HashSet qualified as HashSet+import Data.HashSet.InsOrd.Compat qualified as InsOrd+import Data.Word (Word8)+import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck+import Test.QuickCheck.Function (Fun (..))++data Operation+  = FromList [Word8]+  | Empty+  | Singleton Word8+  | Insert Word8 Operation+  | Delete Word8 Operation+  | Union Operation Operation+  | Difference Operation Operation+  | Intersection Operation Operation+  | Map (Fun Word8 Word8) Operation+  | Filter (Fun Word8 Bool) Operation+  deriving (Show)++instance Arbitrary Operation where+  arbitrary = sized gen+    where+      terminals =+        [ FromList <$> arbitrary,+          pure Empty,+          Singleton <$> arbitrary+        ]+      gen 0 = oneof terminals+      gen n =+        oneof $+          terminals+            <> [ Insert <$> arbitrary <*> smaller,+                 Delete <$> arbitrary <*> smaller,+                 Union <$> half <*> half,+                 Difference <$> half <*> half,+                 Intersection <$> half <*> half,+                 Map <$> arbitrary <*> smaller,+                 Filter <$> arbitrary <*> smaller+               ]+        where+          smaller = gen (n - 1)+          half = gen (n `div` 2)++evalInsOrd :: Operation -> InsOrd.InsOrdHashSet Word8+evalInsOrd operation = case operation of+  FromList values -> InsOrd.fromList values+  Empty -> InsOrd.empty+  Singleton value -> InsOrd.singleton value+  Insert value rest -> InsOrd.insert value (evalInsOrd rest)+  Delete value rest -> InsOrd.delete value (evalInsOrd rest)+  Union left right -> InsOrd.union (evalInsOrd left) (evalInsOrd right)+  Difference left right -> InsOrd.difference (evalInsOrd left) (evalInsOrd right)+  Intersection left right -> InsOrd.intersection (evalInsOrd left) (evalInsOrd right)+  Map (Fun _ f) rest -> InsOrd.map f (evalInsOrd rest)+  Filter (Fun _ predicate) rest -> InsOrd.filter predicate (evalInsOrd rest)++evalHashSet :: Operation -> HashSet.HashSet Word8+evalHashSet operation = case operation of+  FromList values -> HashSet.fromList values+  Empty -> HashSet.empty+  Singleton value -> HashSet.singleton value+  Insert value rest -> HashSet.insert value (evalHashSet rest)+  Delete value rest -> HashSet.delete value (evalHashSet rest)+  Union left right -> HashSet.union (evalHashSet left) (evalHashSet right)+  Difference left right -> HashSet.difference (evalHashSet left) (evalHashSet right)+  Intersection left right -> HashSet.intersection (evalHashSet left) (evalHashSet right)+  Map (Fun _ f) rest -> HashSet.map f (evalHashSet rest)+  Filter (Fun _ predicate) rest -> HashSet.filter predicate (evalHashSet rest)++containsUnion :: Operation -> Bool+containsUnion operation = case operation of+  FromList _ -> False+  Empty -> False+  Singleton _ -> False+  Insert _ rest -> containsUnion rest+  Delete _ rest -> containsUnion rest+  Union _ _ -> True+  Difference left right -> containsUnion left || containsUnion right+  Intersection left right -> containsUnion left || containsUnion right+  Map _ rest -> containsUnion rest+  Filter _ rest -> containsUnion rest++prop_operationModel :: Operation -> Property+prop_operationModel operation =+  let actual = evalInsOrd operation+      expected = evalHashSet operation+   in conjoin+        [ counterexample ("ordered membership: " <> show (InsOrd.toList actual)) $+            InsOrd.toHashSet actual === expected,+          counterexample ("invalid ordered set: " <> show (InsOrd.toList actual)) $+            property (containsUnion operation || InsOrd.valid actual)+        ]++spec :: Spec+spec = do+  describe "operation model" $+    prop "matches Data.HashSet and preserves valid outside the union caveat" prop_operationModel++  describe "ordered set behavior" $ do+    it "keeps the last duplicate at the end" $+      InsOrd.toList (InsOrd.fromList ["a", "b", "a"])+        `shouldBe` ["b", "a"]++    it "moves an existing member to the end when inserted again" $+      InsOrd.toList (InsOrd.insert "a" (InsOrd.fromList ["a", "b"]))+        `shouldBe` ["b", "a"]++    it "uses left-biased union order followed by right-only members" $+      InsOrd.toList (InsOrd.union (InsOrd.fromList ["a", "b"]) (InsOrd.fromList ["b", "c"]))+        `shouldBe` ["a", "b", "c"]++    it "preserves the released union valid caveat and supports normalization" $ do+      let combined = InsOrd.union (InsOrd.singleton "a") (InsOrd.singleton "b")+      InsOrd.valid combined `shouldBe` False+      InsOrd.valid (InsOrd.fromHashSet (InsOrd.toHashSet combined)) `shouldBe` True++    it "supports lens ix, at, and contains" $ do+      let input = InsOrd.fromList ["a", "b"]+      input ^? ix "a" `shouldBe` Just ()+      InsOrd.toList (input & at "a" .~ Nothing) `shouldBe` ["b"]+      InsOrd.toList (input & at "c" ?~ ()) `shouldBe` ["a", "b", "c"]+      InsOrd.toList (input & contains "b" .~ False) `shouldBe` ["a"]+      InsOrd.toList (input & contains "c" .~ True) `shouldBe` ["a", "b", "c"]++    it "round-trips through Show and Read with order intact" $ do+      let input = InsOrd.fromList ['b', 'a']+          output = read (show input) :: InsOrd.InsOrdHashSet Char+      InsOrd.toList output `shouldBe` InsOrd.toList input++  describe "JSON and deep evaluation compatibility" $ do+    it "encodes as an insertion-ordered array" $+      encode (InsOrd.fromList ["b", "a"])+        `shouldBe` BSL.pack "[\"b\",\"a\"]"++    it "round-trips order and membership after index gaps" $ do+      let input = InsOrd.delete "b" (InsOrd.fromList ["a", "b", "c"])+          decoded = eitherDecode (encode input) :: Either String (InsOrd.InsOrdHashSet String)+      fmap InsOrd.toList decoded `shouldBe` Right (InsOrd.toList input)+      fmap InsOrd.toHashSet decoded `shouldBe` Right (InsOrd.toHashSet input)++    it "retains NFData and NFData1 instances" $ do+      let input = InsOrd.fromList ["a", "b"]+      evaluate (force input) `shouldReturn` input+      evaluate (NF.liftRnf rnf input) `shouldReturn` ()

@@ -9,7 +9,7 @@ import Data.Aeson import Data.Aeson.QQ.Simple import Data.HashMap.Strict (HashMap)-import Data.HashSet.InsOrd qualified as InsOrdHS+import Data.HashSet.InsOrd.Compat qualified as InsOrdHS import Data.OpenApi import Data.Text (Text) import Prelude.Compat