mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-22 23:11:41 +03:00
c265e303f6
These codecs should fully cover the `remote_schemas` property of the Metadata type. Ticket: [GDC-522](https://hasurahq.atlassian.net/browse/GDC-522) PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6812 GitOrigin-RevId: 1b256f6829486295957c232b92ff184bd9a86469
82 lines
3.5 KiB
Haskell
82 lines
3.5 KiB
Haskell
module Data.HashMap.Strict.InsOrd.Autodocodec
|
|
( insertionOrderedElemsCodec,
|
|
insertionOrderedElemsCodecWith,
|
|
sortedElemsCodec,
|
|
sortedElemsCodecWith,
|
|
)
|
|
where
|
|
|
|
import Autodocodec (Codec (..), HasCodec (codec), JSONCodec, ValueCodec, bimapCodec, listCodec)
|
|
import Data.HashMap.Strict.InsOrd (elems)
|
|
import Data.List.Extended (duplicates)
|
|
import Data.Text qualified as T
|
|
import Data.Text.Extended qualified as T
|
|
import Hasura.Prelude
|
|
|
|
-- | Codec for ordered hash maps where the key for each element can be inferred
|
|
-- from the element value. This codec serializes the hash map as an array sorted
|
|
-- by key.
|
|
sortedElemsCodec :: (HasCodec a, Hashable k, Ord k, T.ToTxt k) => (a -> k) -> JSONCodec (InsOrdHashMap k a)
|
|
sortedElemsCodec = sortedElemsCodecWith codec
|
|
|
|
-- | Codec for ordered hash maps where the key for each element can be inferred
|
|
-- from the element value. This codec serializes the hash map as an array sorted
|
|
-- by key.
|
|
--
|
|
-- This version is useful if there is no 'HasCodec' instance for the type of the
|
|
-- hash map values. You supply a codec as an argument instead.
|
|
sortedElemsCodecWith :: (Hashable k, Ord k, T.ToTxt k) => JSONCodec a -> (a -> k) -> JSONCodec (InsOrdHashMap k a)
|
|
sortedElemsCodecWith elemCodec keyForElem = bimapCodec dec enc $ listCodec elemCodec
|
|
where
|
|
dec = fromListWithDuplicateCheck elemCodec keyForElem
|
|
enc = sortOn keyForElem . elems
|
|
|
|
-- | Codec for ordered hash maps that serializes to a list. Elements are ordered
|
|
-- according to insertion order in the map. A function to map from elements to
|
|
-- key is used on deserialization.
|
|
--
|
|
-- This version is useful if there is no 'HasCodec' instance for the type of the
|
|
-- hash map values. You supply a codec as an argument instead.
|
|
insertionOrderedElemsCodec :: (Hashable k, HasCodec a, T.ToTxt k) => (a -> k) -> JSONCodec (InsOrdHashMap k a)
|
|
insertionOrderedElemsCodec = insertionOrderedElemsCodecWith codec
|
|
|
|
-- | Codec for ordered hash maps that serializes to a list. Elements are ordered
|
|
-- according to insertion order in the map. A function to map from elements to
|
|
-- key is used on deserialization.
|
|
--
|
|
-- This version is useful if there is no 'HasCodec' instance for the type of the
|
|
-- hash map values. You supply a codec as an argument instead.
|
|
insertionOrderedElemsCodecWith :: (Hashable k, T.ToTxt k) => JSONCodec a -> (a -> k) -> JSONCodec (InsOrdHashMap k a)
|
|
insertionOrderedElemsCodecWith elemCodec keyForElem = bimapCodec dec enc $ listCodec elemCodec
|
|
where
|
|
dec = fromListWithDuplicateCheck elemCodec keyForElem
|
|
enc = elems
|
|
|
|
fromListWithDuplicateCheck :: (Hashable k, T.ToTxt k) => JSONCodec a -> (a -> k) -> [a] -> Either String (InsOrdHashMap k a)
|
|
fromListWithDuplicateCheck elemCodec keyForElem xs =
|
|
let dupKeys = duplicates $ map keyForElem xs
|
|
in if null dupKeys
|
|
then Right $ oMapFromL keyForElem xs
|
|
else Left $ T.unpack $ errMsg <> T.commaSeparated dupKeys
|
|
where
|
|
errMsg = case codecName elemCodec of
|
|
(Just t) -> "multiple " <> t <> " declarations exist: "
|
|
Nothing -> "multiple declarations exist: "
|
|
|
|
codecName :: ValueCodec input output -> Maybe Text
|
|
codecName = \case
|
|
NullCodec -> Nothing
|
|
BoolCodec mname -> mname
|
|
StringCodec mname -> mname
|
|
NumberCodec mname _ -> mname
|
|
ArrayOfCodec mname _ -> mname
|
|
HashMapCodec _ -> Nothing
|
|
MapCodec _ -> Nothing
|
|
ValueCodec -> Nothing
|
|
EqCodec _ _ -> Nothing
|
|
BimapCodec _ _ c -> codecName c
|
|
ObjectOfCodec mname _ -> mname
|
|
EitherCodec {} -> Nothing
|
|
CommentCodec _ c -> codecName c
|
|
ReferenceCodec n _ -> Just n
|