{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}

module Autodocodec.Codec where

import Control.Monad.State
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import qualified Data.Aeson as JSON
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (KeyMap)
import qualified Data.Aeson.KeyMap as KM
#endif
import qualified Data.Aeson.Types as JSON
import Data.HashMap.Strict (HashMap)
import Data.Hashable
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 GHC.Generics (Generic)

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

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

instance Validity NumberBounds

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

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

instance Validity Union

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

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

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

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

-- | Show a codec to a human.
--
-- This function exists for codec debugging.
-- It omits any unshowable information from the output.
showCodecABit :: Codec context input output -> String
showCodecABit :: 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 :: Int -> Codec context input output -> State (Set Text) ShowS
go Int
d = \case
      Codec context input output
NullCodec -> ShowS -> State (Set Text) ShowS
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 (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 (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
      NumberCodec Maybe Text
mName Maybe NumberBounds
mbs -> ShowS -> State (Set Text) ShowS
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 -> Maybe NumberBounds -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe NumberBounds
mbs
      ArrayOfCodec Maybe Text
mName ValueCodec input output
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d 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 (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 input
value JSONCodec input
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 -> input -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 input
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 input -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 JSONCodec input
c
      BimapCodec oldOutput -> Either String output
_ input -> oldInput
_ Codec context oldInput oldOutput
c -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d 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 (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
      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 (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 (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 JSONCodec 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 -> JSONCodec input -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 JSONCodec input
c
      OptionalKeyWithOmittedDefaultCodec Text
k JSONCodec input
c input
_ Maybe Text
mdoc -> (\ShowS
s -> Bool -> ShowS -> ShowS
showParen (Int
d 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 -> JSONCodec input -> State (Set Text) ShowS
forall context input output.
Int -> Codec context input output -> State (Set Text) ShowS
go Int
11 JSONCodec input
c
      PureCodec output
_ -> ShowS -> State (Set Text) ShowS
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 (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 :: (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 :: (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 :: (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
.= :: 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 :: (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 :: output -> ObjectCodec input output
pureCodec = output -> ObjectCodec input output
forall output void. output -> ObjectCodec void 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 :: 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 :: a -> ObjectCodec input a
pure = a -> ObjectCodec input a
forall output void. output -> ObjectCodec void output
pureCodec
  <*> :: 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 :: 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)
-> ValueCodec (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)
 -> ValueCodec (Maybe input) (Maybe output))
-> (ValueCodec input output
    -> Codec Value (Either () input) (Either () output))
-> ValueCodec input output
-> ValueCodec (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 :: 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 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 :: 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 context input1 output1 input2 output2.
Union
-> Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
EitherCodec Union
DisjointUnion

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

-- | 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 :: (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 :: ValueCodec input output
-> ValueCodec (Vector input) (Vector output)
vectorCodec = Maybe Text
-> ValueCodec input output
-> ValueCodec (Vector input) (Vector output)
forall v output.
Maybe Text
-> ValueCodec v output -> ValueCodec (Vector v) (Vector output)
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 :: ValueCodec input output -> ValueCodec [input] [output]
listCodec = (Vector output -> [output])
-> ([input] -> Vector input)
-> Codec Value (Vector input) (Vector output)
-> ValueCodec [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)
 -> ValueCodec [input] [output])
-> (ValueCodec input output
    -> Codec Value (Vector input) (Vector output))
-> ValueCodec input output
-> ValueCodec [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

-- | 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 :: ValueCodec input output
-> ValueCodec (NonEmpty input) (NonEmpty output)
nonEmptyCodec = ([output] -> Either String (NonEmpty output))
-> (NonEmpty input -> [input])
-> Codec Value [input] [output]
-> ValueCodec (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]
 -> ValueCodec (NonEmpty input) (NonEmpty output))
-> (ValueCodec input output -> Codec Value [input] [output])
-> ValueCodec input output
-> ValueCodec (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 :: 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])
-> ValueCodec [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])
 -> ValueCodec [input] [output])
-> Codec Value (Either input [input]) (Either output [output])
-> ValueCodec [input] [output]
forall a b. (a -> b) -> a -> b
$ ValueCodec input output
-> ValueCodec [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 (ValueCodec [input] [output]
 -> Codec Value (Either input [input]) (Either output [output]))
-> ValueCodec [input] [output]
-> Codec Value (Either input [input]) (Either output [output])
forall a b. (a -> b) -> a -> b
$ ValueCodec input output -> ValueCodec [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 :: 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))
-> ValueCodec (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))
 -> ValueCodec (NonEmpty input) (NonEmpty output))
-> Codec
     Value
     (Either input (NonEmpty input))
     (Either output (NonEmpty output))
-> ValueCodec (NonEmpty input) (NonEmpty output)
forall a b. (a -> b) -> a -> b
$ ValueCodec input output
-> ValueCodec (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 (ValueCodec (NonEmpty input) (NonEmpty output)
 -> Codec
      Value
      (Either input (NonEmpty input))
      (Either output (NonEmpty output)))
-> ValueCodec (NonEmpty input) (NonEmpty output)
-> Codec
     Value
     (Either input (NonEmpty input))
     (Either output (NonEmpty output))
forall a b. (a -> b) -> a -> b
$ ValueCodec input output
-> ValueCodec (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 :: 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' :: 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 :: 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 input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
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' :: 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 input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
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 :: 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 value.
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
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' :: 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 value.
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
OptionalKeyWithDefaultCodec Text
key JSONCodec output
c output
defaultValue Maybe Text
forall a. Maybe a
Nothing

-- | An optional field with default value that can be omitted when encoding
--
-- During decoding, the field may be in the object. The default value will be parsed otherwise.
--
-- During encoding, the field will be omitted from the object if it is equal to the default value.
--
-- The shown version of the default value will appear in the documentation.
optionalFieldWithOmittedDefaultWith ::
  Eq output =>
  -- | Key
  Text ->
  -- | Codec for the value
  JSONCodec output ->
  -- | Default value
  output ->
  -- | Documentation
  Text ->
  ObjectCodec output output
optionalFieldWithOmittedDefaultWith :: 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.
Eq value =>
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
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' :: 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.
Eq value =>
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
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 :: 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 Object (Maybe output) (Maybe output)
-> ObjectCodec 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 Object (Maybe output) (Maybe output)
 -> ObjectCodec output output)
-> Codec Object (Maybe output) (Maybe output)
-> ObjectCodec output output
forall a b. (a -> b) -> a -> b
$ Text
-> JSONCodec (Maybe output)
-> Maybe output
-> Text
-> Codec Object (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' :: Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith' Text
key JSONCodec output
c output
defaultValue = (Maybe output -> output)
-> (output -> Maybe output)
-> Codec Object (Maybe output) (Maybe output)
-> ObjectCodec 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 Object (Maybe output) (Maybe output)
 -> ObjectCodec output output)
-> Codec Object (Maybe output) (Maybe output)
-> ObjectCodec output output
forall a b. (a -> b) -> a -> b
$ Text
-> JSONCodec (Maybe output)
-> Maybe output
-> Codec Object (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 :: 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 input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
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' :: 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 input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
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
<?> :: 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
<??> :: 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 :: JSONCodec v -> JSONCodec (HashMap k v)
hashMapCodec = JSONCodec v -> JSONCodec (HashMap k v)
forall k v.
(Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>
JSONCodec v -> JSONCodec (HashMap k v)
HashMapCodec

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

#if MIN_VERSION_aeson(2,0,0)
-- | Encode a 'KeyMap', and decode any 'KeyMap'.
--
-- This chooses 'hashMapCodec' or 'mapCodec' based on @ordered-keymap@ flag in aeson.
keyMapCodec ::
    -- |
    JSONCodec v ->
    -- |
    JSONCodec (KeyMap v)
keyMapCodec :: 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
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 () ()
NullCodec

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

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

-- | An object codec with a given name
--
--
-- === Example usage
--
-- > data Example = Example
-- >   { exampleText :: !Text,
-- >     exampleBool :: !Bool
-- >   }
-- >
-- > instance HasCodec Example where
-- >   codec =
-- >     object "Example" $
-- >       Example
-- >         <$> requiredField "text" "a text" .= exampleText
-- >         <*> requiredField "bool" "a bool" .= exampleBool
--
--
-- ==== API Note
--
-- This is a forward-compatible version 'ObjectOfCodec' with a name.
--
-- > object name = ObjectOfCodec (Just name)
object :: Text -> ObjectCodec input output -> ValueCodec input output
object :: 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 :: JSONCodec i
boundedIntegralCodec =
  (Scientific -> Either String i)
-> (i -> Scientific) -> JSONCodec Scientific -> JSONCodec i
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Scientific -> Either String i
forall b. (Integral b, Bounded b) => Scientific -> Either String b
go i -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (JSONCodec Scientific -> JSONCodec i)
-> JSONCodec Scientific -> JSONCodec i
forall a b. (a -> b) -> a -> b
$ NumberBounds -> JSONCodec Scientific
scientificWithBoundsCodec ((Integral i, Bounded i) => NumberBounds
forall i. (Integral i, Bounded i) => NumberBounds
boundedIntegralNumberBounds @i)
  where
    go :: Scientific -> Either String b
go Scientific
s = case Scientific -> Maybe b
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
s of
      Maybe b
Nothing -> String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"Number did not fit into bounded integer: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
s
      Just b
i -> b -> Either String b
forall a b. b -> Either a b
Right b
i

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

-- | 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.
(Show value, Eq value) =>
value -> JSONCodec value -> JSONCodec value
EqCodec Text
text JSONCodec Text
textCodec

-- | A codec for a literal value corresponding to a literal piece of 'Text'.
--
-- During parsing, only the given 'Text' is accepted.
--
-- During rendering, the given @value@ is always output.
--
--
-- === Example usage
--
-- >>> let c = literalTextValueCodec True "yes"
-- >>> toJSONVia c True
-- String "yes"
-- >>> toJSONVia c False
-- String "yes"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "yes") :: Maybe Bool
-- Just True
-- >>> JSON.parseMaybe (parseJSONVia c) (String "no") :: Maybe Bool
-- Nothing
literalTextValueCodec :: value -> Text -> JSONCodec value
literalTextValueCodec :: value -> Text -> JSONCodec value
literalTextValueCodec value
value Text
text = (Text -> value)
-> (value -> Text) -> JSONCodec Text -> JSONCodec 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 :: 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 :: 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 :: 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 context input1 output1 input2 output2.
Union
-> Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
EitherCodec Union
union Codec context input output
c1 Codec context input' output
c2

-- | A choice codec for a list of options, each with their own rendering matcher.
--
-- During parsing, each of the codecs are tried from first to last until one succeeds.
--
-- During rendering, each matching function is tried until either one succeeds and the corresponding codec is used, or none succeed and the fallback codec is used.
--
--
-- === Example usage
--
-- >>> :{
--   let c =
--        matchChoicesCodec
--          [ (\s -> if s == "even" then Just s else Nothing, literalTextCodec "even")
--          , (\s -> if s == "odd" then Just s else Nothing, literalTextCodec "odd")
--          ] (literalTextCodec "fallback")
-- :}
--
-- >>> toJSONVia c "even"
-- String "even"
-- >>> toJSONVia c "odd"
-- String "odd"
-- >>> toJSONVia c "foobar"
-- String "fallback"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "even") :: Maybe Text
-- Just "even"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "odd") :: Maybe Text
-- Just "odd"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "foobar") :: Maybe Text
-- Nothing
-- >>> JSON.parseMaybe (parseJSONVia c) (String "fallback") :: Maybe Text
-- Just "fallback"
--
--
-- ==== API Note
--
-- This is a forward-compatible version of 'matchChoicesCodecAs DisjointUnion'.
--
-- > disjointMatchChoiceCodec = matchChoicesCodecAs DisjointUnion
matchChoicesCodec ::
  -- | Codecs, each which 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 :: [(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 which 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 :: [(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 which 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 :: 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
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 :: 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 :: 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
--
-- >>> 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
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 :: 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 :: 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 :: NonEmpty (constant, Text) -> JSONCodec constant
stringConstCodec =
  NonEmpty (constant, JSONCodec constant) -> JSONCodec constant
forall enum context.
Eq enum =>
NonEmpty (enum, Codec context enum enum) -> Codec context enum enum
enumCodec
    (NonEmpty (constant, JSONCodec constant) -> JSONCodec constant)
-> (NonEmpty (constant, Text)
    -> NonEmpty (constant, JSONCodec constant))
-> NonEmpty (constant, Text)
-> JSONCodec constant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((constant, Text) -> (constant, JSONCodec constant))
-> NonEmpty (constant, Text)
-> NonEmpty (constant, JSONCodec constant)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map
      ( \(constant
constant, Text
text) ->
          ( constant
constant,
            constant -> Text -> JSONCodec constant
forall value. value -> Text -> JSONCodec value
literalTextValueCodec constant
constant Text
text
          )
      )

-- | A codec for a 'Bounded' 'Enum' that uses its 'Show' instance to have the values correspond to literal 'Text' values.
--
--
-- === Example usage
--
-- >>> data Fruit = Apple | Orange deriving (Show, Eq, Enum, Bounded)
-- >>> let c = shownBoundedEnumCodec
-- >>> toJSONVia c Apple
-- String "Apple"
-- >>> JSON.parseMaybe (parseJSONVia c) (String "Orange") :: Maybe Fruit
-- Just Orange
shownBoundedEnumCodec ::
  forall enum.
  (Show enum, Eq enum, Enum enum, Bounded enum) =>
  JSONCodec enum
shownBoundedEnumCodec :: JSONCodec enum
shownBoundedEnumCodec =
  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, String -> Text
T.pack (enum -> String
forall a. Show a => a -> String
show enum
v))) NonEmpty enum
ne)

-- | Helper function for 'optionalFieldOrNullWith' and 'optionalFieldOrNull'.
--
-- You probably don't need this.
orNullHelper ::
  ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output)) ->
  ObjectCodec (Maybe input) (Maybe output)
orNullHelper :: ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
orNullHelper = (Maybe (Maybe output) -> Maybe output)
-> (Maybe input -> Maybe (Maybe input))
-> ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (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 :: 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 :: 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 :: 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 :: Text -> JSONCodec a
codecViaAeson Text
doc = (Value -> Either String a)
-> (a -> Value) -> JSONCodec Value -> JSONCodec 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 JSONCodec a -> Text -> JSONCodec a
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
doc