module Composite.Aeson.Formats.Provided where
import Composite.Aeson.Base (JsonFormat(JsonFormat), JsonProfunctor(JsonProfunctor), _JsonProfunctor, dimapJsonFormat, toJsonWithFormat)
import Composite.Aeson.Formats.Generic (SumStyle, abeJsonFormat, aesonJsonFormat, jsonArrayFormat, jsonObjectFormat, jsonSumFormat)
import Composite.Aeson.Formats.InternalTH (makeTupleFormats, makeNamedTupleFormats)
import Control.Arrow (first)
import Control.Monad.Except (throwError)
import Control.Lens (_2, _Wrapped, over, view)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.BetterErrors as ABE
import Data.Fixed (HasResolution, Fixed)
import Data.Foldable (toList)
import Data.Hashable (Hashable)
import qualified Data.HashMap.Lazy as LazyHashMap
import qualified Data.HashMap.Strict as StrictHashMap
import Data.IntSet (IntSet)
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map.Lazy as LazyMap
import qualified Data.Map.Strict as StrictMap
import Data.Scientific (Scientific)
import qualified Data.Scientific as Scientific
import Data.Sequence (Seq)
import qualified Data.Sequence as Sequence
import Data.Text (Text)
import qualified Data.Text.Lazy as LT
import qualified Data.Vector as V
import Data.Version (Version)
import Numeric.Natural (Natural)
aesonArrayJsonFormat :: JsonFormat e Aeson.Array
aesonArrayJsonFormat :: forall e. JsonFormat e Array
aesonArrayJsonFormat = forall a e. ToJSON a => Parse e a -> JsonFormat e a
abeJsonFormat forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Array
ABE.asArray
aesonObjectJsonFormat :: JsonFormat e Aeson.Object
aesonObjectJsonFormat :: forall e. JsonFormat e Object
aesonObjectJsonFormat = forall a e. ToJSON a => Parse e a -> JsonFormat e a
abeJsonFormat forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Object
ABE.asObject
aesonValueJsonFormat :: JsonFormat e Aeson.Value
aesonValueJsonFormat :: forall e. JsonFormat e Value
aesonValueJsonFormat = forall a e. ToJSON a => Parse e a -> JsonFormat e a
abeJsonFormat forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Value
ABE.asValue
boolJsonFormat :: JsonFormat e Bool
boolJsonFormat :: forall e. JsonFormat e Bool
boolJsonFormat = forall a e. ToJSON a => Parse e a -> JsonFormat e a
abeJsonFormat forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Bool
ABE.asBool
charJsonFormat :: JsonFormat e Char
charJsonFormat :: forall e. JsonFormat e Char
charJsonFormat = forall a e. (ToJSON a, FromJSON a) => JsonFormat e a
aesonJsonFormat
eitherJsonFormat :: SumStyle -> Text -> Text -> JsonFormat e a -> JsonFormat e b -> JsonFormat e (Either a b)
eitherJsonFormat :: forall e a b.
SumStyle
-> Text
-> Text
-> JsonFormat e a
-> JsonFormat e b
-> JsonFormat e (Either a b)
eitherJsonFormat SumStyle
style Text
leftName Text
rightName JsonFormat e a
leftFormat JsonFormat e b
rightFormat = forall a e.
SumStyle
-> (a -> (Text, Value))
-> NonEmpty (Text, FromJson e a)
-> JsonFormat e a
jsonSumFormat SumStyle
style Either a b -> (Text, Value)
o NonEmpty (Text, FromJson e (Either a b))
is
where
o :: Either a b -> (Text, Value)
o = \ case
Left a
a -> (Text
leftName, forall e a. JsonFormat e a -> a -> Value
toJsonWithFormat JsonFormat e a
leftFormat a
a)
Right b
b -> (Text
rightName, forall e a. JsonFormat e a -> a -> Value
toJsonWithFormat JsonFormat e b
rightFormat b
b)
is :: NonEmpty (Text, FromJson e (Either a b))
is =
(Text
leftName, forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a b e' a' b'.
Iso
(JsonProfunctor e a b)
(JsonProfunctor e' a' b')
(ToJson a, FromJson e b)
(ToJson a', FromJson e' b')
_JsonProfunctor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2) JsonFormat e a
leftFormat) forall a. a -> [a] -> NonEmpty a
:| [(Text
rightName, forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a b e' a' b'.
Iso
(JsonProfunctor e a b)
(JsonProfunctor e' a' b')
(ToJson a, FromJson e b)
(ToJson a', FromJson e' b')
_JsonProfunctor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2) JsonFormat e b
rightFormat)]
fixedJsonFormat :: HasResolution r => JsonFormat e (Fixed r)
fixedJsonFormat :: forall {k} (r :: k) e. HasResolution r => JsonFormat e (Fixed r)
fixedJsonFormat = forall a e. (ToJSON a, FromJSON a) => JsonFormat e a
aesonJsonFormat
strictHashMapJsonFormat :: (Eq k, Hashable k) => (k -> Text) -> (Text -> ABE.Parse e k) -> JsonFormat e a -> JsonFormat e (StrictHashMap.HashMap k a)
strictHashMapJsonFormat :: forall k e a.
(Eq k, Hashable k) =>
(k -> Text)
-> (Text -> Parse e k)
-> JsonFormat e a
-> JsonFormat e (HashMap k a)
strictHashMapJsonFormat k -> Text
kToText Text -> Parse e k
kFromText =
forall t a e.
(t -> [(Text, a)])
-> ([(Text, a)] -> Parse e t) -> JsonFormat e a -> JsonFormat e t
jsonObjectFormat (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first k -> Text
kToText) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
StrictHashMap.toList)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
StrictHashMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\ (Text
k, a
a) -> (, a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parse e k
kFromText Text
k))
lazyHashMapJsonFormat :: (Eq k, Hashable k) => (k -> Text) -> (Text -> ABE.Parse e k) -> JsonFormat e a -> JsonFormat e (LazyHashMap.HashMap k a)
lazyHashMapJsonFormat :: forall k e a.
(Eq k, Hashable k) =>
(k -> Text)
-> (Text -> Parse e k)
-> JsonFormat e a
-> JsonFormat e (HashMap k a)
lazyHashMapJsonFormat k -> Text
kToText Text -> Parse e k
kFromText =
forall t a e.
(t -> [(Text, a)])
-> ([(Text, a)] -> Parse e t) -> JsonFormat e a -> JsonFormat e t
jsonObjectFormat (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first k -> Text
kToText) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
LazyHashMap.toList)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
LazyHashMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\ (Text
k, a
a) -> (, a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parse e k
kFromText Text
k))
intSetJsonFormat :: JsonFormat e IntSet
intSetJsonFormat :: forall e. JsonFormat e IntSet
intSetJsonFormat = forall a e. (ToJSON a, FromJSON a) => JsonFormat e a
aesonJsonFormat
integralJsonFormat :: Integral a => JsonFormat e a
integralJsonFormat :: forall a e. Integral a => JsonFormat e a
integralJsonFormat = forall e a. JsonProfunctor e a a -> JsonFormat e a
JsonFormat forall a b. (a -> b) -> a -> b
$ forall e a b. (a -> Value) -> Parse e b -> JsonProfunctor e a b
JsonProfunctor (Scientific -> Value
Aeson.Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall (m :: * -> *) a err.
(Functor m, Monad m, Integral a) =>
ParseT err m a
ABE.asIntegral
lazyTextJsonFormat :: JsonFormat e LT.Text
lazyTextJsonFormat :: forall e. JsonFormat e Text
lazyTextJsonFormat = forall b a e.
(b -> a) -> (a -> b) -> JsonFormat e a -> JsonFormat e b
dimapJsonFormat Text -> Text
LT.toStrict Text -> Text
LT.fromStrict forall e. JsonFormat e Text
textJsonFormat
listJsonFormat :: JsonFormat e a -> JsonFormat e [a]
listJsonFormat :: forall e a. JsonFormat e a -> JsonFormat e [a]
listJsonFormat = forall t a e.
(t -> [a])
-> ([a] -> Parse e t) -> JsonFormat e a -> JsonFormat e t
jsonArrayFormat forall a. a -> a
id forall (f :: * -> *) a. Applicative f => a -> f a
pure
strictMapJsonFormat :: Ord k => (k -> Text) -> (Text -> ABE.Parse e k) -> JsonFormat e a -> JsonFormat e (StrictMap.Map k a)
strictMapJsonFormat :: forall k e a.
Ord k =>
(k -> Text)
-> (Text -> Parse e k) -> JsonFormat e a -> JsonFormat e (Map k a)
strictMapJsonFormat k -> Text
kToText Text -> Parse e k
kFromText =
forall t a e.
(t -> [(Text, a)])
-> ([(Text, a)] -> Parse e t) -> JsonFormat e a -> JsonFormat e t
jsonObjectFormat (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first k -> Text
kToText) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
StrictMap.toAscList)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
StrictMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\ (Text
k, a
a) -> (, a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parse e k
kFromText Text
k))
lazyMapJsonFormat :: Ord k => (k -> Text) -> (Text -> ABE.Parse e k) -> JsonFormat e a -> JsonFormat e (LazyMap.Map k a)
lazyMapJsonFormat :: forall k e a.
Ord k =>
(k -> Text)
-> (Text -> Parse e k) -> JsonFormat e a -> JsonFormat e (Map k a)
lazyMapJsonFormat k -> Text
kToText Text -> Parse e k
kFromText =
forall t a e.
(t -> [(Text, a)])
-> ([(Text, a)] -> Parse e t) -> JsonFormat e a -> JsonFormat e t
jsonObjectFormat (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first k -> Text
kToText) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
LazyMap.toAscList)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
LazyMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\ (Text
k, a
a) -> (, a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parse e k
kFromText Text
k))
maybeJsonFormat :: JsonFormat e a -> JsonFormat e (Maybe a)
maybeJsonFormat :: forall e a. JsonFormat e a -> JsonFormat e (Maybe a)
maybeJsonFormat =
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped forall a b. (a -> b) -> a -> b
$ \ (JsonProfunctor a -> Value
o Parse e a
i) ->
forall e a b. (a -> Value) -> Parse e b -> JsonProfunctor e a b
JsonProfunctor (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Aeson.Null a -> Value
o) (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
ABE.perhaps Parse e a
i)
naturalJsonFormat :: JsonFormat e Natural
naturalJsonFormat :: forall e. JsonFormat e Natural
naturalJsonFormat = forall a e. (ToJSON a, FromJSON a) => JsonFormat e a
aesonJsonFormat
nonEmptyListJsonFormat :: JsonFormat e a -> JsonFormat e (NonEmpty a)
nonEmptyListJsonFormat :: forall e a. JsonFormat e a -> JsonFormat e (NonEmpty a)
nonEmptyListJsonFormat =
forall t a e.
(t -> [a])
-> ([a] -> Parse e t) -> JsonFormat e a -> JsonFormat e t
jsonArrayFormat forall a. NonEmpty a -> [a]
NEL.toList (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall err. String -> ParseError err
ABE.InvalidJSON forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected nonempty array") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty)
nullJsonFormat :: JsonFormat e ()
nullJsonFormat :: forall e. JsonFormat e ()
nullJsonFormat = forall a e. ToJSON a => Parse e a -> JsonFormat e a
abeJsonFormat forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m ()
ABE.asNull
orderingJsonFormat :: JsonFormat e Ordering
orderingJsonFormat :: forall e. JsonFormat e Ordering
orderingJsonFormat = forall a e. (ToJSON a, FromJSON a) => JsonFormat e a
aesonJsonFormat
realFloatJsonFormat :: RealFloat a => JsonFormat e a
realFloatJsonFormat :: forall a e. RealFloat a => JsonFormat e a
realFloatJsonFormat = forall e a. JsonProfunctor e a a -> JsonFormat e a
JsonFormat forall a b. (a -> b) -> a -> b
$ forall e a b. (a -> Value) -> Parse e b -> JsonProfunctor e a b
JsonProfunctor forall a. RealFloat a => a -> Value
realFloatToJson forall (m :: * -> *) a err.
(Functor m, Monad m, RealFloat a) =>
ParseT err m a
ABE.asRealFloat
realFloatToJson :: RealFloat a => a -> Aeson.Value
realFloatToJson :: forall a. RealFloat a => a -> Value
realFloatToJson a
d
| forall a. RealFloat a => a -> Bool
isNaN a
d Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isInfinite a
d = Value
Aeson.Null
| Bool
otherwise = Scientific -> Value
Aeson.Number forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> Scientific
Scientific.fromFloatDigits a
d
{-# INLINE realFloatToJson #-}
scientificJsonFormat :: JsonFormat e Scientific
scientificJsonFormat :: forall e. JsonFormat e Scientific
scientificJsonFormat = forall a e. ToJSON a => Parse e a -> JsonFormat e a
abeJsonFormat forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Scientific
ABE.asScientific
seqJsonFormat :: JsonFormat e a -> JsonFormat e (Seq a)
seqJsonFormat :: forall e a. JsonFormat e a -> JsonFormat e (Seq a)
seqJsonFormat = forall t a e.
(t -> [a])
-> ([a] -> Parse e t) -> JsonFormat e a -> JsonFormat e t
jsonArrayFormat forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Seq a
Sequence.fromList)
stringJsonFormat :: JsonFormat e String
stringJsonFormat :: forall e. JsonFormat e String
stringJsonFormat = forall a e. ToJSON a => Parse e a -> JsonFormat e a
abeJsonFormat forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m String
ABE.asString
textJsonFormat :: JsonFormat e Text
textJsonFormat :: forall e. JsonFormat e Text
textJsonFormat = forall a e. ToJSON a => Parse e a -> JsonFormat e a
abeJsonFormat forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
ABE.asText
$