{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# 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
import qualified Data.Aeson.Types as JSON
import Data.Coerce (Coercible)
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 Data.Word
import GHC.Generics (Generic)
import Numeric.Natural
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (KeyMap)
import qualified Data.Aeson.KeyMap as KM
#endif

-- $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.
type role Codec _ representational representational

data Codec context input output where
  -- | Encode '()' to the @null@ value, and decode @null@ as '()'.
  NullCodec ::
    (Coercible a (), Coercible b ()) =>
    ValueCodec a b
  -- | Encode a 'Bool' to a @boolean@ value, and decode a @boolean@ value as a 'Bool'.
  BoolCodec ::
    (Coercible a Bool, Coercible b Bool) =>
    -- | Name of the @bool@, for error messages and documentation.
    Maybe Text ->
    ValueCodec a b
  -- | 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 ::
    (Coercible a Text, Coercible b Text) =>
    -- | Name of the @string@, for error messages and documentation.
    Maybe Text ->
    ValueCodec a b
  -- | Encode 'Integer' to a @number@ value, and decode a @number@ value as an 'Integer'.
  --
  -- The number has 'Bounds Integer'.
  -- These are only enforced at decoding time, not at encoding-time.
  --
  -- NOTE: Decoding 'Integer's is dangerous so decoding may fail for enormous numbers.
  -- API NOTE: This is separate from 'NumberCodec' so that we can produce
  -- more precise documentation about whether the numbers are integers.
  IntegerCodec ::
    (Coercible a Integer, Coercible b Integer) =>
    -- | Name of the @integer@, for error messages and documentation.
    Maybe Text ->
    -- | Bounds for the integer, these are checked and documented
    Bounds Integer ->
    ValueCodec a b
  -- | Encode 'Scientific' to a @number@ value, and decode a @number@ value as a 'Scientific'.
  --
  -- The number has 'Bounds Scientific'.
  -- These are only enforced at decoding time, not at encoding-time.
  --
  -- NOTE: We use 'Scientific' here because that is what aeson uses.
  NumberCodec ::
    (Coercible a Scientific, Coercible b Scientific) =>
    -- | Name of the @number@, for error messages and documentation.
    Maybe Text ->
    -- | Bounds for the number, these are checked and documented
    Bounds Scientific ->
    ValueCodec a b
  -- | Encode a 'HashMap', and decode any 'HashMap'.
  HashMapCodec ::
    (Eq k, Hashable k, FromJSONKey k, ToJSONKey k, Coercible a (HashMap k v), Coercible b (HashMap k v)) =>
    JSONCodec v ->
    ValueCodec a b
  -- | Encode a 'Map', and decode any 'Map'.
  MapCodec ::
    (Ord k, FromJSONKey k, ToJSONKey k, Coercible a (Map k v), Coercible b (Map k v)) =>
    JSONCodec v ->
    ValueCodec a b
  -- | Encode a 'JSON.Value', and decode any 'JSON.Value'.
  ValueCodec ::
    (Coercible JSON.Value a, Coercible JSON.Value b) =>
    ValueCodec a b
  -- | Encode a 'Vector' of values as an @array@ value, and decode an @array@ value as a 'Vector' of values.
  ArrayOfCodec ::
    (Coercible a (Vector input), Coercible b (Vector output)) =>
    -- | Name of the @array@, for error messages and documentation.
    Maybe Text ->
    ValueCodec input output ->
    ValueCodec a b
  -- | 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, Coercible a value, Coercible b value) =>
    -- | Value to match
    value ->
    -- | Codec for the value
    JSONCodec value ->
    ValueCodec a b
  -- | 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 ::
    (Coercible a (Either input1 input2), Coercible b (Either output1 output2)) =>
    -- | 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 a b
  -- | 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 ::
    (Coercible a (Maybe input), Coercible b (Maybe output)) =>
    -- | Key
    Text ->
    -- | Codec for the value
    ValueCodec input output ->
    -- | Documentation
    Maybe Text ->
    ObjectCodec a b
  OptionalKeyWithDefaultCodec ::
    (Coercible b value) =>
    -- | Key
    Text ->
    -- | Codec for the value
    ValueCodec value value ->
    -- | Default value
    value ->
    -- | Documentation
    Maybe Text ->
    ObjectCodec value b
  OptionalKeyWithOmittedDefaultCodec ::
    (Eq value, Coercible a value, Coercible b value) =>
    -- | Key
    Text ->
    -- | Codec for the value
    ValueCodec value value ->
    -- | Default value
    value ->
    -- | Documentation
    Maybe Text ->
    ObjectCodec a b
  -- | 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 Bounds a = Bounds
  { -- | Lower bound, inclusive
    forall a. Bounds a -> Maybe a
boundsLower :: !(Maybe a),
    -- Upper bound, inclusive
    forall a. Bounds a -> Maybe a
boundsUpper :: !(Maybe a)
  }
  deriving (Int -> Bounds a -> ShowS
[Bounds a] -> ShowS
Bounds a -> String
(Int -> Bounds a -> ShowS)
-> (Bounds a -> String) -> ([Bounds a] -> ShowS) -> Show (Bounds a)
forall a. Show a => Int -> Bounds a -> ShowS
forall a. Show a => [Bounds a] -> ShowS
forall a. Show a => Bounds a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Bounds a -> ShowS
showsPrec :: Int -> Bounds a -> ShowS
$cshow :: forall a. Show a => Bounds a -> String
show :: Bounds a -> String
$cshowList :: forall a. Show a => [Bounds a] -> ShowS
showList :: [Bounds a] -> ShowS
Show, Bounds a -> Bounds a -> Bool
(Bounds a -> Bounds a -> Bool)
-> (Bounds a -> Bounds a -> Bool) -> Eq (Bounds a)
forall a. Eq a => Bounds a -> Bounds a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Bounds a -> Bounds a -> Bool
== :: Bounds a -> Bounds a -> Bool
$c/= :: forall a. Eq a => Bounds a -> Bounds a -> Bool
/= :: Bounds a -> Bounds a -> Bool
Eq, Eq (Bounds a)
Eq (Bounds a) =>
(Bounds a -> Bounds a -> Ordering)
-> (Bounds a -> Bounds a -> Bool)
-> (Bounds a -> Bounds a -> Bool)
-> (Bounds a -> Bounds a -> Bool)
-> (Bounds a -> Bounds a -> Bool)
-> (Bounds a -> Bounds a -> Bounds a)
-> (Bounds a -> Bounds a -> Bounds a)
-> Ord (Bounds a)
Bounds a -> Bounds a -> Bool
Bounds a -> Bounds a -> Ordering
Bounds a -> Bounds a -> Bounds a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Bounds a)
forall a. Ord a => Bounds a -> Bounds a -> Bool
forall a. Ord a => Bounds a -> Bounds a -> Ordering
forall a. Ord a => Bounds a -> Bounds a -> Bounds a
$ccompare :: forall a. Ord a => Bounds a -> Bounds a -> Ordering
compare :: Bounds a -> Bounds a -> Ordering
$c< :: forall a. Ord a => Bounds a -> Bounds a -> Bool
< :: Bounds a -> Bounds a -> Bool
$c<= :: forall a. Ord a => Bounds a -> Bounds a -> Bool
<= :: Bounds a -> Bounds a -> Bool
$c> :: forall a. Ord a => Bounds a -> Bounds a -> Bool
> :: Bounds a -> Bounds a -> Bool
$c>= :: forall a. Ord a => Bounds a -> Bounds a -> Bool
>= :: Bounds a -> Bounds a -> Bool
$cmax :: forall a. Ord a => Bounds a -> Bounds a -> Bounds a
max :: Bounds a -> Bounds a -> Bounds a
$cmin :: forall a. Ord a => Bounds a -> Bounds a -> Bounds a
min :: Bounds a -> Bounds a -> Bounds a
Ord, (forall x. Bounds a -> Rep (Bounds a) x)
-> (forall x. Rep (Bounds a) x -> Bounds a) -> Generic (Bounds a)
forall x. Rep (Bounds a) x -> Bounds a
forall x. Bounds a -> Rep (Bounds a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Bounds a) x -> Bounds a
forall a x. Bounds a -> Rep (Bounds a) x
$cfrom :: forall a x. Bounds a -> Rep (Bounds a) x
from :: forall x. Bounds a -> Rep (Bounds a) x
$cto :: forall a x. Rep (Bounds a) x -> Bounds a
to :: forall x. Rep (Bounds a) x -> Bounds a
Generic, (forall a b. (a -> b) -> Bounds a -> Bounds b)
-> (forall a b. a -> Bounds b -> Bounds a) -> Functor Bounds
forall a b. a -> Bounds b -> Bounds a
forall a b. (a -> b) -> Bounds a -> Bounds b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Bounds a -> Bounds b
fmap :: forall a b. (a -> b) -> Bounds a -> Bounds b
$c<$ :: forall a b. a -> Bounds b -> Bounds a
<$ :: forall a b. a -> Bounds b -> Bounds a
Functor)

instance (Validity a) => Validity (Bounds a)

emptyBounds :: Bounds a
emptyBounds :: forall a. Bounds a
emptyBounds = Maybe a -> Maybe a -> Bounds a
forall a. Maybe a -> Maybe a -> Bounds a
Bounds Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing

boundedBounds :: (Bounded a) => Bounds a
boundedBounds :: forall a. Bounded a => Bounds a
boundedBounds =
  Bounds
    { boundsLower :: Maybe a
boundsLower = a -> Maybe a
forall a. a -> Maybe a
Just a
forall a. Bounded a => a
minBound,
      boundsUpper :: Maybe a
boundsUpper = a -> Maybe a
forall a. a -> Maybe a
Just a
forall a. Bounded a => a
maxBound
    }

-- | Check if a number falls within given 'NumberBounds'.
checkBounds :: (Show a, Ord a) => Bounds a -> a -> Either String a
checkBounds :: forall a. (Show a, Ord a) => Bounds a -> a -> Either String a
checkBounds Bounds {Maybe a
boundsLower :: forall a. Bounds a -> Maybe a
boundsUpper :: forall a. Bounds a -> Maybe a
boundsLower :: Maybe a
boundsUpper :: Maybe a
..} a
s =
  case Maybe a
boundsLower of
    Just a
lo | a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
lo -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Number", a -> String
forall a. Show a => a -> String
show a
s, String
"is smaller than the lower bound", a -> String
forall a. Show a => a -> String
show a
lo]
    Maybe a
_ -> case Maybe a
boundsUpper of
      Just a
hi | a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
hi -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Number", a -> String
forall a. Show a => a -> String
show a
s, String
"is bigger than the upper bound", a -> String
forall a. Show a => a -> String
show a
hi]
      Maybe a
_ -> a -> Either String a
forall a b. b -> Either a b
Right a
s

data IntegerBoundsSymbolic
  = BitUInt !Word8 -- w bit unsigned int
  | BitSInt !Word8 -- w bit signed int
  | OtherIntegerBounds !(Maybe IntegerSymbolic) !(Maybe IntegerSymbolic)

guessIntegerBoundsSymbolic :: Bounds Integer -> IntegerBoundsSymbolic
guessIntegerBoundsSymbolic :: Bounds Integer -> IntegerBoundsSymbolic
guessIntegerBoundsSymbolic Bounds {Maybe Integer
boundsLower :: forall a. Bounds a -> Maybe a
boundsUpper :: forall a. Bounds a -> Maybe a
boundsLower :: Maybe Integer
boundsUpper :: Maybe Integer
..} =
  case (Integer -> IntegerSymbolic
guessIntegerSymbolic (Integer -> IntegerSymbolic)
-> Maybe Integer -> Maybe IntegerSymbolic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
boundsLower, Integer -> IntegerSymbolic
guessIntegerSymbolic (Integer -> IntegerSymbolic)
-> Maybe Integer -> Maybe IntegerSymbolic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
boundsUpper) of
    (Just IntegerSymbolic
Zero, Just (PowerOf2MinusOne Word8
w)) -> Word8 -> IntegerBoundsSymbolic
BitUInt Word8
w
    (Just (MinusPowerOf2 Word8
w1), Just (PowerOf2MinusOne Word8
w2)) | Word8
w1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w2 -> Word8 -> IntegerBoundsSymbolic
BitSInt (Word8 -> Word8
forall a. Enum a => a -> a
succ Word8
w1)
    (Maybe IntegerSymbolic
l, Maybe IntegerSymbolic
u) -> Maybe IntegerSymbolic
-> Maybe IntegerSymbolic -> IntegerBoundsSymbolic
OtherIntegerBounds Maybe IntegerSymbolic
l Maybe IntegerSymbolic
u

data IntegerSymbolic
  = Zero
  | PowerOf2 !Word8 -- 2^w
  | PowerOf2MinusOne !Word8 -- 2^w -1
  | MinusPowerOf2 !Word8 -- - 2^w
  | MinusPowerOf2MinusOne !Word8 -- - (2^w -1)
  | OtherInteger !Integer

guessIntegerSymbolic :: Integer -> IntegerSymbolic
guessIntegerSymbolic :: Integer -> IntegerSymbolic
guessIntegerSymbolic Integer
i =
  let log2Rounded :: Word8
      log2Rounded :: Word8
log2Rounded = Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)) :: Double)
      guess :: Integer
      guess :: Integer
guess = Integer
2 Integer -> Word8 -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Word8
log2Rounded
   in if
        | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> IntegerSymbolic
Zero
        | Integer
guess Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i -> Word8 -> IntegerSymbolic
PowerOf2 Word8
log2Rounded
        | (Integer
guess Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i -> Word8 -> IntegerSymbolic
PowerOf2MinusOne Word8
log2Rounded
        | -Integer
guess Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i -> Word8 -> IntegerSymbolic
MinusPowerOf2 Word8
log2Rounded
        | -(Integer
guess Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i -> Word8 -> IntegerSymbolic
MinusPowerOf2MinusOne Word8
log2Rounded
        | Bool
otherwise -> Integer -> IntegerSymbolic
OtherInteger Integer
i

-- | 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
(Int -> Union -> ShowS)
-> (Union -> String) -> ([Union] -> ShowS) -> Show Union
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Union -> ShowS
showsPrec :: Int -> Union -> ShowS
$cshow :: Union -> String
show :: Union -> String
$cshowList :: [Union] -> ShowS
showList :: [Union] -> ShowS
Show, Union -> Union -> Bool
(Union -> Union -> Bool) -> (Union -> Union -> Bool) -> Eq Union
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Union -> Union -> Bool
== :: Union -> Union -> Bool
$c/= :: Union -> Union -> Bool
/= :: Union -> Union -> Bool
Eq, (forall x. Union -> Rep Union x)
-> (forall x. Rep Union x -> Union) -> Generic Union
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
$cfrom :: forall x. Union -> Rep Union x
from :: forall x. Union -> Rep Union x
$cto :: forall x. Rep Union x -> Union
to :: forall x. Rep Union x -> Union
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 = (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"") (ShowS -> String)
-> (Codec context input output -> ShowS)
-> Codec context input output
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State (Set Text) ShowS -> Set Text -> ShowS
forall s a. State s a -> s -> a
`evalState` Set Text
forall a. Set a
S.empty) (State (Set Text) ShowS -> ShowS)
-> (Codec context input output -> State (Set Text) ShowS)
-> Codec context input output
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Codec context input output -> State (Set Text) ShowS
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 -> ShowS -> State (Set Text) ShowS
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS -> State (Set Text) ShowS)
-> ShowS -> State (Set Text) ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"NullCodec"
      BoolCodec Maybe Text
mName -> ShowS -> State (Set Text) ShowS
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS -> State (Set Text) ShowS)
-> ShowS -> State (Set Text) ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"BoolCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName
      StringCodec Maybe Text
mName -> ShowS -> State (Set Text) ShowS
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS -> State (Set Text) ShowS)
-> ShowS -> State (Set Text) ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"StringCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName
      IntegerCodec Maybe Text
mName Bounds Integer
mbs -> ShowS -> State (Set Text) ShowS
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS -> State (Set Text) ShowS)
-> ShowS -> State (Set Text) ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"IntegerCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bounds Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bounds Integer
mbs
      NumberCodec Maybe Text
mName Bounds Scientific
mbs -> ShowS -> State (Set Text) ShowS
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS -> State (Set Text) ShowS)
-> ShowS -> State (Set Text) ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"NumberCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bounds Scientific -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bounds Scientific
mbs
      ArrayOfCodec Maybe Text
mName ValueCodec input output
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ArrayOfCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ValueCodec input output -> State (Set Text) ShowS
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ObjectOfCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mName ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ObjectCodec input output -> State (Set Text) ShowS
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 -> ShowS -> State (Set Text) ShowS
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS -> State (Set Text) ShowS)
-> ShowS -> State (Set Text) ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ValueCodec"
      MapCodec JSONCodec v
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"MapCodec" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> JSONCodec v -> State (Set Text) ShowS
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"HashMapCodec" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> JSONCodec v -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 JSONCodec v
c
      EqCodec value
value JSONCodec value
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"EqCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> value -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 value
value ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> JSONCodec value -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 JSONCodec value
c
      BimapCodec oldOutput -> Either String output
_ input -> oldInput
_ Codec context oldInput oldOutput
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"BimapCodec _ _ " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Codec context oldInput oldOutput -> State (Set Text) ShowS
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"EitherCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Union -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Union
u ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2) (ShowS -> ShowS -> ShowS)
-> State (Set Text) ShowS
-> StateT (Set Text) Identity (ShowS -> ShowS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Codec context input1 output1 -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 Codec context input1 output1
c1 StateT (Set Text) Identity (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall a b.
StateT (Set Text) Identity (a -> b)
-> StateT (Set Text) Identity a -> StateT (Set Text) Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Codec context input2 output2 -> State (Set Text) ShowS
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 <- ((Text, (Text, ObjectCodec Void output)) -> State (Set Text) ShowS)
-> [(Text, (Text, ObjectCodec Void output))]
-> StateT (Set Text) Identity [ShowS]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(Text
n, (Text
_, ObjectCodec Void output
c)) -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> ShowS
forall a. Show a => a -> ShowS
shows Text
n ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ObjectCodec Void output -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ObjectCodec Void output
c) ([(Text, (Text, ObjectCodec Void output))]
 -> StateT (Set Text) Identity [ShowS])
-> [(Text, (Text, ObjectCodec Void output))]
-> StateT (Set Text) Identity [ShowS]
forall a b. (a -> b) -> a -> b
$ HashMap Text (Text, ObjectCodec Void output)
-> [(Text, (Text, ObjectCodec Void output))]
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
"[" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id (ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (String -> ShowS
showString String
", ") [ShowS]
cs) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]"
        ShowS -> State (Set Text) ShowS
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS -> State (Set Text) ShowS)
-> ShowS -> State (Set Text) ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"DiscriminatedUnionCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
propertyName ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" _ " ShowS -> ShowS -> ShowS
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"CommentCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
comment ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ValueCodec input output -> State (Set Text) ShowS
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 <- (Set Text -> Bool) -> StateT (Set Text) Identity Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Text
name)
        if Bool
alreadySeen
          then ShowS -> State (Set Text) ShowS
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS -> State (Set Text) ShowS)
-> ShowS -> State (Set Text) ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ReferenceCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
name
          else do
            (Set Text -> Set Text) -> StateT (Set Text) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
S.insert Text
name)
            ShowS
s <- Int -> ValueCodec input output -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ValueCodec input output
c
            ShowS -> State (Set Text) ShowS
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS -> State (Set Text) ShowS)
-> ShowS -> State (Set Text) ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ReferenceCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"RequiredKeyCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mdoc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ValueCodec input output -> State (Set Text) ShowS
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"OptionalKeyCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mdoc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ValueCodec input output -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ValueCodec input output
c
      OptionalKeyWithDefaultCodec Text
k ValueCodec input input
c input
_ Maybe Text
mdoc -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"OptionalKeyWithDefaultCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" _ " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mdoc) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ValueCodec input input -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ValueCodec input input
c
      OptionalKeyWithOmittedDefaultCodec Text
k ValueCodec value value
c value
_ Maybe Text
mdoc -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"OptionalKeyWithOmittedDefaultCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Text
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" _ " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe Text
mdoc) (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ValueCodec value value -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ValueCodec value value
c
      PureCodec output
_ -> ShowS -> State (Set Text) ShowS
forall a. a -> StateT (Set Text) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS -> State (Set Text) ShowS)
-> ShowS -> State (Set Text) ShowS
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ApCodec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2) (ShowS -> ShowS -> ShowS)
-> State (Set Text) ShowS
-> StateT (Set Text) Identity (ShowS -> ShowS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ObjectCodec input (output -> output) -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 ObjectCodec input (output -> output)
oc1 StateT (Set Text) Identity (ShowS -> ShowS)
-> State (Set Text) ShowS -> State (Set Text) ShowS
forall a b.
StateT (Set Text) Identity (a -> b)
-> StateT (Set Text) Identity a -> StateT (Set Text) Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ObjectCodec input output -> State (Set Text) ShowS
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 = (oldOutput -> newOutput)
-> (input -> input)
-> Codec context input oldOutput
-> Codec context input newOutput
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec oldOutput -> newOutput
f input -> input
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 = (a -> b) -> Codec context input a -> Codec context input b
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 = (output -> output)
-> (newInput -> oldInput)
-> Codec context oldInput output
-> Codec context newInput output
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec output -> output
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
(.=) = ((newInput -> oldInput)
 -> ObjectCodec oldInput output -> ObjectCodec newInput output)
-> ObjectCodec oldInput output
-> (newInput -> oldInput)
-> ObjectCodec newInput output
forall a b c. (a -> b -> c) -> b -> a -> c
flip (newInput -> oldInput)
-> ObjectCodec oldInput output -> ObjectCodec newInput output
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 = (oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec (newOutput -> Either String newOutput
forall a b. b -> Either a b
Right (newOutput -> Either String newOutput)
-> (oldOutput -> newOutput) -> oldOutput -> Either String newOutput
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 = output -> ObjectCodec input output
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 = ObjectCodec input (output -> newOutput)
-> ObjectCodec input output -> ObjectCodec input newOutput
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 = a -> ObjectCodec input a
forall output input. output -> ObjectCodec input output
pureCodec
  <*> :: forall a b.
ObjectCodec input (a -> b)
-> ObjectCodec input a -> ObjectCodec input 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.
  (Either () output -> Maybe output)
-> (Maybe input -> Either () input)
-> Codec Value (Either () input) (Either () output)
-> Codec Value (Maybe input) (Maybe output)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either () output -> Maybe output
forall {a}. Either () a -> Maybe a
f Maybe input -> Either () input
forall {b}. Maybe b -> Either () b
g
    (Codec Value (Either () input) (Either () output)
 -> Codec Value (Maybe input) (Maybe output))
-> (ValueCodec input output
    -> Codec Value (Either () input) (Either () output))
-> ValueCodec input output
-> Codec Value (Maybe input) (Maybe output)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codec Value () ()
-> ValueCodec input output
-> Codec Value (Either () input) (Either () output)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
possiblyJointEitherCodec Codec Value () ()
nullCodec
  where
    f :: Either () a -> Maybe a
f = \case
      Left () -> Maybe a
forall a. Maybe a
Nothing
      Right a
r -> a -> Maybe a
forall a. a -> Maybe a
Just a
r
    g :: Maybe b -> Either () b
g = \case
      Maybe b
Nothing -> () -> Either () b
forall a b. a -> Either a b
Left ()
      Just b
r -> b -> Either () b
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 = Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
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 = Union
-> Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
forall a value v b output1 output2 context.
(Coercible a (Either value v),
 Coercible b (Either output1 output2)) =>
Union
-> Codec context value output1
-> Codec context v output2
-> Codec context a b
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 = Union
-> Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
forall a value v b output1 output2 context.
(Coercible a (Either value v),
 Coercible b (Either output1 output2)) =>
Union
-> Codec context value output1
-> Codec context v output2
-> Codec context a b
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 = (any -> ())
-> (a -> b) -> Codec context b any -> Codec context a ()
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (() -> any -> ()
forall a b. a -> b -> a
const ()) (b -> a -> b
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 = (b -> a)
-> (Void -> any) -> Codec context any b -> Codec context Void a
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec b -> a
f Void -> any
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 = Text
-> (input -> (Text, ObjectCodec input ()))
-> HashMap Text (Text, ObjectCodec Void output)
-> ObjectCodec input output
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 -> (oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
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' (oldOutput -> Either String oldOutput)
-> (oldOutput -> Either String newOutput)
-> oldOutput
-> Either String newOutput
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> oldOutput -> Either String newOutput
f) (oldInput -> oldInput
g' (oldInput -> oldInput)
-> (newInput -> oldInput) -> newInput -> oldInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. newInput -> oldInput
g) Codec context oldInput oldOutput
c
    Codec context oldInput oldOutput
c -> (oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
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 = Maybe Text
-> ValueCodec input output
-> ValueCodec (Vector input) (Vector output)
forall a value b v.
(Coercible a (Vector value), Coercible b (Vector v)) =>
Maybe Text -> ValueCodec value v -> ValueCodec a b
ArrayOfCodec Maybe Text
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 = (Vector output -> [output])
-> ([input] -> Vector input)
-> Codec Value (Vector input) (Vector output)
-> Codec Value [input] [output]
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Vector output -> [output]
forall a. Vector a -> [a]
V.toList [input] -> Vector input
forall a. [a] -> Vector a
V.fromList (Codec Value (Vector input) (Vector output)
 -> Codec Value [input] [output])
-> (ValueCodec input output
    -> Codec Value (Vector input) (Vector output))
-> ValueCodec input output
-> Codec Value [input] [output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueCodec input output
-> Codec Value (Vector input) (Vector output)
forall input output.
ValueCodec input output
-> ValueCodec (Vector input) (Vector output)
vectorCodec

-- Some restricted constructors
optionalKeyCodec :: Text -> ValueCodec input output -> Maybe Text -> ObjectCodec (Maybe input) (Maybe output)
optionalKeyCodec :: forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
optionalKeyCodec = Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
forall a value b v.
(Coercible a (Maybe value), Coercible b (Maybe v)) =>
Text -> ValueCodec value v -> Maybe Text -> ObjectCodec a b
OptionalKeyCodec

optionalKeyWithDefaultCodec ::
  -- | Key
  Text ->
  -- | Codec for the value
  ValueCodec value value ->
  -- | Default value
  value ->
  -- | Documentation
  Maybe Text ->
  ObjectCodec value value
optionalKeyWithDefaultCodec :: forall value.
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
optionalKeyWithDefaultCodec = Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
forall b value.
Coercible b value =>
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value b
OptionalKeyWithDefaultCodec

-- | 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 = ([output] -> Either String (NonEmpty output))
-> (NonEmpty input -> [input])
-> Codec Value [input] [output]
-> Codec Value (NonEmpty input) (NonEmpty output)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec [output] -> Either String (NonEmpty output)
forall {a}. [a] -> Either String (NonEmpty a)
parseNonEmptyList NonEmpty input -> [input]
forall a. NonEmpty a -> [a]
NE.toList (Codec Value [input] [output]
 -> Codec Value (NonEmpty input) (NonEmpty output))
-> (ValueCodec input output -> Codec Value [input] [output])
-> ValueCodec input output
-> Codec Value (NonEmpty input) (NonEmpty output)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueCodec input output -> Codec Value [input] [output]
forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec
  where
    parseNonEmptyList :: [a] -> Either String (NonEmpty a)
parseNonEmptyList [a]
l = case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
l of
      Maybe (NonEmpty a)
Nothing -> String -> Either String (NonEmpty a)
forall a b. a -> Either a b
Left String
"Expected a nonempty list, but got an empty list."
      Just NonEmpty a
ne -> NonEmpty a -> Either String (NonEmpty a)
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 = (Either output [output] -> [output])
-> ([input] -> Either input [input])
-> Codec Value (Either input [input]) (Either output [output])
-> Codec Value [input] [output]
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either output [output] -> [output]
forall {a}. Either a [a] -> [a]
f [input] -> Either input [input]
forall {a}. [a] -> Either a [a]
g (Codec Value (Either input [input]) (Either output [output])
 -> Codec Value [input] [output])
-> Codec Value (Either input [input]) (Either output [output])
-> Codec Value [input] [output]
forall a b. (a -> b) -> a -> b
$ ValueCodec input output
-> Codec Value [input] [output]
-> Codec Value (Either input [input]) (Either output [output])
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 (Codec Value [input] [output]
 -> Codec Value (Either input [input]) (Either output [output]))
-> Codec Value [input] [output]
-> Codec Value (Either input [input]) (Either output [output])
forall a b. (a -> b) -> a -> b
$ ValueCodec input output -> Codec Value [input] [output]
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] -> a -> Either a [a]
forall a b. a -> Either a b
Left a
v
      [a]
vs -> [a] -> Either a [a]
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 = (Either output (NonEmpty output) -> NonEmpty output)
-> (NonEmpty input -> Either input (NonEmpty input))
-> Codec
     Value
     (Either input (NonEmpty input))
     (Either output (NonEmpty output))
-> Codec Value (NonEmpty input) (NonEmpty output)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either output (NonEmpty output) -> NonEmpty output
forall {a}. Either a (NonEmpty a) -> NonEmpty a
f NonEmpty input -> Either input (NonEmpty input)
forall {a}. NonEmpty a -> Either a (NonEmpty a)
g (Codec
   Value
   (Either input (NonEmpty input))
   (Either output (NonEmpty output))
 -> Codec Value (NonEmpty input) (NonEmpty output))
-> Codec
     Value
     (Either input (NonEmpty input))
     (Either output (NonEmpty output))
-> Codec Value (NonEmpty input) (NonEmpty output)
forall a b. (a -> b) -> a -> b
$ ValueCodec input output
-> Codec Value (NonEmpty input) (NonEmpty output)
-> Codec
     Value
     (Either input (NonEmpty input))
     (Either output (NonEmpty output))
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 (Codec Value (NonEmpty input) (NonEmpty output)
 -> Codec
      Value
      (Either input (NonEmpty input))
      (Either output (NonEmpty output)))
-> Codec Value (NonEmpty input) (NonEmpty output)
-> Codec
     Value
     (Either input (NonEmpty input))
     (Either output (NonEmpty output))
forall a b. (a -> b) -> a -> b
$ ValueCodec input output
-> Codec Value (NonEmpty input) (NonEmpty output)
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 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| []
      Right NonEmpty a
vs -> NonEmpty a
vs
    g :: NonEmpty a -> Either a (NonEmpty a)
g = \case
      a
v :| [] -> a -> Either a (NonEmpty a)
forall a b. a -> Either a b
Left a
v
      NonEmpty a
vs -> NonEmpty a -> Either a (NonEmpty a)
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 = Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec input output
forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec input output
RequiredKeyCodec Text
key ValueCodec input output
c (Text -> Maybe Text
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 = Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec input output
forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec input output
RequiredKeyCodec Text
key ValueCodec input output
c Maybe Text
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 = Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
forall a value b v.
(Coercible a (Maybe value), Coercible b (Maybe v)) =>
Text -> ValueCodec value v -> Maybe Text -> ObjectCodec a b
OptionalKeyCodec Text
key ValueCodec input output
c (Text -> Maybe Text
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 = Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
forall a value b v.
(Coercible a (Maybe value), Coercible b (Maybe v)) =>
Text -> ValueCodec value v -> Maybe Text -> ObjectCodec a b
OptionalKeyCodec Text
key ValueCodec input output
c Maybe Text
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 = Text
-> JSONCodec output
-> output
-> Maybe Text
-> ObjectCodec output output
forall b value.
Coercible b value =>
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value b
OptionalKeyWithDefaultCodec Text
key JSONCodec output
c output
defaultValue (Text -> Maybe Text
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 = Text
-> JSONCodec output
-> output
-> Maybe Text
-> ObjectCodec output output
forall b value.
Coercible b value =>
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value b
OptionalKeyWithDefaultCodec Text
key JSONCodec output
c output
defaultValue Maybe Text
forall a. Maybe a
Nothing

-- | Like 'optionalFieldWithDefaultWith', but also interpret @null@ as the
-- default value.
optionalFieldOrNullWithDefaultWith ::
  (Eq output) =>
  -- | Key
  Text ->
  -- | Codec for the value
  JSONCodec output ->
  -- | Default value
  output ->
  -- | Documentation
  Text ->
  ObjectCodec output output
optionalFieldOrNullWithDefaultWith :: forall output.
Eq output =>
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
optionalFieldOrNullWithDefaultWith Text
key JSONCodec output
c output
defaultValue Text
doc = (Maybe output -> output)
-> (output -> Maybe output)
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
-> Codec (KeyMap Value) output output
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 (Codec (KeyMap Value) (Maybe output) (Maybe output)
 -> Codec (KeyMap Value) output output)
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
-> Codec (KeyMap Value) output output
forall a b. (a -> b) -> a -> b
$ Text
-> JSONCodec (Maybe output)
-> Maybe output
-> Text
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
forall output.
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
optionalFieldWithDefaultWith Text
key (JSONCodec output -> JSONCodec (Maybe output)
forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec JSONCodec output
c) (output -> Maybe output
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 output -> output -> Bool
forall a. Eq a => a -> a -> Bool
== output
defaultValue then Maybe output
forall a. Maybe a
Nothing else output -> Maybe output
forall a. a -> Maybe a
Just output
v

-- | Like 'optionalFieldOrNullWithDefaultWith', but without documentation.
optionalFieldOrNullWithDefaultWith' ::
  (Eq output) =>
  -- | Key
  Text ->
  -- | Codec for the value
  JSONCodec output ->
  -- | Default value
  output ->
  ObjectCodec output output
optionalFieldOrNullWithDefaultWith' :: forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldOrNullWithDefaultWith' Text
key JSONCodec output
c output
defaultValue = (Maybe output -> output)
-> (output -> Maybe output)
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
-> Codec (KeyMap Value) output output
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 (Codec (KeyMap Value) (Maybe output) (Maybe output)
 -> Codec (KeyMap Value) output output)
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
-> Codec (KeyMap Value) output output
forall a b. (a -> b) -> a -> b
$ Text
-> JSONCodec (Maybe output)
-> Maybe output
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
forall output.
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithDefaultWith' Text
key (JSONCodec output -> JSONCodec (Maybe output)
forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec JSONCodec output
c) (output -> Maybe output
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 output -> output -> Bool
forall a. Eq a => a -> a -> Bool
== output
defaultValue then Maybe output
forall a. Maybe a
Nothing else output -> Maybe output
forall a. a -> Maybe a
Just output
v

-- | 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 = Text
-> JSONCodec output
-> output
-> Maybe Text
-> ObjectCodec output output
forall value a b.
(Eq value, Coercible a value, Coercible b value) =>
Text
-> ValueCodec value value -> value -> Maybe Text -> ObjectCodec a b
OptionalKeyWithOmittedDefaultCodec Text
key JSONCodec output
c output
defaultValue (Text -> Maybe Text
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 = Text
-> JSONCodec output
-> output
-> Maybe Text
-> ObjectCodec output output
forall value a b.
(Eq value, Coercible a value, Coercible b value) =>
Text
-> ValueCodec value value -> value -> Maybe Text -> ObjectCodec a b
OptionalKeyWithOmittedDefaultCodec Text
key JSONCodec output
c output
defaultValue Maybe Text
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 = (Maybe output -> output)
-> (output -> Maybe output)
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
-> Codec (KeyMap Value) output output
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 (Codec (KeyMap Value) (Maybe output) (Maybe output)
 -> Codec (KeyMap Value) output output)
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
-> Codec (KeyMap Value) output output
forall a b. (a -> b) -> a -> b
$ Text
-> JSONCodec (Maybe output)
-> Maybe output
-> Text
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
forall output.
Eq output =>
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith Text
key (JSONCodec output -> JSONCodec (Maybe output)
forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec JSONCodec output
c) (output -> Maybe output
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 output -> output -> Bool
forall a. Eq a => a -> a -> Bool
== output
defaultValue then Maybe output
forall a. Maybe a
Nothing else output -> Maybe output
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 = (Maybe output -> output)
-> (output -> Maybe output)
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
-> Codec (KeyMap Value) output output
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 (Codec (KeyMap Value) (Maybe output) (Maybe output)
 -> Codec (KeyMap Value) output output)
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
-> Codec (KeyMap Value) output output
forall a b. (a -> b) -> a -> b
$ Text
-> JSONCodec (Maybe output)
-> Maybe output
-> Codec (KeyMap Value) (Maybe output) (Maybe output)
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith' Text
key (JSONCodec output -> JSONCodec (Maybe output)
forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec JSONCodec output
c) (output -> Maybe output
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 output -> output -> Bool
forall a. Eq a => a -> a -> Bool
== output
defaultValue then Maybe output
forall a. Maybe a
Nothing else output -> Maybe output
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 = ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
forall input output.
ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
orNullHelper (ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
 -> ObjectCodec (Maybe input) (Maybe output))
-> ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
forall a b. (a -> b) -> a -> b
$ Text
-> ValueCodec (Maybe input) (Maybe output)
-> Maybe Text
-> ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
forall a value b v.
(Coercible a (Maybe value), Coercible b (Maybe v)) =>
Text -> ValueCodec value v -> Maybe Text -> ObjectCodec a b
OptionalKeyCodec Text
key (ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec ValueCodec input output
c) (Text -> Maybe Text
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 = ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
forall input output.
ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
orNullHelper (ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
 -> ObjectCodec (Maybe input) (Maybe output))
-> ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
forall a b. (a -> b) -> a -> b
$ Text
-> ValueCodec (Maybe input) (Maybe output)
-> Maybe Text
-> ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
forall a value b v.
(Coercible a (Maybe value), Coercible b (Maybe v)) =>
Text -> ValueCodec value v -> Maybe Text -> ObjectCodec a b
OptionalKeyCodec Text
key (ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec ValueCodec input output
c) Maybe Text
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
(<?>) = (Text -> ValueCodec input output -> ValueCodec input output)
-> ValueCodec input output -> Text -> ValueCodec input output
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> ValueCodec input output -> ValueCodec input output
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 = Text -> ValueCodec input output -> ValueCodec input output
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 = JSONCodec v -> ValueCodec (HashMap k v) (HashMap k v)
forall value a v b.
(Eq value, Hashable value, FromJSONKey value, ToJSONKey value,
 Coercible a (HashMap value v), Coercible b (HashMap value v)) =>
JSONCodec v -> ValueCodec a b
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 = JSONCodec v -> ValueCodec (Map k v) (Map k v)
forall value a v b.
(Ord value, FromJSONKey value, ToJSONKey value,
 Coercible a (Map value v), Coercible b (Map value v)) =>
JSONCodec v -> ValueCodec a b
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 Maybe (Coercion (Map Key Any) (KeyMap Any))
forall v. Maybe (Coercion (Map Key v) (KeyMap v))
KM.coercionToMap of
  -- Can coerce to Map, use
  Just Coercion (Map Key Any) (KeyMap Any)
_ -> (Map Key v -> KeyMap v)
-> (KeyMap v -> Map Key v)
-> Codec Value (Map Key v) (Map Key v)
-> JSONCodec (KeyMap v)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Map Key v -> KeyMap v
forall v. Map Key v -> KeyMap v
KM.fromMap KeyMap v -> Map Key v
forall v. KeyMap v -> Map Key v
KM.toMap (Codec Value (Map Key v) (Map Key v) -> JSONCodec (KeyMap v))
-> (JSONCodec v -> Codec Value (Map Key v) (Map Key v))
-> JSONCodec v
-> JSONCodec (KeyMap v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONCodec v -> Codec Value (Map Key v) (Map Key v)
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 -> (HashMap Key v -> KeyMap v)
-> (KeyMap v -> HashMap Key v)
-> Codec Value (HashMap Key v) (HashMap Key v)
-> JSONCodec (KeyMap v)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec HashMap Key v -> KeyMap v
forall v. HashMap Key v -> KeyMap v
KM.fromHashMap KeyMap v -> HashMap Key v
forall v. KeyMap v -> HashMap Key v
KM.toHashMap (Codec Value (HashMap Key v) (HashMap Key v)
 -> JSONCodec (KeyMap v))
-> (JSONCodec v -> Codec Value (HashMap Key v) (HashMap Key v))
-> JSONCodec v
-> JSONCodec (KeyMap v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONCodec v -> Codec Value (HashMap Key v) (HashMap Key v)
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
forall a b.
(Coercible Value a, Coercible Value b) =>
ValueCodec a b
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 :: Codec Value () ()
nullCodec = Codec Value () ()
forall a b. (Coercible a (), Coercible b ()) => ValueCodec a b
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
forall a b.
(Coercible a Bool, Coercible b Bool) =>
Maybe Text -> ValueCodec a b
BoolCodec Maybe Text
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
forall a b.
(Coercible a Text, Coercible b Text) =>
Maybe Text -> ValueCodec a b
StringCodec Maybe Text
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 = (Text -> String)
-> (String -> Text) -> JSONCodec Text -> JSONCodec String
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 -> Bounds Scientific -> JSONCodec Scientific
forall a b.
(Coercible a Scientific, Coercible b Scientific) =>
Maybe Text -> Bounds Scientific -> ValueCodec a b
NumberCodec Maybe Text
forall a. Maybe a
Nothing Bounds Scientific
forall a. Bounds a
emptyBounds

-- | Codec for 'Integer' values
--
-- This codec does a bounds check for the range [-10^1024, 10^1024] it can safely parse very large numbers.
--
--
-- === 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
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'IntegerCodec' without a name.
--
-- > scientificCodec = IntegerCodec Nothing Nothing
--
-- For a codec without this protection, see 'unsafeUnboundedIntegerCodec'.
integerCodec :: JSONCodec Integer
integerCodec :: JSONCodec Integer
integerCodec = Maybe Text -> Bounds Integer -> JSONCodec Integer
forall a b.
(Coercible a Integer, Coercible b Integer) =>
Maybe Text -> Bounds Integer -> ValueCodec a b
IntegerCodec Maybe Text
forall a. Maybe a
Nothing Bounds Integer
forall a. Bounds a
emptyBounds

-- | A codec for 'Natural' values.
--
-- 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 =
  (Integer -> Natural)
-> (Natural -> Integer) -> JSONCodec Integer -> JSONCodec Natural
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (JSONCodec Integer -> JSONCodec Natural)
-> JSONCodec Integer -> JSONCodec Natural
forall a b. (a -> b) -> a -> b
$
    Bounds Integer -> JSONCodec Integer
integerWithBoundsCodec
      ( Bounds
          { boundsLower :: Maybe Integer
boundsLower = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0,
            boundsUpper :: Maybe Integer
boundsUpper = Maybe Integer
forall a. Maybe a
Nothing
          }
      )

-- | Codec for 'Scientific' values with bounds
--
--
-- === Example usage
--
-- >>> let c = scientificWithBoundsCodec Bounds {boundsLower = Just 2, boundsUpper = Just 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 bounds
scientificWithBoundsCodec :: Bounds Scientific -> JSONCodec Scientific
scientificWithBoundsCodec :: Bounds Scientific -> JSONCodec Scientific
scientificWithBoundsCodec Bounds Scientific
bounds = Maybe Text -> Bounds Scientific -> JSONCodec Scientific
forall a b.
(Coercible a Scientific, Coercible b Scientific) =>
Maybe Text -> Bounds Scientific -> ValueCodec a b
NumberCodec Maybe Text
forall a. Maybe a
Nothing Bounds Scientific
bounds

-- | Codec for 'Integer' values with bounds
--
--
-- === Example usage
--
-- >>> let c = integerWithBoundsCodec Bounds {boundsLower = Just 2, boundsUpper = Just 4}
-- >>> toJSONVia c 3
-- Number 3.0
-- >>> toJSONVia c 5
-- Number 5.0
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 3)
-- Just 3
-- >>> JSON.parseMaybe (parseJSONVia c) (Number 5)
-- Nothing
--
-- ==== API Note
--
-- This is a forward-compatible version of 'IntegerCodec' without a name.
--
-- > integerWithBoundsCodec bounds = IntegerCodec Nothing bounds
integerWithBoundsCodec :: Bounds Integer -> JSONCodec Integer
integerWithBoundsCodec :: Bounds Integer -> JSONCodec Integer
integerWithBoundsCodec Bounds Integer
bounds = Maybe Text -> Bounds Integer -> JSONCodec Integer
forall a b.
(Coercible a Integer, Coercible b Integer) =>
Maybe Text -> Bounds Integer -> ValueCodec a b
IntegerCodec Maybe Text
forall a. Maybe a
Nothing Bounds Integer
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 = Maybe Text -> ObjectCodec input output -> ValueCodec input output
forall input output.
Maybe Text -> ObjectCodec input output -> ValueCodec input output
ObjectOfCodec (Text -> Maybe Text
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 =
  (Integer -> i)
-> (i -> Integer) -> JSONCodec Integer -> Codec Value i i
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Integer -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (JSONCodec Integer -> Codec Value i i)
-> JSONCodec Integer -> Codec Value i i
forall a b. (a -> b) -> a -> b
$ Bounds Integer -> JSONCodec Integer
integerWithBoundsCodec (forall i. (Integral i, Bounded i) => Bounds Integer
boundedIntegralBounds @i)

-- | 'NumberBounds' for a bounded integral type.
--
-- You can call this using @TypeApplications@: @boundedIntegralBounds @Word@
boundedIntegralBounds :: forall i. (Integral i, Bounded i) => Bounds Integer
boundedIntegralBounds :: forall i. (Integral i, Bounded i) => Bounds Integer
boundedIntegralBounds = i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> Integer) -> Bounds i -> Bounds Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Bounded a => Bounds a
boundedBounds @i

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

-- | This is an unsafe (unchecked) version of 'naturalCodec'.
unsafeUnboundedNaturalCodec :: JSONCodec Natural
unsafeUnboundedNaturalCodec :: JSONCodec Natural
unsafeUnboundedNaturalCodec =
  (Scientific -> Either String Natural)
-> (Natural -> Scientific)
-> JSONCodec Scientific
-> JSONCodec Natural
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 Natural -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral JSONCodec Scientific
scientificCodec
  where
    go :: Scientific -> Either String Natural
go Scientific
s = case Scientific -> Either Float Natural
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
Scientific.floatingOrInteger Scientific
s :: Either Float Natural of
      Right Natural
i -> Natural -> Either String Natural
forall a b. b -> Either a b
Right Natural
i
      Left Float
_ -> String -> Either String Natural
forall a b. a -> Either a b
Left (String
"Number is not an integer: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
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 = Text -> JSONCodec Text -> JSONCodec Text
forall value a b.
(Show value, Eq value, Coercible a value, Coercible b value) =>
value -> ValueCodec value value -> ValueCodec a b
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 = (Text -> value)
-> (value -> Text) -> JSONCodec Text -> Codec Value value value
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (value -> Text -> value
forall a b. a -> b -> a
const value
value) (Text -> value -> Text
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 = Union
-> Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
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 = Union
-> Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
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 =
  (Either output output -> output)
-> (newInput -> Either input input')
-> Codec context (Either input input') (Either output output)
-> Codec context newInput output
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec ((output -> output)
-> (output -> output) -> Either output output -> output
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either output -> output
forall a. a -> a
id output -> output
forall a. a -> a
id) newInput -> Either input input'
renderingChooser (Codec context (Either input input') (Either output output)
 -> Codec context newInput output)
-> Codec context (Either input input') (Either output output)
-> Codec context newInput output
forall a b. (a -> b) -> a -> b
$
    Union
-> Codec context input output
-> Codec context input' output
-> Codec context (Either input input') (Either output output)
forall a value v b output1 output2 context.
(Coercible a (Either value v),
 Coercible b (Either output1 output2)) =>
Union
-> Codec context value output1
-> Codec context v output2
-> Codec context a b
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 = Union
-> [(input -> Maybe input, Codec context input output)]
-> Codec context input output
-> Codec context input output
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 = Union
-> [(input -> Maybe input, Codec context input output)]
-> Codec context input output
-> Codec context input output
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) -> Union
-> Codec context input output
-> Codec context input output
-> (input -> Either input input)
-> Codec context input output
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) ((input -> Either input input) -> Codec context input output)
-> (input -> Either input input) -> Codec context input output
forall a b. (a -> b) -> a -> b
$ \input
i -> case input -> Maybe input
m input
i of
        Just input
j -> input -> Either input input
forall a b. a -> Either a b
Left input
j
        Maybe input
Nothing -> input -> Either input input
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 = NonEmpty (Codec context input output) -> Codec context input output
forall context input output.
NonEmpty (Codec context input output) -> Codec context input output
go (Codec context input output
c Codec context input output
-> [Codec context input output]
-> NonEmpty (Codec context input output)
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 [Codec context input output]
-> Maybe (NonEmpty (Codec context input output))
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' -> Codec context input output
-> Codec context input output
-> (input -> Either input input)
-> Codec context input output
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' (NonEmpty (Codec context input output) -> Codec context input output
forall context input output.
NonEmpty (Codec context input output) -> Codec context input output
go NonEmpty (Codec context input output)
ne') input -> Either input input
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 = Codec context input output
-> Codec context input' output
-> (input -> Either input input')
-> Codec context input output
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 input -> Either input input'
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 [(enum, Codec context enum enum)]
-> Maybe (NonEmpty (enum, Codec context enum enum))
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 -> Codec context enum enum
-> Codec context enum enum
-> (enum -> Either enum enum)
-> Codec context enum enum
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) ((enum -> Either enum enum) -> Codec context enum enum)
-> (enum -> Either enum enum) -> Codec context enum enum
forall a b. (a -> b) -> a -> b
$ \enum
i ->
        if enum
e enum -> enum -> Bool
forall a. Eq a => a -> a -> Bool
== enum
i
          then enum -> Either enum enum
forall a b. a -> Either a b
Left enum
e
          else enum -> Either enum enum
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 =
  NonEmpty (constant, Codec Value constant constant)
-> Codec Value constant constant
forall enum context.
Eq enum =>
NonEmpty (enum, Codec context enum enum) -> Codec context enum enum
enumCodec
    (NonEmpty (constant, Codec Value constant constant)
 -> Codec Value constant constant)
-> (NonEmpty (constant, Text)
    -> NonEmpty (constant, Codec Value constant constant))
-> NonEmpty (constant, Text)
-> Codec Value constant constant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((constant, Text) -> (constant, Codec Value constant constant))
-> NonEmpty (constant, Text)
-> NonEmpty (constant, Codec Value constant constant)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map
      ( \(constant
constant, Text
text) ->
          ( constant
constant,
            constant -> Text -> Codec Value constant constant
forall value. value -> Text -> JSONCodec value
literalTextValueCodec constant
constant Text
text
          )
      )

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

-- | 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 = (enum -> Text) -> JSONCodec enum
forall enum.
(Eq enum, Enum enum, Bounded enum) =>
(enum -> Text) -> JSONCodec enum
boundedEnumCodec (String -> Text
T.pack (String -> Text) -> (enum -> String) -> enum -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. enum -> String
forall a. Show a => a -> String
show)

-- | 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 = (Maybe (Maybe output) -> Maybe output)
-> (Maybe input -> Maybe (Maybe input))
-> Codec
     (KeyMap Value) (Maybe (Maybe input)) (Maybe (Maybe output))
-> Codec (KeyMap Value) (Maybe input) (Maybe output)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Maybe (Maybe output) -> Maybe output
forall input. Maybe (Maybe input) -> Maybe input
f Maybe input -> Maybe (Maybe input)
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 -> Maybe input
forall a. Maybe a
Nothing
      Just Maybe input
Nothing -> Maybe input
forall a. Maybe a
Nothing
      Just (Just input
a) -> input -> Maybe input
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 -> Maybe (Maybe output)
forall a. Maybe a
Nothing
      Just output
a -> Maybe output -> Maybe (Maybe output)
forall a. a -> Maybe a
Just (output -> Maybe output
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 = Text -> ValueCodec input output -> ValueCodec input output
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 = (Value -> Either String a)
-> (a -> Value) -> JSONCodec Value -> Codec Value a a
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec ((Value -> Parser a) -> Value -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
JSON.parseEither Value -> Parser a
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON) a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON JSONCodec Value
valueCodec Codec Value a a -> Text -> Codec Value a a
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
doc

-- Could get this from https://hackage.haskell.org/package/either-result-0.3.1.0/docs/Control-Monad-Result.html#t:Result
-- but just reimplementing here to avoid a dependency, as it's not exported anyway
-- (well it is actually, until we give this module an explicit export list).
-- We need to do this because `Either String a` doesn't have a `MonadFail` instance,
-- but `Time.iso8601ParseM` expects it's return value to have a `MonadFail` instance.
newtype Result a = Result {forall a. Result a -> Either String a
runResult :: Either String a}
  deriving newtype ((forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
fmap :: forall a b. (a -> b) -> Result a -> Result b
$c<$ :: forall a b. a -> Result b -> Result a
<$ :: forall a b. a -> Result b -> Result a
Functor, Functor Result
Functor Result =>
(forall a. a -> Result a)
-> (forall a b. Result (a -> b) -> Result a -> Result b)
-> (forall a b c.
    (a -> b -> c) -> Result a -> Result b -> Result c)
-> (forall a b. Result a -> Result b -> Result b)
-> (forall a b. Result a -> Result b -> Result a)
-> Applicative Result
forall a. a -> Result a
forall a b. Result a -> Result b -> Result a
forall a b. Result a -> Result b -> Result b
forall a b. Result (a -> b) -> Result a -> Result b
forall a b c. (a -> b -> c) -> Result a -> Result b -> Result c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Result a
pure :: forall a. a -> Result a
$c<*> :: forall a b. Result (a -> b) -> Result a -> Result b
<*> :: forall a b. Result (a -> b) -> Result a -> Result b
$cliftA2 :: forall a b c. (a -> b -> c) -> Result a -> Result b -> Result c
liftA2 :: forall a b c. (a -> b -> c) -> Result a -> Result b -> Result c
$c*> :: forall a b. Result a -> Result b -> Result b
*> :: forall a b. Result a -> Result b -> Result b
$c<* :: forall a b. Result a -> Result b -> Result a
<* :: forall a b. Result a -> Result b -> Result a
Applicative, Applicative Result
Applicative Result =>
(forall a b. Result a -> (a -> Result b) -> Result b)
-> (forall a b. Result a -> Result b -> Result b)
-> (forall a. a -> Result a)
-> Monad Result
forall a. a -> Result a
forall a b. Result a -> Result b -> Result b
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Result a -> (a -> Result b) -> Result b
>>= :: forall a b. Result a -> (a -> Result b) -> Result b
$c>> :: forall a b. Result a -> Result b -> Result b
>> :: forall a b. Result a -> Result b -> Result b
$creturn :: forall a. a -> Result a
return :: forall a. a -> Result a
Monad)

instance MonadFail Result where
  fail :: forall a. String -> Result a
fail = Either String a -> Result a
forall a. Either String a -> Result a
Result (Either String a -> Result a)
-> (String -> Either String a) -> String -> Result a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left

-- TODO 'aeson' has it's own custom datetime serialising code in the module @Data.Aeson.Encoding.Builder@:
-- The core function here is `Data.Aeson.Encoding.Builder.timeOfDay64`.
-- However, this module is private.
-- There is @Data.Aeson.Encoding.Internal@, which interestingly isn't private, but it's only exposed functions
-- wrap the return bytestring in a quotes. Only for the quotes to be removed in `Data.Aeson.Types.ToJSON.stringEncoding`
-- This all seems a bit silly.
-- I think `aeson` should just expose @Data.Aeson.Encoding.Builder@ and it's datetime instances should just take those builders,
-- convert them to Text and be done with it.
-- I plan to submit a PR to 'aeson' to do this.
-- In the meantime, I think the best way to ensure we are exactly behaving as 'aeson' is just to _assume_ aeson is returning a string
-- This is a correct assumption for any of the datetime types, but using this function generally is unsafe.
unsafeCodecViaAesonString ::
  (FromJSON a, ToJSON a) =>
  -- | Name
  Text ->
  JSONCodec a
unsafeCodecViaAesonString :: forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
unsafeCodecViaAesonString Text
doc = (Text -> Either String a)
-> (a -> Text) -> JSONCodec Text -> Codec Value a a
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec ((Value -> Parser a) -> Value -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
JSON.parseEither Value -> Parser a
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON (Value -> Either String a)
-> (Text -> Value) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
JSON.String) (Value -> Text
unsafeAesonValueToString (Value -> Text) -> (a -> Value) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON) JSONCodec Text
textCodec Codec Value a a -> Text -> Codec Value a a
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
doc
  where
    unsafeAesonValueToString :: Value -> Text
unsafeAesonValueToString Value
v = case Value
v of
      JSON.String Text
s -> Text
s
      Value
_ -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"unsafeAesonValueToString failed.\n " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n is not a JSON string."