{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Autodocodec.Class where

import Autodocodec.Codec
import Data.Aeson (FromJSONKey, ToJSONKey)
import qualified Data.Aeson as JSON
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (KeyMap)
#endif
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.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 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 :: [Char] -> Either [Char] (Item [Char])
parseChar = \case
          [] -> forall a b. a -> Either a b
Left [Char]
"Expected exactly 1 character, but got none."
          [Item [Char]
c] -> forall a b. b -> Either a b
Right Item [Char]
c
          [Char]
s -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Expected exactly 1 character, but got more:" forall a. Semigroup a => a -> a -> a
<> [Char]
s
     in forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either [Char] newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec [Char] -> Either [Char] (Item [Char])
parseChar (forall a. a -> [a] -> [a]
: []) JSONCodec [Char]
stringCodec
  listCodecForStringCompatibility :: JSONCodec [Char]
listCodecForStringCompatibility = JSONCodec [Char]
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

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

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

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 [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