{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
-- Because Eq is a superclass of Hashable in newer versions.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Autodocodec.Codec where

import Control.Monad
import Control.Monad.State
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import qualified Data.Aeson as JSON
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (KeyMap)
import qualified Data.Aeson.KeyMap as KM
#endif
import qualified Data.Aeson.Types as JSON
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Hashable
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Map (Map)
import Data.Scientific as Scientific
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Validity
import Data.Validity.Scientific ()
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Void
import GHC.Generics (Generic)
import Numeric.Natural

-- $setup
-- >>> import Autodocodec.Aeson (toJSONVia, toJSONViaCodec, toJSONObjectVia, toJSONObjectViaCodec, parseJSONVia, parseJSONViaCodec, parseJSONObjectVia, parseJSONObjectViaCodec)
-- >>> import qualified Autodocodec.Aeson.Compat as Compat
-- >>> import Autodocodec.Class (HasCodec(codec), requiredField)
-- >>> import qualified Data.Aeson as JSON
-- >>> import qualified Data.HashMap.Strict as HM
-- >>> import Data.Aeson (Value(..))
-- >>> import qualified Data.Vector as Vector
-- >>> import Data.Int
-- >>> import Data.Word
-- >>> :set -XOverloadedStrings
-- >>> :set -XOverloadedLists
-- >>> :set -XLambdaCase

-- | A Self-documenting encoder and decoder,
--
-- also called an "Autodocodec".
--
-- In an ideal situation, this type would have only one type parameter: 'Codec value'.
-- This does not work very well because we want to be able to implement 'Functor' and 'Applicative', which each require a kind '* -> *'.
-- So instead we use two type parameters.
--
-- The two type parameters correspond to the phase in which they are used:
--
-- * The @input@ parameter is used for the type that is used during encoding of a value, so it's the @input@ to the codec.
-- * The @output@ parameter is used for the type that is used during decoding of a value, so it's the @output@ of the codec.
-- * Both parameters are unused during documentation.
data Codec context input output where
  -- | Encode '()' to the @null@ value, and decode @null@ as '()'.
  NullCodec ::
    ValueCodec () ()
  -- | Encode a 'Bool' to a @boolean@ value, and decode a @boolean@ value as a 'Bool'.
  BoolCodec ::
    -- | Name of the @bool@, for error messages and documentation.
    Maybe Text ->
    JSONCodec Bool
  -- | Encode 'Text' to a @string@ value, and decode a @string@ value as a 'Text'.
  --
  -- This is named after the primitive type "String" in json, not after the haskell type string.
  StringCodec ::
    -- | Name of the @string@, for error messages and documentation.
    Maybe Text ->
    JSONCodec Text
  -- | Encode 'Scientific' to a @number@ value, and decode a @number@ value as a 'Scientific'.
  --
  -- The number has optional 'NumberBounds'.
  -- These are only enforced at decoding time, not at encoding-time.
  --
  -- NOTE: We use 'Scientific' here because that is what aeson uses.
  NumberCodec ::
    -- | Name of the @number@, for error messages and documentation.
    Maybe Text ->
    -- | Bounds for the number, these are checked and documented
    Maybe NumberBounds ->
    JSONCodec Scientific
  -- | Encode a 'HashMap', and decode any 'HashMap'.
  HashMapCodec ::
    (Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>
    JSONCodec v ->
    JSONCodec (HashMap k v)
  -- | Encode a 'Map', and decode any 'Map'.
  MapCodec ::
    (Ord k, FromJSONKey k, ToJSONKey k) =>
    JSONCodec v ->
    JSONCodec (Map k v)
  -- | Encode a 'JSON.Value', and decode any 'JSON.Value'.
  ValueCodec ::
    JSONCodec JSON.Value
  -- | Encode a 'Vector' of values as an @array@ value, and decode an @array@ value as a 'Vector' of values.
  ArrayOfCodec ::
    -- | Name of the @array@, for error messages and documentation.
    Maybe Text ->
    ValueCodec input output ->
    ValueCodec (Vector input) (Vector output)
  -- | Encode a value as a an @object@ value using the given 'ObjectCodec', and decode an @object@ value as a value using the given 'ObjectCodec'.
  ObjectOfCodec ::
    -- | Name of the @object@, for error messages and documentation.
    Maybe Text ->
    ObjectCodec input output ->
    ValueCodec input output
  -- | Match a given value using its 'Eq' instance during decoding, and encode exactly that value during encoding.
  EqCodec ::
    (Show value, Eq value) =>
    -- | Value to match
    value ->
    -- | Codec for the value
    JSONCodec value ->
    JSONCodec value
  -- | Map a codec in both directions.
  --
  -- This is not strictly dimap, because the decoding function is allowed to fail,
  -- but we can implement dimap using this function by using a decoding function that does not fail.
  -- Otherwise we would have to have another constructor here.
  BimapCodec ::
    (oldOutput -> Either String newOutput) ->
    (newInput -> oldInput) ->
    Codec context oldInput oldOutput ->
    Codec context newInput newOutput
  -- | Encode/Decode an 'Either' value
  --
  -- During encoding, encode either value of an 'Either' using their own codec.
  -- During decoding, try to parse the 'Left' side first, and the 'Right' side only when that fails.
  --
  --
  -- This codec is used to implement choice.
  --
  -- Note that this codec works for both values and objects.
  -- However: due to the complex nature of documentation, the documentation may
  -- not be as good as you would hope when you use this codec.
  -- In particular, you should prefer using it for values rather than objects,
  -- because those docs are easier to generate.
  EitherCodec ::
    -- | What type of union we encode and decode
    !Union ->
    -- | Codec for the 'Left' side
    Codec context input1 output1 ->
    -- | Codec for the 'Right' side
    Codec context input2 output2 ->
    Codec context (Either input1 input2) (Either output1 output2)
  -- | Encode/decode a discriminated union of objects
  --
  -- The type of object being encoded/decoded is discriminated by
  -- a designated "discriminator" property on the object which takes a string value.
  --
  -- When encoding, the provided function is applied to the input to obtain a new encoder
  -- for the input. The function 'mapToEncoder' is provided to assist with building these
  -- encoders.
  --
  -- When decoding, the value of the discriminator property is looked up in the `HashMap`
  -- to obtain a decoder for the output. The function `mapToDecoder' is provided
  -- to assist with building these decoders. See examples in 'Usage.hs'.
  --
  -- The 'HashMap' is also used to generate schemas for the type.
  -- In particular, for OpenAPI 3, it will generate a schema with a 'discriminator', as defined
  -- by https://swagger.io/docs/specification/data-models/inheritance-and-polymorphism/
  DiscriminatedUnionCodec ::
    -- | propertyName to use for discrimination
    Text ->
    -- | how to encode the input
    (input -> (Discriminator, ObjectCodec input ())) ->
    -- | how to decode the output
    -- The 'Text' field is the name to use for the object schema.
    HashMap Discriminator (Text, ObjectCodec Void output) ->
    ObjectCodec input output
  -- | A comment codec
  --
  -- This is used to add implementation-irrelevant but human-relevant information.
  CommentCodec ::
    -- | Comment
    Text ->
    ValueCodec input output ->
    ValueCodec input output
  -- | A reference codec
  --
  -- This is used for naming a codec, so that recursive codecs can have a finite schema.
  --
  -- It doesn't _need_ to be recursive, and you may just have wanted to name the codec, but it _may_ be recursive from here downward.
  --
  -- This value MUST be lazy, otherwise we can never define recursive codecs.
  ReferenceCodec ::
    -- | Name
    Text ->
    ~(ValueCodec input output) ->
    ValueCodec input output
  RequiredKeyCodec ::
    -- | Key
    Text ->
    -- | Codec for the value
    ValueCodec input output ->
    -- | Documentation
    Maybe Text ->
    ObjectCodec input output
  OptionalKeyCodec ::
    -- | Key
    Text ->
    -- | Codec for the value
    ValueCodec input output ->
    -- | Documentation
    Maybe Text ->
    ObjectCodec (Maybe input) (Maybe output)
  OptionalKeyWithDefaultCodec ::
    -- | Key
    Text ->
    -- | Codec for the value
    ValueCodec value value ->
    -- | Default value
    value ->
    -- | Documentation
    Maybe Text ->
    ObjectCodec value value
  OptionalKeyWithOmittedDefaultCodec ::
    Eq value =>
    -- | Key
    Text ->
    -- | Codec for the value
    ValueCodec value value ->
    -- | Default value
    value ->
    -- | Documentation
    Maybe Text ->
    ObjectCodec value value
  -- | To implement 'pure' from 'Applicative'.
  --
  -- Pure is not available for non-object codecs because there is no 'mempty' for 'JSON.Value', which we would need during encoding.
  PureCodec ::
    output ->
    -- |
    --
    -- We have to use 'void' instead of 'Void' here to be able to implement 'Applicative'.
    ObjectCodec void output
  -- | To implement '<*>' from 'Applicative'.
  --
  -- Ap is not available for non-object codecs because we cannot combine ('mappend') two encoded 'JSON.Value's
  ApCodec ::
    ObjectCodec input (output -> newOutput) ->
    ObjectCodec input output ->
    ObjectCodec input newOutput

data NumberBounds = NumberBounds
  { NumberBounds -> Scientific
numberBoundsLower :: !Scientific,
    NumberBounds -> Scientific
numberBoundsUpper :: !Scientific
  }
  deriving (Int -> NumberBounds -> ShowS
[NumberBounds] -> ShowS
NumberBounds -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumberBounds] -> ShowS
$cshowList :: [NumberBounds] -> ShowS
show :: NumberBounds -> String
$cshow :: NumberBounds -> String
showsPrec :: Int -> NumberBounds -> ShowS
$cshowsPrec :: Int -> NumberBounds -> ShowS
Show, NumberBounds -> NumberBounds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumberBounds -> NumberBounds -> Bool
$c/= :: NumberBounds -> NumberBounds -> Bool
== :: NumberBounds -> NumberBounds -> Bool
$c== :: NumberBounds -> NumberBounds -> Bool
Eq, forall x. Rep NumberBounds x -> NumberBounds
forall x. NumberBounds -> Rep NumberBounds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NumberBounds x -> NumberBounds
$cfrom :: forall x. NumberBounds -> Rep NumberBounds x
Generic)

instance Validity NumberBounds

-- | Check if a number falls within given 'NumberBounds'.
checkNumberBounds :: NumberBounds -> Scientific -> Either String Scientific
checkNumberBounds :: NumberBounds -> Scientific -> Either String Scientific
checkNumberBounds NumberBounds {Scientific
numberBoundsUpper :: Scientific
numberBoundsLower :: Scientific
numberBoundsUpper :: NumberBounds -> Scientific
numberBoundsLower :: NumberBounds -> Scientific
..} Scientific
s =
  if Scientific
numberBoundsLower forall a. Ord a => a -> a -> Bool
<= Scientific
s
    then
      if Scientific
s forall a. Ord a => a -> a -> Bool
<= Scientific
numberBoundsUpper
        then forall a b. b -> Either a b
Right Scientific
s
        else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Number", forall a. Show a => a -> String
show Scientific
s, String
"is bigger than the upper bound", forall a. Show a => a -> String
show Scientific
numberBoundsUpper]
    else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Number", forall a. Show a => a -> String
show Scientific
s, String
"is smaller than the lower bound", forall a. Show a => a -> String
show Scientific
numberBoundsUpper]

-- | What type of union the encoding uses
data Union
  = -- | Not disjoint, see 'possiblyJointEitherCodec'.
    PossiblyJointUnion
  | -- | Disjoint, see 'disjointEitherCodec'.
    DisjointUnion
  deriving (Int -> Union -> ShowS
[Union] -> ShowS
Union -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Union] -> ShowS
$cshowList :: [Union] -> ShowS
show :: Union -> String
$cshow :: Union -> String
showsPrec :: Int -> Union -> ShowS
$cshowsPrec :: Int -> Union -> ShowS
Show, Union -> Union -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Union -> Union -> Bool
$c/= :: Union -> Union -> Bool
== :: Union -> Union -> Bool
$c== :: Union -> Union -> Bool
Eq, forall x. Rep Union x -> Union
forall x. Union -> Rep Union x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Union x -> Union
$cfrom :: forall x. Union -> Rep Union x
Generic)

instance Validity Union

-- | A codec within the 'JSON.Value' context.
--
-- An 'ValueCodec' can be used to turn a Haskell value into a 'JSON.Value' or to parse a 'JSON.Value' into a haskell value.
--
-- This cannot be used in certain places where 'ObjectCodec' could be used, and vice versa.
type ValueCodec = Codec JSON.Value

-- | A codec within the 'JSON.Object' context.
--
-- An 'Object' can be used to turn a Haskell value into a 'JSON.Object' or to parse a 'JSON.Object' into a haskell value.
--
-- This cannot be used in certain places where 'ValueCodec' could be used, and vice versa.
type ObjectCodec = Codec JSON.Object

-- | A completed autodocodec for parsing and rendering a 'JSON.Value'.
--
-- You can use a value of this type to get everything else for free:
--
-- * Encode values to JSON using 'toJSONViaCodec' or 'toJSONVia'
-- * Decode values from JSON using 'parseJSONViaCodec' or 'parseJSONVia'
-- * Produce a JSON Schema using 'jsonSchemaViaCodec' or 'jsonSchemaVia' from @autodocodec-schema@
-- * Encode to and decode from Yaml using @autodocodec-yaml@
-- * Produce a human-readible YAML schema using @renderColouredSchemaViaCodec@ from @autodocodec-yaml@
-- * Produce a Swagger2 schema using @autodocodec-swagger2@
-- * Produce a OpenAPI3 schema using @autodocodec-openapi3@
type JSONCodec a = ValueCodec a a

-- | A completed autodocodec for parsing and rendering a 'JSON.Object'.
type JSONObjectCodec a = ObjectCodec a a

-- | Show a codec to a human.
--
-- This function exists for codec debugging.
-- It omits any unshowable information from the output.
showCodecABit :: Codec context input output -> String
showCodecABit :: forall context input output. Codec context input output -> String
showCodecABit = (forall a b. (a -> b) -> a -> b
$ String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. State s a -> s -> a
`evalState` forall a. Set a
S.empty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
0
  where
    go :: Int -> Codec context input output -> State (Set Text) ShowS
    go :: forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
d = \case
      Codec context input output
NullCodec -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"NullCodec"
      BoolCodec Maybe Text
mName -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"BoolCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName
      StringCodec Maybe Text
mName -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"StringCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName
      NumberCodec Maybe Text
mName Maybe NumberBounds
mbs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"NumberCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe NumberBounds
mbs
      ArrayOfCodec Maybe Text
mName ValueCodec input output
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ArrayOfCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ValueCodec input output
c
      ObjectOfCodec Maybe Text
mName ObjectCodec input output
oc -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ObjectOfCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ObjectCodec input output
oc
      Codec context input output
ValueCodec -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ValueCodec"
      MapCodec JSONCodec v
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"MapCodec" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 JSONCodec v
c
      HashMapCodec JSONCodec v
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"HashMapCodec" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 JSONCodec v
c
      EqCodec input
value JSONCodec input
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"EqCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 input
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 JSONCodec input
c
      BimapCodec oldOutput -> Either String output
_ input -> oldInput
_ Codec context oldInput oldOutput
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"BimapCodec _ _ " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 Codec context oldInput oldOutput
c
      EitherCodec Union
u Codec context input1 output1
c1 Codec context input2 output2
c2 -> (\ShowS
s1 ShowS
s2 -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"EitherCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Union
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 Codec context input1 output1
c1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 Codec context input2 output2
c2
      DiscriminatedUnionCodec Text
propertyName input -> (Text, ObjectCodec input ())
_ HashMap Text (Text, ObjectCodec Void output)
mapping -> do
        [ShowS]
cs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Text
n, (Text
_, ObjectCodec Void output
c)) -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen Bool
True forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> ShowS
shows Text
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ObjectCodec Void output
c) forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text (Text, ObjectCodec Void output)
mapping
        let csList :: ShowS
csList = String -> ShowS
showString String
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (forall a. a -> [a] -> [a]
intersperse (String -> ShowS
showString String
", ") [ShowS]
cs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"DiscriminatedUnionCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
propertyName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" _ " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
csList
      CommentCodec Text
comment ValueCodec input output
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"CommentCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ValueCodec input output
c
      ReferenceCodec Text
name ValueCodec input output
c -> do
        Bool
alreadySeen <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. Ord a => a -> Set a -> Bool
S.member Text
name)
        if Bool
alreadySeen
          then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ReferenceCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
name
          else do
            forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Ord a => a -> Set a -> Set a
S.insert Text
name)
            ShowS
s <- forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ValueCodec input output
c
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ReferenceCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s
      RequiredKeyCodec Text
k ValueCodec input output
c Maybe Text
mdoc -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"RequiredKeyCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mdoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ValueCodec input output
c
      OptionalKeyCodec Text
k ValueCodec input output
c Maybe Text
mdoc -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"OptionalKeyCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mdoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ValueCodec input output
c
      OptionalKeyWithDefaultCodec Text
k JSONCodec input
c input
_ Maybe Text
mdoc -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"OptionalKeyWithDefaultCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" _ " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mdoc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 JSONCodec input
c
      OptionalKeyWithOmittedDefaultCodec Text
k JSONCodec input
c input
_ Maybe Text
mdoc -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"OptionalKeyWithOmittedDefaultCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" _ " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mdoc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 JSONCodec input
c
      PureCodec output
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"PureCodec _"
      ApCodec ObjectCodec input (output -> output)
oc1 ObjectCodec input output
oc2 -> (\ShowS
s1 ShowS
s2 -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ApCodec " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ObjectCodec input (output -> output)
oc1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ObjectCodec input output
oc2

-- | Map the output part of a codec
--
-- You can use this function if you only need to map the parsing-side of a codec.
-- This function is probably only useful if the function you map does not change the codec type.
--
-- WARNING: This can be used to produce a codec that does not roundtrip.
--
-- >>> JSON.parseMaybe (parseJSONVia (rmapCodec (*2) codec)) (Number 5) :: Maybe Int
-- Just 10
rmapCodec ::
  (oldOutput -> newOutput) ->
  Codec context input oldOutput ->
  Codec context input newOutput
rmapCodec :: forall oldOutput newOutput context input.
(oldOutput -> newOutput)
-> Codec context input oldOutput -> Codec context input newOutput
rmapCodec oldOutput -> newOutput
f = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec oldOutput -> newOutput
f forall a. a -> a
id

instance Functor (Codec context input) where
  fmap :: forall a b.
(a -> b) -> Codec context input a -> Codec context input b
fmap = forall oldOutput newOutput context input.
(oldOutput -> newOutput)
-> Codec context input oldOutput -> Codec context input newOutput
rmapCodec

-- | Map the input part of a codec
--
-- You can use this function if you only need to map the rendering-side of a codec.
-- This function is probably only useful if the function you map does not change the codec type.
--
-- WARNING: This can be used to produce a codec that does not roundtrip.
--
-- >>> toJSONVia (lmapCodec (*2) (codec :: JSONCodec Int)) 5
-- Number 10.0
lmapCodec ::
  (newInput -> oldInput) ->
  Codec context oldInput output ->
  Codec context newInput output
lmapCodec :: forall newInput oldInput context output.
(newInput -> oldInput)
-> Codec context oldInput output -> Codec context newInput output
lmapCodec newInput -> oldInput
g = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall a. a -> a
id newInput -> oldInput
g

-- | Infix version of 'lmapCodec'
--
-- Use this function to supply the rendering side of a codec.
--
-- > (.=) = flip lmapCodec
--
-- === Example usage
--
-- > data Example = Example
-- >   { exampleText :: !Text,
-- >     exampleBool :: !Bool
-- >   }
-- > instance HasCodec Example where
-- >   codec =
-- >     object "Example" $
-- >       Example
-- >         <$> requiredField "text" .= exampleText
-- >         <*> requiredField "bool" .= exampleBool
(.=) :: ObjectCodec oldInput output -> (newInput -> oldInput) -> ObjectCodec newInput output
.= :: forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
(.=) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall newInput oldInput context output.
(newInput -> oldInput)
-> Codec context oldInput output -> Codec context newInput output
lmapCodec

-- | Map both directions of a codec
--
-- You can use this function to change the type of a codec as long as the two
-- functions are inverses.
--
-- === 'HasCodec' instance for newtypes
--
-- A good use-case is implementing 'HasCodec' for newtypes:
--
-- > newtype MyInt = MyInt { unMyInt :: Int }
-- > instance HasCodec MyInt where
-- >   codec = dimapCodec MyInt unMyInt codec
dimapCodec ::
  -- | Function to make __to__ the new type
  (oldOutput -> newOutput) ->
  -- | Function to make __from__ the new type
  (newInput -> oldInput) ->
  -- | Codec for the old type
  Codec context oldInput oldOutput ->
  Codec context newInput newOutput
dimapCodec :: forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec oldOutput -> newOutput
f newInput -> oldInput
g = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. oldOutput -> newOutput
f) newInput -> oldInput
g

-- | Produce a value without parsing any part of an 'Object'.
--
-- This function exists to implement @Applicative (ObjectCodec input)@.
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'PureCodec'.
--
-- > pureCodec = PureCodec
pureCodec :: output -> ObjectCodec input output
pureCodec :: forall output input. output -> ObjectCodec input output
pureCodec = forall output input. output -> ObjectCodec input output
PureCodec

-- | Sequentially apply two codecs that parse part of an 'Object'.
--
-- This function exists to implement @Applicative (ObjectCodec input)@.
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'ApCodec'.
--
-- > apCodec = ApCodec
apCodec :: ObjectCodec input (output -> newOutput) -> ObjectCodec input output -> ObjectCodec input newOutput
apCodec :: forall input output newOutput.
ObjectCodec input (output -> newOutput)
-> ObjectCodec input output -> ObjectCodec input newOutput
apCodec = forall input output newOutput.
ObjectCodec input (output -> newOutput)
-> ObjectCodec input output -> ObjectCodec input newOutput
ApCodec

instance Applicative (ObjectCodec input) where
  pure :: forall a. a -> ObjectCodec input a
pure = forall output input. output -> ObjectCodec input output
pureCodec
  <*> :: forall a b.
ObjectCodec input (a -> b)
-> ObjectCodec input a -> ObjectCodec input b
(<*>) = forall input output newOutput.
ObjectCodec input (output -> newOutput)
-> ObjectCodec input output -> ObjectCodec input newOutput
apCodec

-- | Maybe codec
--
-- This can be used to also allow @null@ during decoding of a 'Maybe' value.
--
-- During decoding, also accept a @null@ value as 'Nothing'.
-- During encoding, encode as usual.
--
--
-- === Example usage
--
-- >>> toJSONVia (maybeCodec codec) (Just 'a')
-- String "a"
-- >>> toJSONVia (maybeCodec codec) (Nothing :: Maybe Char)
-- Null
maybeCodec :: ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec :: forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec =
  -- We must use 'possiblyJointEitherCodec' here, otherwise a codec for (Maybe
  -- (Maybe Text)) will fail to parse.
  forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall {a}. Either () a -> Maybe a
f forall {b}. Maybe b -> Either () b
g
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
possiblyJointEitherCodec JSONCodec ()
nullCodec
  where
    f :: Either () a -> Maybe a
f = \case
      Left () -> forall a. Maybe a
Nothing
      Right a
r -> forall a. a -> Maybe a
Just a
r
    g :: Maybe b -> Either () b
g = \case
      Maybe b
Nothing -> forall a b. a -> Either a b
Left ()
      Just b
r -> forall a b. b -> Either a b
Right b
r

-- | Either codec
--
-- During encoding, parse a value according to either codec.
-- During encoding, use the corresponding codec to encode either value.
--
-- === 'HasCodec' instance for sum types
--
-- To write a 'HasCodec' instance for sum types, you will need to decide whether encoding is disjoint or not.
-- The default, so also the implementation of this function, is 'possiblyJointEitherCodec', but you may want to use 'disjointEitherCodec' instead.
--
-- Ask yourself: Can the encoding of a 'Left' value be decoded as 'Right' value (or vice versa)?
--
-- @Yes ->@ use 'possiblyJointEitherCodec'.
--
-- @No  ->@ use 'disjointEitherCodec'.
--
--
-- === Example usage
--
-- >>> let c = eitherCodec codec codec :: JSONCodec (Either Int String)
-- >>> toJSONVia c (Left 5)
-- Number 5.0
-- >>> toJSONVia c (Right "hello")
-- String "hello"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "world") :: Maybe (Either Int String)
-- Just (Right "world")
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'possiblyJointEitherCodec'.
--
-- > eitherCodec = possiblyJointEitherCodec
eitherCodec ::
  Codec context input1 output1 ->
  Codec context input2 output2 ->
  Codec context (Either input1 input2) (Either output1 output2)
eitherCodec :: forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec = forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
possiblyJointEitherCodec

-- | Possibly joint either codec
--
-- During encoding, parse a value according to either codec.
-- During encoding, use the corresponding codec to encode either value.
--
-- This codec is for the case in which parsing must be disjoint.
--
-- === 'HasCodec' instance for sum types with an encoding that is definitely disjoint.
--
-- The 'eitherCodec' can be used to implement 'HasCodec' instances for sum types
-- for which the encoding is definitely disjoint.
--
-- >>> data War = WorldWar Word8 | OtherWar Text deriving (Show, Eq)
-- >>> :{
--   instance HasCodec War where
--    codec =
--      dimapCodec f g $
--        disjointEitherCodec
--          (codec :: JSONCodec Word8)
--          (codec :: JSONCodec Text)
--      where
--        f = \case
--          Left w -> WorldWar w
--          Right t -> OtherWar t
--        g = \case
--          WorldWar w -> Left w
--          OtherWar t -> Right t
-- :}
--
-- Note that this incoding is indeed disjoint because an encoded 'String' can
-- never be parsed as an 'Word8' and vice versa.
--
-- >>> toJSONViaCodec (WorldWar 2)
-- Number 2.0
-- >>> toJSONViaCodec (OtherWar "OnDrugs")
-- String "OnDrugs"
-- >>> JSON.parseMaybe parseJSONViaCodec (String "of the roses") :: Maybe War
-- Just (OtherWar "of the roses")
--
--
-- === WARNING
--
-- If it turns out that the encoding of a value is not disjoint, decoding may
-- fail and documentation may be wrong.
--
-- >>> let c = disjointEitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec Int)
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 5) :: Maybe (Either Int Int)
-- Nothing
--
-- Encoding still works as expected, however:
--
-- >>> toJSONVia c (Left 5)
-- Number 5.0
-- >>> toJSONVia c (Right 6)
-- Number 6.0
--
--
-- === Example usage
--
-- >>> toJSONVia (disjointEitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec String)) (Left 5)
-- Number 5.0
-- >>> toJSONVia (disjointEitherCodec (codec :: JSONCodec Int) (codec :: JSONCodec String)) (Right "hello")
-- String "hello"
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'EitherCodec DisjointUnion'.
--
-- > disjointEitherCodec = EitherCodec DisjointUnion
disjointEitherCodec ::
  Codec context input1 output1 ->
  Codec context input2 output2 ->
  Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec :: forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec = forall context input output input2 output2.
Union
-> Codec context input output
-> Codec context input2 output2
-> Codec context (Either input input2) (Either output output2)
EitherCodec Union
DisjointUnion

-- | Possibly joint either codec
--
-- During encoding, parse a value according to either codec.
-- During encoding, use the corresponding codec to encode either value.
--
-- This codec is for the case in which parsing may not be disjoint.
--
-- === 'HasCodec' instance for sum types with an encoding that is not disjoint.
--
-- The 'eitherCodec' can be used to implement 'HasCodec' instances for sum types.
-- If you just have two codecs that you want to try in order, while parsing, you can do this:
--
-- >>> :{
--   data Ainur
--     = Valar Text Text
--     | Maiar Text
--     deriving (Show, Eq)
-- :}
--
-- >>> :{
--   instance HasCodec Ainur where
--     codec =
--       dimapCodec f g $
--         possiblyJointEitherCodec
--           (object "Valar" $
--             (,)
--              <$> requiredField "domain" "Domain which the Valar rules over" .= fst
--              <*> requiredField "name" "Name of the Valar" .= snd)
--           (object "Maiar" $ requiredField "name" "Name of the Maiar")
--       where
--         f = \case
--           Left (domain, name) -> Valar domain name
--           Right name -> Maiar name
--         g = \case
--           Valar domain name -> Left (domain, name)
--           Maiar name -> Right name
-- :}
--
-- Note that this encoding is indeed not disjoint, because a @Valar@ object can
-- parse as a @Maiar@ value.
--
-- >>> toJSONViaCodec (Valar "Stars" "Varda")
-- Object (fromList [("domain",String "Stars"),("name",String "Varda")])
-- >>> toJSONViaCodec (Maiar "Sauron")
-- Object (fromList [("name",String "Sauron")])
-- >>> JSON.parseMaybe parseJSONViaCodec (Object (Compat.fromList [("name",String "Olorin")])) :: Maybe Ainur
-- Just (Maiar "Olorin")
--
--
-- === WARNING
--
-- The order of the codecs in a 'possiblyJointEitherCodec' matters.
--
-- In the above example, decoding works as expected because the @Valar@ case is parsed first.
-- If the @Maiar@ case were first in the 'possiblyJointEitherCodec', then
-- @Valar@ could never be parsed.
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'EitherCodec PossiblyJointUnion'.
--
-- > possiblyJointEitherCodec = EitherCodec PossiblyJointUnion
possiblyJointEitherCodec ::
  Codec context input1 output1 ->
  Codec context input2 output2 ->
  Codec context (Either input1 input2) (Either output1 output2)
possiblyJointEitherCodec :: forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
possiblyJointEitherCodec = forall context input output input2 output2.
Union
-> Codec context input output
-> Codec context input2 output2
-> Codec context (Either input input2) (Either output output2)
EitherCodec Union
PossiblyJointUnion

-- | Discriminator value used in 'DiscriminatedUnionCodec'
type Discriminator = Text

-- | Wrap up a value of type 'b' with its codec to produce
-- and encoder for 'a's that ignores its input and instead encodes
-- the value 'b'.
-- This is useful for building 'discriminatedUnionCodec's.
mapToEncoder :: b -> Codec context b any -> Codec context a ()
mapToEncoder :: forall b context any a.
b -> Codec context b any -> Codec context a ()
mapToEncoder b
b = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (forall a b. a -> b -> a
const ()) (forall a b. a -> b -> a
const b
b)

-- | Map a codec for decoding 'b's into a decoder for 'a's.
-- This is useful for building 'discriminatedUnionCodec's.
mapToDecoder :: (b -> a) -> Codec context any b -> Codec context Void a
mapToDecoder :: forall b a context any.
(b -> a) -> Codec context any b -> Codec context Void a
mapToDecoder b -> a
f = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec b -> a
f forall a. Void -> a
absurd

-- | Encode/decode a discriminated union of objects
--
-- The type of object being encoded/decoded is discriminated by
-- a designated "discriminator" property on the object which takes a string value.
--
-- When encoding, the provided function is applied to the input to obtain a new encoder
-- for the input. The function 'mapToEncoder' is provided to assist with building these
-- encoders. See examples in 'Usage.hs'.
--
-- When decoding, the value of the discriminator property is looked up in the `HashMap`
-- to obtain a decoder for the output. The function `mapToDecoder' is provided
-- to assist with building these decoders. See examples in 'Usage.hs'.
--
-- The 'HashMap' is also used to generate schemas for the type.
-- In particular, for OpenAPI 3, it will generate a schema with a 'discriminator', as defined
-- by https://swagger.io/docs/specification/data-models/inheritance-and-polymorphism/
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'DiscriminatedUnionCodec'.
--
-- > discriminatedUnionCodec = 'DiscriminatedUnionCodec'
discriminatedUnionCodec ::
  -- | propertyName
  Text ->
  -- | how to encode the input
  --
  -- Use 'mapToEncoder' to produce the 'ObjectCodec's.
  (input -> (Discriminator, ObjectCodec input ())) ->
  -- | how to decode the output
  --
  -- The 'Text' field is the name to use for the object schema.
  --
  -- Use 'mapToDecoder' to produce the 'ObjectCodec's.
  HashMap Discriminator (Text, ObjectCodec Void output) ->
  ObjectCodec input output
discriminatedUnionCodec :: forall input output.
Text
-> (input -> (Text, ObjectCodec input ()))
-> HashMap Text (Text, ObjectCodec Void output)
-> ObjectCodec input output
discriminatedUnionCodec = forall input output.
Text
-> (input -> (Text, ObjectCodec input ()))
-> HashMap Text (Text, ObjectCodec Void output)
-> ObjectCodec input output
DiscriminatedUnionCodec

-- | Map a codec's input and output types.
--
-- This function allows you to have the parsing fail in a new way.
--
-- If you use this function, then you will most likely want to add documentation about how not every value that the schema specifies will be accepted.
--
-- This function is like 'BimapCodec' except it also combines one level of a nested 'BimapCodec's.
--
--
-- === Example usage
--
-- logLevelCodec :: JSONCodec LogLevel
-- logLevelCodec = bimapCodec parseLogLevel renderLogLevel codec <?> "Valid values include DEBUG, INFO, WARNING, ERROR."
bimapCodec ::
  (oldOutput -> Either String newOutput) ->
  (newInput -> oldInput) ->
  Codec context oldInput oldOutput ->
  Codec context newInput newOutput
bimapCodec :: forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec oldOutput -> Either String newOutput
f newInput -> oldInput
g =
  -- We distinguish between a 'BimapCodec' and a non-'BimapCodec' just so that
  -- we don't introduce additional layers that we can already combine anyway.
  \case
    BimapCodec oldOutput -> Either String oldOutput
f' oldInput -> oldInput
g' Codec context oldInput oldOutput
c -> forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
BimapCodec (oldOutput -> Either String oldOutput
f' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> oldOutput -> Either String newOutput
f) (oldInput -> oldInput
g' forall b c a. (b -> c) -> (a -> b) -> a -> c
. newInput -> oldInput
g) Codec context oldInput oldOutput
c
    Codec context oldInput oldOutput
c -> forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
BimapCodec oldOutput -> Either String newOutput
f newInput -> oldInput
g Codec context oldInput oldOutput
c

-- | Vector codec
--
-- Build a codec for vectors of values from a codec for a single value.
--
--
-- === Example usage
--
-- >>> toJSONVia (vectorCodec codec) (Vector.fromList ['a','b'])
-- Array [String "a",String "b"]
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'ArrayOfCodec' without a name.
--
-- > vectorCodec = ArrayOfCodec Nothing
vectorCodec :: ValueCodec input output -> ValueCodec (Vector input) (Vector output)
vectorCodec :: forall input output.
ValueCodec input output
-> ValueCodec (Vector input) (Vector output)
vectorCodec = forall input output.
Maybe Text
-> ValueCodec input output
-> ValueCodec (Vector input) (Vector output)
ArrayOfCodec forall a. Maybe a
Nothing

-- | List codec
--
-- Build a codec for lists of values from a codec for a single value.
--
--
-- === Example usage
--
-- >>> toJSONVia (listCodec codec) ['a','b']
-- Array [String "a",String "b"]
--
--
-- ==== API Note
--
-- This is the list version of 'vectorCodec'.
listCodec :: ValueCodec input output -> ValueCodec [input] [output]
listCodec :: forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall a. Vector a -> [a]
V.toList forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall input output.
ValueCodec input output
-> ValueCodec (Vector input) (Vector output)
vectorCodec

-- | Build a codec for nonempty lists of values from a codec for a single value.
--
--
-- === Example usage
--
-- >>> toJSONVia (nonEmptyCodec codec) ('a' :| ['b'])
-- Array [String "a",String "b"]
--
--
-- ==== API Note
--
-- This is the non-empty list version of 'vectorCodec'.
nonEmptyCodec :: ValueCodec input output -> ValueCodec (NonEmpty input) (NonEmpty output)
nonEmptyCodec :: forall input output.
ValueCodec input output
-> ValueCodec (NonEmpty input) (NonEmpty output)
nonEmptyCodec = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec forall {a}. [a] -> Either String (NonEmpty a)
parseNonEmptyList forall a. NonEmpty a -> [a]
NE.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec
  where
    parseNonEmptyList :: [a] -> Either String (NonEmpty a)
parseNonEmptyList [a]
l = case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
l of
      Maybe (NonEmpty a)
Nothing -> forall a b. a -> Either a b
Left String
"Expected a nonempty list, but got an empty list."
      Just NonEmpty a
ne -> forall a b. b -> Either a b
Right NonEmpty a
ne

-- | Single or list codec
--
-- This codec behaves like 'listCodec', except the values may also be
-- simplified as a single value.
--
-- During parsing, a single element may be parsed as the list of just that element.
-- During rendering, a list with only one element will be rendered as just that element.
--
--
-- === Example usage
--
-- >>> let c = singleOrListCodec codec :: JSONCodec [Int]
-- >>> toJSONVia c [5]
-- Number 5.0
-- >>> toJSONVia c [5,6]
-- Array [Number 5.0,Number 6.0]
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 5) :: Maybe [Int]
-- Just [5]
-- >>> JSON.parseMaybe (parseJSONVia c) (Array [Number 5, Number 6]) :: Maybe [Int]
-- Just [5,6]
--
--
-- === WARNING
--
-- If you use nested lists, for example when the given value codec is also a
-- 'listCodec', you may get in trouble with ambiguities during parsing.
singleOrListCodec :: ValueCodec input output -> ValueCodec [input] [output]
singleOrListCodec :: forall input output.
ValueCodec input output -> ValueCodec [input] [output]
singleOrListCodec ValueCodec input output
c = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall {a}. Either a [a] -> [a]
f forall {a}. [a] -> Either a [a]
g forall a b. (a -> b) -> a -> b
$ forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec ValueCodec input output
c forall a b. (a -> b) -> a -> b
$ forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec ValueCodec input output
c
  where
    f :: Either a [a] -> [a]
f = \case
      Left a
v -> [a
v]
      Right [a]
vs -> [a]
vs
    g :: [a] -> Either a [a]
g = \case
      [a
v] -> forall a b. a -> Either a b
Left a
v
      [a]
vs -> forall a b. b -> Either a b
Right [a]
vs

-- | Single or nonempty list codec
--
-- This codec behaves like 'nonEmptyCodec', except the values may also be
-- simplified as a single value.
--
-- During parsing, a single element may be parsed as the list of just that element.
-- During rendering, a list with only one element will be rendered as just that element.
--
--
-- === Example usage
--
-- >>> let c = singleOrNonEmptyCodec codec :: JSONCodec (NonEmpty Int)
-- >>> toJSONVia c (5 :| [])
-- Number 5.0
-- >>> toJSONVia c (5 :| [6])
-- Array [Number 5.0,Number 6.0]
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 5) :: Maybe (NonEmpty Int)
-- Just (5 :| [])
-- >>> JSON.parseMaybe (parseJSONVia c) (Array [Number 5, Number 6]) :: Maybe (NonEmpty Int)
-- Just (5 :| [6])
--
--
-- === WARNING
--
-- If you use nested lists, for example when the given value codec is also a
-- 'nonEmptyCodec', you may get in trouble with ambiguities during parsing.
--
-- ==== API Note
--
-- This is a nonempty version of 'singleOrListCodec'.
singleOrNonEmptyCodec :: ValueCodec input output -> ValueCodec (NonEmpty input) (NonEmpty output)
singleOrNonEmptyCodec :: forall input output.
ValueCodec input output
-> ValueCodec (NonEmpty input) (NonEmpty output)
singleOrNonEmptyCodec ValueCodec input output
c = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall {a}. Either a (NonEmpty a) -> NonEmpty a
f forall {a}. NonEmpty a -> Either a (NonEmpty a)
g forall a b. (a -> b) -> a -> b
$ forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec ValueCodec input output
c forall a b. (a -> b) -> a -> b
$ forall input output.
ValueCodec input output
-> ValueCodec (NonEmpty input) (NonEmpty output)
nonEmptyCodec ValueCodec input output
c
  where
    f :: Either a (NonEmpty a) -> NonEmpty a
f = \case
      Left a
v -> a
v forall a. a -> [a] -> NonEmpty a
:| []
      Right NonEmpty a
vs -> NonEmpty a
vs
    g :: NonEmpty a -> Either a (NonEmpty a)
g = \case
      a
v :| [] -> forall a b. a -> Either a b
Left a
v
      NonEmpty a
vs -> forall a b. b -> Either a b
Right NonEmpty a
vs

-- | A required field
--
-- During decoding, the field must be in the object.
--
-- During encoding, the field will always be in the object.
requiredFieldWith ::
  -- | Key
  Text ->
  -- | Codec for the value
  ValueCodec input output ->
  -- | Documentation
  Text ->
  ObjectCodec input output
requiredFieldWith :: forall input output.
Text -> ValueCodec input output -> Text -> ObjectCodec input output
requiredFieldWith Text
key ValueCodec input output
c Text
doc = forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec input output
RequiredKeyCodec Text
key ValueCodec input output
c (forall a. a -> Maybe a
Just Text
doc)

-- | Like 'requiredFieldWith', but without documentation.
requiredFieldWith' ::
  -- | Key
  Text ->
  -- | Codec for the value
  ValueCodec input output ->
  ObjectCodec input output
requiredFieldWith' :: forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
key ValueCodec input output
c = forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec input output
RequiredKeyCodec Text
key ValueCodec input output
c forall a. Maybe a
Nothing

-- | An optional field
--
-- During decoding, the field may be in the object. 'Nothing' will be parsed otherwise.
--
-- During encoding, the field will be omitted from the object if it is 'Nothing'.
optionalFieldWith ::
  -- | Key
  Text ->
  -- | Codec for the value
  ValueCodec input output ->
  -- | Documentation
  Text ->
  ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith :: forall input output.
Text
-> ValueCodec input output
-> Text
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith Text
key ValueCodec input output
c Text
doc = forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
OptionalKeyCodec Text
key ValueCodec input output
c (forall a. a -> Maybe a
Just Text
doc)

-- | Like 'optionalFieldWith', but without documentation.
optionalFieldWith' ::
  -- | Key
  Text ->
  -- | Codec for the value
  ValueCodec input output ->
  ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' :: forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
key ValueCodec input output
c = forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
OptionalKeyCodec Text
key ValueCodec input output
c forall a. Maybe a
Nothing

-- | An optional field with default value
--
-- During decoding, the field may be in the object. The default value will be parsed otherwise.
--
-- During encoding, the field will always be in the object. The default value is ignored.
--
-- The shown version of the default value will appear in the documentation.
optionalFieldWithDefaultWith ::
  -- | Key
  Text ->
  -- | Codec for the value
  JSONCodec output ->
  -- | Default value
  output ->
  -- | Documentation
  Text ->
  ObjectCodec output output
optionalFieldWithDefaultWith :: forall output.
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
optionalFieldWithDefaultWith Text
key JSONCodec output
c output
defaultValue Text
doc = forall value.
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
OptionalKeyWithDefaultCodec Text
key JSONCodec output
c output
defaultValue (forall a. a -> Maybe a
Just Text
doc)

-- | Like 'optionalFieldWithDefaultWith', but without documentation.
optionalFieldWithDefaultWith' ::
  -- | Key
  Text ->
  -- | Codec for the value
  JSONCodec output ->
  -- | Default value
  output ->
  ObjectCodec output output
optionalFieldWithDefaultWith' :: forall output.
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithDefaultWith' Text
key JSONCodec output
c output
defaultValue = forall value.
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
OptionalKeyWithDefaultCodec Text
key JSONCodec output
c output
defaultValue forall a. Maybe a
Nothing

-- | An optional field with default value that can be omitted when encoding
--
-- During decoding, the field may be in the object. The default value will be parsed otherwise.
--
-- During encoding, the field will be omitted from the object if it is equal to the default value.
--
-- The shown version of the default value will appear in the documentation.
optionalFieldWithOmittedDefaultWith ::
  Eq output =>
  -- | Key
  Text ->
  -- | Codec for the value
  JSONCodec output ->
  -- | Default value
  output ->
  -- | Documentation
  Text ->
  ObjectCodec output output
optionalFieldWithOmittedDefaultWith :: forall output.
Eq output =>
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith Text
key JSONCodec output
c output
defaultValue Text
doc = forall value.
Eq value =>
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
OptionalKeyWithOmittedDefaultCodec Text
key JSONCodec output
c output
defaultValue (forall a. a -> Maybe a
Just Text
doc)

-- | Like 'optionalFieldWithOmittedDefaultWith', but without documentation.
optionalFieldWithOmittedDefaultWith' ::
  Eq output =>
  -- | Key
  Text ->
  -- | Codec for the value
  JSONCodec output ->
  -- | Default value
  output ->
  ObjectCodec output output
optionalFieldWithOmittedDefaultWith' :: forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith' Text
key JSONCodec output
c output
defaultValue = forall value.
Eq value =>
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
OptionalKeyWithOmittedDefaultCodec Text
key JSONCodec output
c output
defaultValue forall a. Maybe a
Nothing

-- | Like 'optionalFieldWithOmittedDefaultWith', but the value may also be
-- @null@ and that will be interpreted as the default value.
optionalFieldOrNullWithOmittedDefaultWith ::
  Eq output =>
  -- | Key
  Text ->
  -- | Codec for the value
  JSONCodec output ->
  -- | Default value
  output ->
  -- | Documentation
  Text ->
  ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith :: forall output.
Eq output =>
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith Text
key JSONCodec output
c output
defaultValue Text
doc = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Maybe output -> output
f output -> Maybe output
g forall a b. (a -> b) -> a -> b
$ forall output.
Eq output =>
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith Text
key (forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec JSONCodec output
c) (forall a. a -> Maybe a
Just output
defaultValue) Text
doc
  where
    f :: Maybe output -> output
f = \case
      Just output
v -> output
v
      Maybe output
Nothing -> output
defaultValue
    g :: output -> Maybe output
g output
v = if output
v forall a. Eq a => a -> a -> Bool
== output
defaultValue then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just output
v

-- | Like 'optionalFieldWithOmittedDefaultWith'', but the value may also be
-- @null@ and that will be interpreted as the default value.
optionalFieldOrNullWithOmittedDefaultWith' ::
  Eq output =>
  -- | Key
  Text ->
  -- | Codec for the value
  JSONCodec output ->
  -- | Default value
  output ->
  ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith' :: forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith' Text
key JSONCodec output
c output
defaultValue = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Maybe output -> output
f output -> Maybe output
g forall a b. (a -> b) -> a -> b
$ forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith' Text
key (forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec JSONCodec output
c) (forall a. a -> Maybe a
Just output
defaultValue)
  where
    f :: Maybe output -> output
f = \case
      Just output
v -> output
v
      Maybe output
Nothing -> output
defaultValue
    g :: output -> Maybe output
g output
v = if output
v forall a. Eq a => a -> a -> Bool
== output
defaultValue then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just output
v

-- | An optional, or null, field
--
-- During decoding, the field may be in the object. 'Nothing' will be parsed if it is not.
-- If the field is @null@, then it will be parsed as 'Nothing' as well.
--
-- During encoding, the field will be omitted from the object if it is 'Nothing'.
optionalFieldOrNullWith ::
  -- | Key
  Text ->
  -- | Codec for the value
  ValueCodec input output ->
  -- | Documentation
  Text ->
  ObjectCodec (Maybe input) (Maybe output)
optionalFieldOrNullWith :: forall input output.
Text
-> ValueCodec input output
-> Text
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldOrNullWith Text
key ValueCodec input output
c Text
doc = forall input output.
ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
orNullHelper forall a b. (a -> b) -> a -> b
$ forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
OptionalKeyCodec Text
key (forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec ValueCodec input output
c) (forall a. a -> Maybe a
Just Text
doc)

-- | Like 'optionalFieldOrNullWith', but without documentation
optionalFieldOrNullWith' ::
  -- | Key
  Text ->
  -- | Codec for the value
  ValueCodec input output ->
  ObjectCodec (Maybe input) (Maybe output)
optionalFieldOrNullWith' :: forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldOrNullWith' Text
key ValueCodec input output
c = forall input output.
ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
orNullHelper forall a b. (a -> b) -> a -> b
$ forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
OptionalKeyCodec Text
key (forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec ValueCodec input output
c) forall a. Maybe a
Nothing

-- | Add a comment to a codec
--
-- This is an infix version of 'CommentCodec'
-- > (<?>) = flip CommentCodec
(<?>) ::
  ValueCodec input output ->
  -- | Comment
  Text ->
  ValueCodec input output
<?> :: forall input output.
ValueCodec input output -> Text -> ValueCodec input output
(<?>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall input output.
Text -> ValueCodec input output -> ValueCodec input output
CommentCodec

-- | A version of '<?>' that lets you supply a list of lines of text instead of a single text.
--
-- This helps when you use an automated formatter that deals with lists more nicely than with multi-line strings.
(<??>) ::
  ValueCodec input output ->
  -- | Lines of comments
  [Text] ->
  ValueCodec input output
<??> :: forall input output.
ValueCodec input output -> [Text] -> ValueCodec input output
(<??>) ValueCodec input output
c [Text]
ls = forall input output.
Text -> ValueCodec input output -> ValueCodec input output
CommentCodec ([Text] -> Text
T.unlines [Text]
ls) ValueCodec input output
c

-- | Encode a 'HashMap', and decode any 'HashMap'.
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'HashMapCodec'.
--
-- > hashMapCodec = HashMapCodec
hashMapCodec ::
  (Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>
  JSONCodec v ->
  JSONCodec (HashMap k v)
hashMapCodec :: forall k v.
(Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>
JSONCodec v -> JSONCodec (HashMap k v)
hashMapCodec = forall k v.
(Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>
JSONCodec v -> JSONCodec (HashMap k v)
HashMapCodec

-- | Encode a 'Map', and decode any 'Map'.
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'MapCodec'.
--
-- > mapCodec = MapCodec
mapCodec ::
  (Ord k, FromJSONKey k, ToJSONKey k) =>
  JSONCodec v ->
  JSONCodec (Map k v)
mapCodec :: forall k v.
(Ord k, FromJSONKey k, ToJSONKey k) =>
JSONCodec v -> JSONCodec (Map k v)
mapCodec = forall k v.
(Ord k, FromJSONKey k, ToJSONKey k) =>
JSONCodec v -> JSONCodec (Map k v)
MapCodec

#if MIN_VERSION_aeson(2,0,0)
-- | Encode a 'KeyMap', and decode any 'KeyMap'.
--
-- This chooses 'hashMapCodec' or 'mapCodec' based on @ordered-keymap@ flag in aeson.
keyMapCodec ::
    -- |
    JSONCodec v ->
    -- |
    JSONCodec (KeyMap v)
keyMapCodec :: forall v. JSONCodec v -> JSONCodec (KeyMap v)
keyMapCodec = case forall v. Maybe (Coercion (Map Key v) (KeyMap v))
KM.coercionToMap of
  -- Can coerce to Map, use
  Just Coercion (Map Key Any) (KeyMap Any)
_ -> forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall v. Map Key v -> KeyMap v
KM.fromMap forall v. KeyMap v -> Map Key v
KM.toMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Ord k, FromJSONKey k, ToJSONKey k) =>
JSONCodec v -> JSONCodec (Map k v)
mapCodec
  -- Cannot coerce to Map, use HashMap instead.
  Maybe (Coercion (Map Key Any) (KeyMap Any))
Nothing -> forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall v. HashMap Key v -> KeyMap v
KM.fromHashMap forall v. KeyMap v -> HashMap Key v
KM.toHashMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>
JSONCodec v -> JSONCodec (HashMap k v)
hashMapCodec
#endif

-- | Codec for a 'JSON.Value'
--
-- This is essentially your escape-hatch for when you would normally need a monad instance for 'Codec'.
-- You can build monad parsing by using 'valueCodec' together with 'bimapCodec' and supplying your own parsing function.
--
-- Note that this _does_ mean that the documentation will just say that you are parsing and rendering a value, so you may want to document the extra parsing further using '<?>'.
--
-- ==== API Note
--
-- This is a forward-compatible version of 'ValueCodec'.
--
-- > valueCodec = ValueCodec
valueCodec :: JSONCodec JSON.Value
valueCodec :: JSONCodec Value
valueCodec = JSONCodec Value
ValueCodec

-- | Codec for @null@
--
--
-- === Example usage
--
-- >>> toJSONVia nullCodec ()
-- Null
-- >>> JSON.parseMaybe (parseJSONVia nullCodec) Null
-- Just ()
-- >>> JSON.parseMaybe (parseJSONVia nullCodec) (Number 5)
-- Nothing
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'NullCodec'.
--
-- > nullCodec = NullCodec
nullCodec :: JSONCodec ()
nullCodec :: JSONCodec ()
nullCodec = JSONCodec ()
NullCodec

-- | Codec for boolean values
--
--
-- === Example usage
--
-- >>> toJSONVia boolCodec True
-- Bool True
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'BoolCodec' without a name.
--
-- > boolCodec = BoolCodec Nothing
boolCodec :: JSONCodec Bool
boolCodec :: JSONCodec Bool
boolCodec = Maybe Text -> JSONCodec Bool
BoolCodec forall a. Maybe a
Nothing

-- | Codec for text values
--
--
-- === Example usage
--
-- >>> toJSONVia textCodec "hello"
-- String "hello"
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'StringCodec' without a name.
--
-- > textCodec = StringCodec Nothing
textCodec :: JSONCodec Text
textCodec :: JSONCodec Text
textCodec = Maybe Text -> JSONCodec Text
StringCodec forall a. Maybe a
Nothing

-- | Codec for 'String' values
--
--
-- === Example usage
--
-- >>> toJSONVia stringCodec "hello"
-- String "hello"
--
--
-- === WARNING
--
-- This codec uses 'T.unpack' and 'T.pack' to dimap a 'textCodec', so it __does not roundtrip__.
--
-- >>> toJSONVia stringCodec "\55296"
-- String "\65533"
--
--
-- ==== API Note
--
-- This is a 'String' version of 'textCodec'.
stringCodec :: JSONCodec String
stringCodec :: JSONCodec String
stringCodec = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> String
T.unpack String -> Text
T.pack JSONCodec Text
textCodec

-- | Codec for 'Scientific' values
--
--
-- === Example usage
--
-- >>> toJSONVia scientificCodec 5
-- Number 5.0
-- >>> JSON.parseMaybe (parseJSONVia scientificCodec) (Number 3)
-- Just 3.0
--
--
-- === WARNING
--
-- 'Scientific' is a type that is only for JSON parsing and rendering.
-- Do not use it for any calculations.
-- Instead, convert to another number type before doing any calculations.
--
-- @
-- λ> (1 / 3) :: Scientific
-- *** Exception: fromRational has been applied to a repeating decimal which can't be represented as a Scientific! It's better to avoid performing fractional operations on Scientifics and convert them to other fractional types like Double as early as possible.
-- @
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'NumberCodec' without a name.
--
-- > scientificCodec = NumberCodec Nothing Nothing
scientificCodec :: JSONCodec Scientific
scientificCodec :: JSONCodec Scientific
scientificCodec = Maybe Text -> Maybe NumberBounds -> JSONCodec Scientific
NumberCodec forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Codec for 'Scientific' values with bounds
--
--
-- === Example usage
--
-- >>> let c = scientificWithBoundsCodec NumberBounds {numberBoundsLower = 2, numberBoundsUpper = 4}
-- >>> toJSONVia c 3
-- Number 3.0
-- >>> toJSONVia c 5
-- Number 5.0
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 3)
-- Just 3.0
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 5)
-- Nothing
--
--
-- === WARNING
--
-- 'Scientific' is a type that is only for JSON parsing and rendering.
-- Do not use it for any calculations.
-- Instead, convert to another number type before doing any calculations.
--
-- @
-- λ> (1 / 3) :: Scientific
-- *** Exception: fromRational has been applied to a repeating decimal which can't be represented as a Scientific! It's better to avoid performing fractional operations on Scientifics and convert them to other fractional types like Double as early as possible.
-- @
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'NumberCodec' without a name.
--
-- > scientificWithBoundsCodec bounds = NumberCodec Nothing (Just bounds)
scientificWithBoundsCodec :: NumberBounds -> JSONCodec Scientific
scientificWithBoundsCodec :: NumberBounds -> JSONCodec Scientific
scientificWithBoundsCodec NumberBounds
bounds = Maybe Text -> Maybe NumberBounds -> JSONCodec Scientific
NumberCodec forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just NumberBounds
bounds)

-- | An object codec with a given name
--
--
-- === Example usage
--
-- > data Example = Example
-- >   { exampleText :: !Text,
-- >     exampleBool :: !Bool
-- >   }
-- >
-- > instance HasCodec Example where
-- >   codec =
-- >     object "Example" $
-- >       Example
-- >         <$> requiredField "text" "a text" .= exampleText
-- >         <*> requiredField "bool" "a bool" .= exampleBool
--
--
-- ==== API Note
--
-- This is a forward-compatible version 'ObjectOfCodec' with a name.
--
-- > object name = ObjectOfCodec (Just name)
object :: Text -> ObjectCodec input output -> ValueCodec input output
object :: forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
name = forall input output.
Maybe Text -> ObjectCodec input output -> ValueCodec input output
ObjectOfCodec (forall a. a -> Maybe a
Just Text
name)

-- | A codec for bounded integers like 'Int', 'Int8', and 'Word'.
--
-- This codec will not have a name, and it will use the 'boundedNumberBounds' to add number bounds.
--
-- >>> let c = boundedIntegralCodec :: JSONCodec Int8
-- >>> toJSONVia c 5
-- Number 5.0
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 100)
-- Just 100
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 200)
-- Nothing
boundedIntegralCodec :: forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec :: forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec =
  forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec forall {b}.
(Integral b, Bounded b) =>
Scientific -> Either String b
go forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ NumberBounds -> JSONCodec Scientific
scientificWithBoundsCodec (forall i. (Integral i, Bounded i) => NumberBounds
boundedIntegralNumberBounds @i)
  where
    go :: Scientific -> Either String b
go Scientific
s = case forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
s of
      Maybe b
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Number did not fit into bounded integer: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
s
      Just b
i -> forall a b. b -> Either a b
Right b
i

-- | 'NumberBounds' for a bounded integral type.
--
-- You can call this using @TypeApplications@: @boundedIntegralNumberBounds @Word@
boundedIntegralNumberBounds :: forall i. (Integral i, Bounded i) => NumberBounds
boundedIntegralNumberBounds :: forall i. (Integral i, Bounded i) => NumberBounds
boundedIntegralNumberBounds =
  NumberBounds
    { numberBoundsLower :: Scientific
numberBoundsLower = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: i),
      numberBoundsUpper :: Scientific
numberBoundsUpper = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: i)
    }

-- | A safe codec for 'Integer'.
--
-- This codec does a bounds check for the range [-10^1024, 10^1024] it can safely parse very large numbers.
--
-- For a codec without this protection, see 'unsafeUnboundedIntegerCodec'.
--
-- === Example usage
--
-- >>> toJSONVia integerCodec 5
-- Number 5.0
-- >>> toJSONVia integerCodec (-1000000000000)
-- Number (-1.0e12)
-- >>> JSON.parseMaybe (parseJSONVia integerCodec) (Number (-4.0))
-- Just (-4)
-- >>> JSON.parseMaybe (parseJSONVia integerCodec) (Number (scientific 1 100000000))
-- Nothing
integerCodec :: JSONCodec Integer
integerCodec :: JSONCodec Integer
integerCodec =
  forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Scientific -> Either String Integer
go forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
    NumberBounds -> JSONCodec Scientific
scientificWithBoundsCodec
      ( NumberBounds
          { numberBoundsLower :: Scientific
numberBoundsLower = Integer -> Int -> Scientific
scientific (-Integer
1) Int
1024,
            numberBoundsUpper :: Scientific
numberBoundsUpper = Integer -> Int -> Scientific
scientific Integer
1 Int
1024
          }
      )
  where
    go :: Scientific -> Either String Integer
go Scientific
s = case forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
s :: Either Float Integer of
      Right Integer
i -> forall a b. b -> Either a b
Right Integer
i
      Left Float
_ -> forall a b. a -> Either a b
Left (String
"Number is not an integer: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
s)

-- | This is an unsafe (unchecked) version of 'integerCodec'.
unsafeUnboundedIntegerCodec :: JSONCodec Integer
unsafeUnboundedIntegerCodec :: JSONCodec Integer
unsafeUnboundedIntegerCodec =
  forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Scientific -> Either String Integer
go forall a b. (Integral a, Num b) => a -> b
fromIntegral JSONCodec Scientific
scientificCodec
  where
    go :: Scientific -> Either String Integer
go Scientific
s = case forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
s :: Either Float Integer of
      Right Integer
i -> forall a b. b -> Either a b
Right Integer
i
      Left Float
_ -> forall a b. a -> Either a b
Left (String
"Number is not an integer: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
s)

-- | A safe codec for 'Natural'.
--
-- This codec does a bounds check for the range [0, 10^1024] it can safely parse very large numbers.
--
-- For a codec without this protection, see 'unsafeUnboundedNaturalCodec'.
--
-- === Example usage
--
-- >>> toJSONVia naturalCodec 5
-- Number 5.0
-- >>> toJSONVia naturalCodec (1000000000000)
-- Number 1.0e12
-- >>> JSON.parseMaybe (parseJSONVia naturalCodec) (Number 4.0)
-- Just 4
-- >>> JSON.parseMaybe (parseJSONVia naturalCodec) (Number (scientific 1 100000000))
-- Nothing
naturalCodec :: JSONCodec Natural
naturalCodec :: JSONCodec Natural
naturalCodec =
  forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Scientific -> Either String Natural
go forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
    NumberBounds -> JSONCodec Scientific
scientificWithBoundsCodec
      ( NumberBounds
          { numberBoundsLower :: Scientific
numberBoundsLower = Integer -> Int -> Scientific
scientific Integer
0 Int
0,
            numberBoundsUpper :: Scientific
numberBoundsUpper = Integer -> Int -> Scientific
scientific Integer
1 Int
1024
          }
      )
  where
    go :: Scientific -> Either String Natural
go Scientific
s = case forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
s :: Either Float Natural of
      Right Natural
i -> forall a b. b -> Either a b
Right Natural
i
      Left Float
_ -> forall a b. a -> Either a b
Left (String
"Number is not an integer: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
s)

-- | This is an unsafe (unchecked) version of 'naturalCodec'.
unsafeUnboundedNaturalCodec :: JSONCodec Natural
unsafeUnboundedNaturalCodec :: JSONCodec Natural
unsafeUnboundedNaturalCodec =
  forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Scientific -> Either String Natural
go forall a b. (Integral a, Num b) => a -> b
fromIntegral JSONCodec Scientific
scientificCodec
  where
    go :: Scientific -> Either String Natural
go Scientific
s = case forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
s :: Either Float Natural of
      Right Natural
i -> forall a b. b -> Either a b
Right Natural
i
      Left Float
_ -> forall a b. a -> Either a b
Left (String
"Number is not an integer: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Scientific
s)

-- | A codec for a literal piece of 'Text'.
--
-- During parsing, only the given 'Text' is accepted.
--
-- During rendering, the given 'Text' is always output.
--
--
-- === Example usage
--
-- >>> let c = literalTextCodec "hello"
-- >>> toJSONVia c "hello"
-- String "hello"
-- >>> toJSONVia c "world"
-- String "hello"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "hello")
-- Just "hello"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "world")
-- Nothing
literalTextCodec :: Text -> JSONCodec Text
literalTextCodec :: Text -> JSONCodec Text
literalTextCodec Text
text = forall value.
(Show value, Eq value) =>
value -> JSONCodec value -> JSONCodec value
EqCodec Text
text JSONCodec Text
textCodec

-- | A codec for a literal value corresponding to a literal piece of 'Text'.
--
-- During parsing, only the given 'Text' is accepted.
--
-- During rendering, the given @value@ is always output.
--
--
-- === Example usage
--
-- >>> let c = literalTextValueCodec True "yes"
-- >>> toJSONVia c True
-- String "yes"
-- >>> toJSONVia c False
-- String "yes"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "yes") :: Maybe Bool
-- Just True
-- >>> JSON.parseMaybe (parseJSONVia c) (String "no") :: Maybe Bool
-- Nothing
literalTextValueCodec :: value -> Text -> JSONCodec value
literalTextValueCodec :: forall value. value -> Text -> JSONCodec value
literalTextValueCodec value
value Text
text = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (forall a b. a -> b -> a
const value
value) (forall a b. a -> b -> a
const Text
text) (Text -> JSONCodec Text
literalTextCodec Text
text)

-- | A choice codec, but unlike 'eitherCodec', it's for the same output type instead of different ones.
--
-- While parsing, this codec will first try the left codec, then the right if that fails.
--
-- While rendering, the provided function is used to decide which codec to use for rendering.
--
-- Note: The reason this is less primitive than the 'eitherCodec' is that 'Either' makes it clear which codec you want to use for rendering.
-- In this case, we need to provide our own function for choosing which codec we want to use for rendering.
--
--
-- === Example usage
--
-- >>> :{
--   let c =
--        matchChoiceCodec
--         (literalTextCodec "even")
--         (literalTextCodec "odd")
--         (\s -> if s == "even" then Left s else Right s)
-- :}
--
-- >>> toJSONVia c "even"
-- String "even"
-- >>> toJSONVia c "odd"
-- String "odd"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "even") :: Maybe Text
-- Just "even"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "odd") :: Maybe Text
-- Just "odd"
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'matchChoiceCodecAs PossiblyJointUnion':
--
-- > disjointMatchChoiceCodec = matchChoiceCodecAs PossiblyJointUnion
matchChoiceCodec ::
  -- | First codec
  Codec context input output ->
  -- | Second codec
  Codec context input' output ->
  -- | Rendering chooser
  (newInput -> Either input input') ->
  Codec context newInput output
matchChoiceCodec :: forall context input output input' newInput.
Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
matchChoiceCodec = forall context input output input' newInput.
Union
-> Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
matchChoiceCodecAs Union
PossiblyJointUnion

-- | Disjoint version of 'matchChoiceCodec'
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'matchChoiceCodecAs DisjointUnion':
--
-- > disjointMatchChoiceCodec = matchChoiceCodecAs DisjointUnion
disjointMatchChoiceCodec ::
  -- | First codec
  Codec context input output ->
  -- | Second codec
  Codec context input' output ->
  -- | Rendering chooser
  (newInput -> Either input input') ->
  Codec context newInput output
disjointMatchChoiceCodec :: forall context input output input' newInput.
Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
disjointMatchChoiceCodec = forall context input output input' newInput.
Union
-> Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
matchChoiceCodecAs Union
DisjointUnion

-- | An even more general version of 'matchChoiceCodec' and 'disjointMatchChoiceCodec'.
matchChoiceCodecAs ::
  -- | Is the union DisjointUnion or PossiblyJointUnion
  Union ->
  -- | First codec
  Codec context input output ->
  -- | Second codec
  Codec context input' output ->
  -- | Rendering chooser
  (newInput -> Either input input') ->
  Codec context newInput output
matchChoiceCodecAs :: forall context input output input' newInput.
Union
-> Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
matchChoiceCodecAs Union
union Codec context input output
c1 Codec context input' output
c2 newInput -> Either input input'
renderingChooser =
  forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id) newInput -> Either input input'
renderingChooser forall a b. (a -> b) -> a -> b
$
    forall context input output input2 output2.
Union
-> Codec context input output
-> Codec context input2 output2
-> Codec context (Either input input2) (Either output output2)
EitherCodec Union
union Codec context input output
c1 Codec context input' output
c2

-- | A choice codec for a list of options, each with their own rendering matcher.
--
-- During parsing, each of the codecs are tried from first to last until one succeeds.
--
-- During rendering, each matching function is tried until either one succeeds and the corresponding codec is used, or none succeed and the fallback codec is used.
--
--
-- === Example usage
--
-- >>> :{
--   let c =
--        matchChoicesCodec
--          [ (\s -> if s == "even" then Just s else Nothing, literalTextCodec "even")
--          , (\s -> if s == "odd" then Just s else Nothing, literalTextCodec "odd")
--          ] (literalTextCodec "fallback")
-- :}
--
-- >>> toJSONVia c "even"
-- String "even"
-- >>> toJSONVia c "odd"
-- String "odd"
-- >>> toJSONVia c "foobar"
-- String "fallback"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "even") :: Maybe Text
-- Just "even"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "odd") :: Maybe Text
-- Just "odd"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "foobar") :: Maybe Text
-- Nothing
-- >>> JSON.parseMaybe (parseJSONVia c) (String "fallback") :: Maybe Text
-- Just "fallback"
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'matchChoicesCodecAs DisjointUnion'.
--
-- > disjointMatchChoiceCodec = matchChoicesCodecAs DisjointUnion
matchChoicesCodec ::
  -- | Codecs, each with their own rendering matcher
  [(input -> Maybe input, Codec context input output)] ->
  -- | Fallback codec, in case none of the matchers in the list match
  Codec context input output ->
  Codec context input output
matchChoicesCodec :: forall input context output.
[(input -> Maybe input, Codec context input output)]
-> Codec context input output -> Codec context input output
matchChoicesCodec = forall input context output.
Union
-> [(input -> Maybe input, Codec context input output)]
-> Codec context input output
-> Codec context input output
matchChoicesCodecAs Union
PossiblyJointUnion

-- | Disjoint version of 'matchChoicesCodec'
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'matchChoicesCodecAs DisjointUnion'.
--
-- > disjointMatchChoiceCodec = matchChoicesCodecAs DisjointUnion
disjointMatchChoicesCodec ::
  -- | Codecs, each with their own rendering matcher
  [(input -> Maybe input, Codec context input output)] ->
  -- | Fallback codec, in case none of the matchers in the list match
  Codec context input output ->
  Codec context input output
disjointMatchChoicesCodec :: forall input context output.
[(input -> Maybe input, Codec context input output)]
-> Codec context input output -> Codec context input output
disjointMatchChoicesCodec = forall input context output.
Union
-> [(input -> Maybe input, Codec context input output)]
-> Codec context input output
-> Codec context input output
matchChoicesCodecAs Union
DisjointUnion

-- | An even more general version of 'matchChoicesCodec' and 'disjointMatchChoicesCodec'
matchChoicesCodecAs ::
  Union ->
  -- | Codecs, each with their own rendering matcher
  [(input -> Maybe input, Codec context input output)] ->
  -- | Fallback codec, in case none of the matchers in the list match
  Codec context input output ->
  Codec context input output
matchChoicesCodecAs :: forall input context output.
Union
-> [(input -> Maybe input, Codec context input output)]
-> Codec context input output
-> Codec context input output
matchChoicesCodecAs Union
union [(input -> Maybe input, Codec context input output)]
l Codec context input output
fallback = [(input -> Maybe input, Codec context input output)]
-> Codec context input output
go [(input -> Maybe input, Codec context input output)]
l
  where
    go :: [(input -> Maybe input, Codec context input output)]
-> Codec context input output
go = \case
      [] -> Codec context input output
fallback
      ((input -> Maybe input
m, Codec context input output
c) : [(input -> Maybe input, Codec context input output)]
rest) -> forall context input output input' newInput.
Union
-> Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
matchChoiceCodecAs Union
union Codec context input output
c ([(input -> Maybe input, Codec context input output)]
-> Codec context input output
go [(input -> Maybe input, Codec context input output)]
rest) forall a b. (a -> b) -> a -> b
$ \input
i -> case input -> Maybe input
m input
i of
        Just input
j -> forall a b. a -> Either a b
Left input
j
        Maybe input
Nothing -> forall a b. b -> Either a b
Right input
i

-- | Use one codec for the default way of parsing and rendering, but then also
-- use a list of other codecs for potentially different parsing.
--
-- You can use this for keeping old ways of parsing intact while already rendering in the new way.
--
--
-- === Example usage
--
-- >>> data Fruit = Apple | Orange deriving (Show, Eq, Bounded, Enum)
-- >>> let c = parseAlternatives shownBoundedEnumCodec [stringConstCodec [(Apple, "foo"), (Orange, "bar")]]
-- >>> toJSONVia c Apple
-- String "Apple"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "foo") :: Maybe Fruit
-- Just Apple
-- >>> JSON.parseMaybe (parseJSONVia c) (String "Apple") :: Maybe Fruit
-- Just Apple
-- >>> JSON.parseMaybe (parseJSONVia c) (String "Tomato") :: Maybe Fruit
-- Nothing
parseAlternatives ::
  -- | Main codec, for parsing and rendering
  Codec context input output ->
  -- | Alternative codecs just for parsing
  [Codec context input output] ->
  Codec context input output
parseAlternatives :: forall context input output.
Codec context input output
-> [Codec context input output] -> Codec context input output
parseAlternatives Codec context input output
c [Codec context input output]
rest = forall context input output.
NonEmpty (Codec context input output) -> Codec context input output
go (Codec context input output
c forall a. a -> [a] -> NonEmpty a
:| [Codec context input output]
rest)
  where
    go :: NonEmpty (Codec context input output) -> Codec context input output
    go :: forall context input output.
NonEmpty (Codec context input output) -> Codec context input output
go = \case
      (Codec context input output
c' :| [Codec context input output]
cRest) -> case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Codec context input output]
cRest of
        Maybe (NonEmpty (Codec context input output))
Nothing -> Codec context input output
c'
        Just NonEmpty (Codec context input output)
ne' -> forall context input output input' newInput.
Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
matchChoiceCodec Codec context input output
c' (forall context input output.
NonEmpty (Codec context input output) -> Codec context input output
go NonEmpty (Codec context input output)
ne') forall a b. a -> Either a b
Left

-- | Like 'parseAlternatives', but with only one alternative codec
--
--
-- === Example usage
-- ==== Values
--
-- >>> data Fruit = Apple | Orange deriving (Show, Eq, Bounded, Enum)
-- >>> let c = parseAlternative shownBoundedEnumCodec (stringConstCodec [(Apple, "foo"), (Orange, "bar")])
-- >>> toJSONVia c Apple
-- String "Apple"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "foo") :: Maybe Fruit
-- Just Apple
-- >>> JSON.parseMaybe (parseJSONVia c) (String "Apple") :: Maybe Fruit
-- Just Apple
--
-- ==== Required object fields
--
-- >>> data Fruit = Apple | Orange deriving (Show, Eq, Bounded, Enum)
-- >>> let c = shownBoundedEnumCodec
-- >>> let o = parseAlternative (requiredFieldWith "current" c "current key for this field") (requiredFieldWith "legacy" c "legacy key for this field")
-- >>> toJSONObjectVia o Apple
-- fromList [("current",String "Apple")]
-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("current",String "Apple")]) :: Maybe Fruit
-- Just Apple
-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("legacy",String "Apple")]) :: Maybe Fruit
-- Just Apple
-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("current",String "Tomato")]) :: Maybe Fruit
-- Nothing
--
-- ==== Required object fields
--
-- While 'parseAlternative' works exactly like you would expect it would with 'requiredField', using 'parseAlterternative' with optional fields has some pitfalls.
--
-- >>> data Fruit = Apple | Orange deriving (Show, Eq, Bounded, Enum)
-- >>> let c = shownBoundedEnumCodec
-- >>> let o = parseAlternative (optionalFieldWith "current" c "current key for this field") (optionalFieldWith "legacy" c "legacy key for this field")
-- >>> toJSONObjectVia o (Just Apple)
-- fromList [("current",String "Apple")]
-- >>> toJSONObjectVia o Nothing
-- fromList []
-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("current",String "Apple")]) :: Maybe (Maybe Fruit)
-- Just (Just Apple)
--
--
-- ! This is the important result !
-- The second 'optionalFieldWith' is not tried because the first one _succeeds_ in parsing 'Nothing'
--
-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("legacy",String "Apple")]) :: Maybe (Maybe Fruit)
-- Just Nothing
--
-- Here the parser succeeds as well, because it fails to parse the @current@ field, so it tries to parse the @legacy@ field, which is missing.
--
-- >>> JSON.parseMaybe (parseJSONObjectVia o) (KM.fromList [("current",String "Tomato")]) :: Maybe (Maybe Fruit)
-- Just Nothing
parseAlternative ::
  -- | Main codec, for parsing and rendering
  Codec context input output ->
  -- | Alternative codecs just for parsing
  Codec context input' output ->
  Codec context input output
parseAlternative :: forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative Codec context input output
c Codec context input' output
cAlt = forall context input output input' newInput.
Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
matchChoiceCodec Codec context input output
c Codec context input' output
cAlt forall a b. a -> Either a b
Left

-- | A codec for an enum that can be written each with their own codec.
--
--
-- === WARNING
--
-- If you don't provide a string for one of the type's constructors, the last codec in the list will be used instead.
enumCodec ::
  forall enum context.
  Eq enum =>
  NonEmpty (enum, Codec context enum enum) ->
  Codec context enum enum
enumCodec :: forall enum context.
Eq enum =>
NonEmpty (enum, Codec context enum enum) -> Codec context enum enum
enumCodec = NonEmpty (enum, Codec context enum enum) -> Codec context enum enum
go
  where
    go :: NonEmpty (enum, Codec context enum enum) -> Codec context enum enum
    go :: NonEmpty (enum, Codec context enum enum) -> Codec context enum enum
go ((enum
e, Codec context enum enum
c) :| [(enum, Codec context enum enum)]
rest) = case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [(enum, Codec context enum enum)]
rest of
      Maybe (NonEmpty (enum, Codec context enum enum))
Nothing -> Codec context enum enum
c
      Just NonEmpty (enum, Codec context enum enum)
ne -> forall context input output input' newInput.
Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
disjointMatchChoiceCodec Codec context enum enum
c (NonEmpty (enum, Codec context enum enum) -> Codec context enum enum
go NonEmpty (enum, Codec context enum enum)
ne) forall a b. (a -> b) -> a -> b
$ \enum
i ->
        if enum
e forall a. Eq a => a -> a -> Bool
== enum
i
          then forall a b. a -> Either a b
Left enum
e
          else forall a b. b -> Either a b
Right enum
i

-- | A codec for an enum that can be written as constant string values
--
--
-- === Example usage
--
-- >>> data Fruit = Apple | Orange deriving (Show, Eq)
-- >>> let c = stringConstCodec [(Apple, "foo"), (Orange, "bar")]
-- >>> toJSONVia c Orange
-- String "bar"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "foo") :: Maybe Fruit
-- Just Apple
--
--
-- === WARNING
--
-- If you don't provide a string for one of the type's constructors, the last string in the list will be used instead:
--
-- >>> let c = stringConstCodec [(Apple, "foo")]
-- >>> toJSONVia c Orange
-- String "foo"
stringConstCodec ::
  forall constant.
  Eq constant =>
  NonEmpty (constant, Text) ->
  JSONCodec constant
stringConstCodec :: forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec =
  forall enum context.
Eq enum =>
NonEmpty (enum, Codec context enum enum) -> Codec context enum enum
enumCodec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map
      ( \(constant
constant, Text
text) ->
          ( constant
constant,
            forall value. value -> Text -> JSONCodec value
literalTextValueCodec constant
constant Text
text
          )
      )

-- | A codec for a 'Bounded' 'Enum' that uses its 'Show' instance to have the values correspond to literal 'Text' values.
--
--
-- === Example usage
--
-- >>> data Fruit = Apple | Orange deriving (Show, Eq, Enum, Bounded)
-- >>> let c = shownBoundedEnumCodec
-- >>> toJSONVia c Apple
-- String "Apple"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "Orange") :: Maybe Fruit
-- Just Orange
shownBoundedEnumCodec ::
  forall enum.
  (Show enum, Eq enum, Enum enum, Bounded enum) =>
  JSONCodec enum
shownBoundedEnumCodec :: forall enum.
(Show enum, Eq enum, Enum enum, Bounded enum) =>
JSONCodec enum
shownBoundedEnumCodec =
  let ls :: [enum]
ls = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
   in case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [enum]
ls of
        Maybe (NonEmpty enum)
Nothing -> forall a. HasCallStack => String -> a
error String
"0 enum values ?!"
        Just NonEmpty enum
ne -> forall constant.
Eq constant =>
NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (\enum
v -> (enum
v, String -> Text
T.pack (forall a. Show a => a -> String
show enum
v))) NonEmpty enum
ne)

-- | Helper function for 'optionalFieldOrNullWith' and 'optionalFieldOrNull'.
--
-- You probably don't need this.
orNullHelper ::
  ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output)) ->
  ObjectCodec (Maybe input) (Maybe output)
orNullHelper :: forall input output.
ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
orNullHelper = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall input. Maybe (Maybe input) -> Maybe input
f forall output. Maybe output -> Maybe (Maybe output)
g
  where
    f :: Maybe (Maybe input) -> Maybe input
    f :: forall input. Maybe (Maybe input) -> Maybe input
f = \case
      Maybe (Maybe input)
Nothing -> forall a. Maybe a
Nothing
      Just Maybe input
Nothing -> forall a. Maybe a
Nothing
      Just (Just input
a) -> forall a. a -> Maybe a
Just input
a
    g :: Maybe output -> Maybe (Maybe output)
    g :: forall output. Maybe output -> Maybe (Maybe output)
g = \case
      Maybe output
Nothing -> forall a. Maybe a
Nothing
      Just output
a -> forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just output
a)

-- | Name a codec.
--
-- This is used to allow for references to the codec, and that's necessary
-- to produce finite documentation for recursive codecs.
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'ReferenceCodec'.
--
-- > named = ReferenceCodec
named :: Text -> ValueCodec input output -> ValueCodec input output
named :: forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named = forall input output.
Text -> ValueCodec input output -> ValueCodec input output
ReferenceCodec

-- | Produce a codec using a type's 'FromJSON' and 'ToJSON' instances.
--
-- You will only want to use this if you cannot figure out how to produce a
-- 'JSONCodec' for your type.
--
-- Note that this will not have good documentation because, at a codec level,
-- it's just parsing and rendering a 'JSON.Value'.
--
--
-- === Example usage
--
-- >>> toJSONVia (codecViaAeson "Int") (5 :: Int)
-- Number 5.0
-- >>> JSON.parseMaybe (parseJSONVia (codecViaAeson "Int")) (Number 5) :: Maybe Int
-- Just 5
codecViaAeson ::
  (FromJSON a, ToJSON a) =>
  -- | Name
  Text ->
  JSONCodec a
codecViaAeson :: forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
codecViaAeson Text
doc = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec (forall a b. (a -> Parser b) -> a -> Either String b
JSON.parseEither forall a. FromJSON a => Value -> Parser a
JSON.parseJSON) forall a. ToJSON a => a -> Value
JSON.toJSON JSONCodec Value
valueCodec forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
doc