{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- Because Eq is a superclass of Hashable in newer versions.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Autodocodec.Class where

import Autodocodec.Codec
import Data.Aeson (FromJSONKey, ToJSONKey)
import qualified Data.Aeson as JSON
import Numeric.Natural
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (KeyMap)
#endif
import Data.Functor.Identity
import Data.HashMap.Strict (HashMap)
import Data.Hashable (Hashable)
import Data.Int
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map (Map)
import Data.Scientific
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text.Lazy as LT
import Data.Time
import Data.Vector (Vector)
import Data.Void
import Data.Word

-- | A class for values which have a canonical codec.
--
-- There are no formal laws for this class.
-- If you really want a law, it should be "Whomever uses the 'codec' from your instance should not be surprised."
class HasCodec value where
  -- | A codec for a single value
  --
  -- See the sections on helper functions for implementing this for plenty of examples.
  codec :: JSONCodec value

  -- | A codec for a list of values
  --
  -- This is really only useful for cases like 'Char' and 'String'.
  -- We didn't call it 'listCodec' so we could use that name for making a codec for a list of values from a single codec instead.
  listCodecForStringCompatibility :: JSONCodec [value]
  listCodecForStringCompatibility = forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec forall value. HasCodec value => JSONCodec value
codec

  {-# MINIMAL codec #-}

instance HasCodec Void where
  codec :: JSONCodec Void
codec = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec (\Value
_ -> forall a b. a -> Either a b
Left String
"Cannot decode a Void.") forall a. Void -> a
absurd JSONCodec Value
ValueCodec

instance HasCodec Bool where
  codec :: JSONCodec Bool
codec = JSONCodec Bool
boolCodec

instance HasCodec Ordering where
  codec :: JSONCodec Ordering
codec = forall enum.
(Show enum, Eq enum, Enum enum, Bounded enum) =>
JSONCodec enum
shownBoundedEnumCodec

instance HasCodec Char where
  codec :: JSONCodec Char
codec =
    let parseChar :: String -> Either String (Item String)
parseChar = \case
          [] -> forall a b. a -> Either a b
Left String
"Expected exactly 1 character, but got none."
          [Item String
c] -> forall a b. b -> Either a b
Right Item String
c
          String
s -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Expected exactly 1 character, but got more:" forall a. Semigroup a => a -> a -> a
<> String
s
     in forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec String -> Either String (Item String)
parseChar (forall a. a -> [a] -> [a]
: []) JSONCodec String
stringCodec
  listCodecForStringCompatibility :: JSONCodec String
listCodecForStringCompatibility = JSONCodec String
stringCodec

instance HasCodec Text where
  codec :: JSONCodec Text
codec = JSONCodec Text
textCodec

instance HasCodec LT.Text where
  codec :: JSONCodec Text
codec = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Text -> Text
LT.fromStrict Text -> Text
LT.toStrict JSONCodec Text
textCodec

instance HasCodec Scientific where
  codec :: JSONCodec Scientific
codec = JSONCodec Scientific
scientificCodec

instance HasCodec Int where
  codec :: JSONCodec Int
codec = forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec

instance HasCodec Int8 where
  codec :: JSONCodec Int8
codec = forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec

instance HasCodec Int16 where
  codec :: JSONCodec Int16
codec = forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec

instance HasCodec Int32 where
  codec :: JSONCodec Int32
codec = forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec

instance HasCodec Int64 where
  codec :: JSONCodec Int64
codec = forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec

-- | This instance uses the "safe" 'integerCodec'.
instance HasCodec Integer where
  codec :: JSONCodec Integer
codec = JSONCodec Integer
integerCodec

instance HasCodec Word where
  codec :: JSONCodec Word
codec = forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec

instance HasCodec Word8 where
  codec :: JSONCodec Word8
codec = forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec

instance HasCodec Word16 where
  codec :: JSONCodec Word16
codec = forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec

instance HasCodec Word32 where
  codec :: JSONCodec Word32
codec = forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec

instance HasCodec Word64 where
  codec :: JSONCodec Word64
codec = forall i. (Integral i, Bounded i) => JSONCodec i
boundedIntegralCodec

-- | This instance uses the "safe" 'naturalCodec'.
instance HasCodec Natural where
  codec :: JSONCodec Natural
codec = JSONCodec Natural
naturalCodec

instance HasCodec JSON.Value where
  codec :: JSONCodec Value
codec = JSONCodec Value
ValueCodec

instance HasCodec a => HasCodec (Identity a) where
  codec :: JSONCodec (Identity a)
codec = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall a. Identity a -> a
runIdentity forall a. a -> Identity a
Identity forall value. HasCodec value => JSONCodec value
codec

instance HasCodec a => HasCodec (Maybe a) where
  codec :: JSONCodec (Maybe a)
codec = forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec forall value. HasCodec value => JSONCodec value
codec

instance (HasCodec l, HasCodec r) => HasCodec (Either l r) where
  codec :: JSONCodec (Either l r)
codec =
    forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec
      (forall input output.
Maybe Text -> ObjectCodec input output -> ValueCodec input output
ObjectOfCodec forall a. Maybe a
Nothing (forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"Left"))
      (forall input output.
Maybe Text -> ObjectCodec input output -> ValueCodec input output
ObjectOfCodec forall a. Maybe a
Nothing (forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"Right"))

instance HasCodec a => HasCodec (Vector a) where
  codec :: JSONCodec (Vector a)
codec = forall input output.
ValueCodec input output
-> ValueCodec (Vector input) (Vector output)
vectorCodec forall value. HasCodec value => JSONCodec value
codec

instance HasCodec a => HasCodec [a] where
  codec :: JSONCodec [a]
codec = forall a. HasCodec a => JSONCodec [a]
listCodecForStringCompatibility

instance HasCodec a => HasCodec (NonEmpty a) where
  codec :: JSONCodec (NonEmpty a)
codec = forall input output.
ValueCodec input output
-> ValueCodec (NonEmpty input) (NonEmpty output)
nonEmptyCodec forall value. HasCodec value => JSONCodec value
codec

instance (Ord a, HasCodec a) => HasCodec (Set a) where
  codec :: JSONCodec (Set a)
codec = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall a. Ord a => [a] -> Set a
S.fromList forall a. Set a -> [a]
S.toList forall value. HasCodec value => JSONCodec value
codec

instance (Ord k, FromJSONKey k, ToJSONKey k, HasCodec v) => HasCodec (Map k v) where
  codec :: JSONCodec (Map k v)
codec = forall input output.
(Ord input, FromJSONKey input, ToJSONKey input) =>
JSONCodec output -> JSONCodec (Map input output)
MapCodec forall value. HasCodec value => JSONCodec value
codec

instance (Eq k, Hashable k, FromJSONKey k, ToJSONKey k, HasCodec v) => HasCodec (HashMap k v) where
  codec :: JSONCodec (HashMap k v)
codec = forall input output.
(Eq input, Hashable input, FromJSONKey input, ToJSONKey input) =>
JSONCodec output -> JSONCodec (HashMap input output)
HashMapCodec forall value. HasCodec value => JSONCodec value
codec

#if MIN_VERSION_aeson(2,0,0)
instance HasCodec v => HasCodec (KeyMap v) where
  codec :: JSONCodec (KeyMap v)
codec = forall v. JSONCodec v -> JSONCodec (KeyMap v)
keyMapCodec forall value. HasCodec value => JSONCodec value
codec
#endif

-- TODO make these instances better once aeson exposes its @Data.Aeson.Parser.Time@ or @Data.Attoparsec.Time@ modules.
instance HasCodec Day where
  codec :: JSONCodec Day
codec = forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
codecViaAeson Text
"Day"

instance HasCodec LocalTime where
  codec :: JSONCodec LocalTime
codec = forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
codecViaAeson Text
"LocalTime"

instance HasCodec UTCTime where
  codec :: JSONCodec UTCTime
codec = forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
codecViaAeson Text
"LocalTime"

instance HasCodec TimeOfDay where
  codec :: JSONCodec TimeOfDay
codec = forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
codecViaAeson Text
"TimeOfDay"

instance HasCodec ZonedTime where
  codec :: JSONCodec ZonedTime
codec = forall a. (FromJSON a, ToJSON a) => Text -> JSONCodec a
codecViaAeson Text
"ZonedTime"

instance HasCodec NominalDiffTime where
  codec :: JSONCodec NominalDiffTime
codec = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (Real a, Fractional b) => a -> b
realToFrac (forall value. HasCodec value => JSONCodec value
codec :: JSONCodec Scientific)

instance HasCodec DiffTime where
  codec :: JSONCodec DiffTime
codec = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (Real a, Fractional b) => a -> b
realToFrac (forall value. HasCodec value => JSONCodec value
codec :: JSONCodec Scientific)

-- | A class for values which have a canonical object codec.
--
-- There are no formal laws for this class.
-- If you really want a law, it should be "Whomever uses the 'codec' from your instance should not be surprised."
class HasObjectCodec object where
  -- | A object codec for the value
  --
  -- See the sections on helper functions for implementing this for plenty of examples.
  objectCodec :: JSONObjectCodec object

-- | A required field
--
-- During decoding, the field must be in the object.
--
-- During encoding, the field will always be in the object.
--
-- See 'requiredFieldWith'
requiredField ::
  HasCodec output =>
  -- | Key
  Text ->
  -- | Documentation
  Text ->
  ObjectCodec output output
requiredField :: forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
key = forall input output.
Text -> ValueCodec input output -> Text -> ObjectCodec input output
requiredFieldWith Text
key forall value. HasCodec value => JSONCodec value
codec

-- | Like 'requiredField', but without documentation
requiredField' ::
  HasCodec output =>
  -- | Key
  Text ->
  ObjectCodec output output
requiredField' :: forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
key = forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
key forall value. HasCodec value => JSONCodec value
codec

-- | An optional field
--
-- During decoding, the field may be in the object. 'Nothing' will be parsed otherwise.
--
-- During encoding, the field will be in the object if it is not 'Nothing', and omitted otherwise.
--
-- See 'optionalFieldWith'
optionalField ::
  HasCodec output =>
  -- | Key
  Text ->
  -- | Documentation
  Text ->
  ObjectCodec (Maybe output) (Maybe output)
optionalField :: forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
key = forall input output.
Text
-> ValueCodec input output
-> Text
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith Text
key forall value. HasCodec value => JSONCodec value
codec

-- | Like 'optionalField', but without documentation
optionalField' ::
  HasCodec output =>
  -- | Key
  Text ->
  ObjectCodec (Maybe output) (Maybe output)
optionalField' :: forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
key = forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
key forall value. HasCodec value => JSONCodec value
codec

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

-- | Like 'optionalFieldWithDefault', but without documentation
optionalFieldWithDefault' ::
  (HasCodec output) =>
  -- | Key
  Text ->
  -- | Default value
  output ->
  ObjectCodec output output
optionalFieldWithDefault' :: forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
key output
defaultValue = forall output.
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithDefaultWith' Text
key forall value. HasCodec value => JSONCodec value
codec output
defaultValue

-- | 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 in the object if it is not 'Nothing', and omitted otherwise.
optionalFieldOrNull ::
  forall output.
  HasCodec output =>
  -- | Key
  Text ->
  -- | Documentation
  Text ->
  ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull :: forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull Text
key Text
doc = forall input output.
ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
orNullHelper forall a b. (a -> b) -> a -> b
$ forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
OptionalKeyCodec Text
key (forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec forall value. HasCodec value => JSONCodec value
codec) (forall a. a -> Maybe a
Just Text
doc)

-- | Like 'optionalFieldOrNull', but without documentation
optionalFieldOrNull' ::
  forall output.
  HasCodec output =>
  -- | Key
  Text ->
  ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull' :: forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull' Text
key = forall input output.
ObjectCodec (Maybe (Maybe input)) (Maybe (Maybe output))
-> ObjectCodec (Maybe input) (Maybe output)
orNullHelper forall a b. (a -> b) -> a -> b
$ forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
OptionalKeyCodec Text
key (forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec forall value. HasCodec value => JSONCodec value
codec) forall a. Maybe a
Nothing

optionalFieldWithOmittedDefault ::
  (Eq output, HasCodec output) =>
  -- | Key
  Text ->
  -- | Default value
  output ->
  -- | Documentation
  Text ->
  ObjectCodec output output
optionalFieldWithOmittedDefault :: forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
key output
defaultValue Text
doc = forall output.
Eq output =>
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith Text
key forall value. HasCodec value => JSONCodec value
codec output
defaultValue Text
doc

optionalFieldWithOmittedDefault' ::
  (Eq output, HasCodec output) =>
  -- | Key
  Text ->
  -- | Default value
  output ->
  ObjectCodec output output
optionalFieldWithOmittedDefault' :: forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
key output
defaultValue = forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithOmittedDefaultWith' Text
key forall value. HasCodec value => JSONCodec value
codec output
defaultValue

optionalFieldOrNullWithOmittedDefault ::
  (Eq output, HasCodec output) =>
  -- | Key
  Text ->
  -- | Default value
  output ->
  -- | Documentation
  Text ->
  ObjectCodec output output
optionalFieldOrNullWithOmittedDefault :: forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefault Text
key output
defaultValue Text
doc = forall output.
Eq output =>
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith Text
key forall value. HasCodec value => JSONCodec value
codec output
defaultValue Text
doc

optionalFieldOrNullWithOmittedDefault' ::
  (Eq output, HasCodec output) =>
  -- | Key
  Text ->
  -- | Default value
  output ->
  ObjectCodec output output
optionalFieldOrNullWithOmittedDefault' :: forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefault' Text
key output
defaultValue = forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefaultWith' Text
key forall value. HasCodec value => JSONCodec value
codec output
defaultValue