module Composite.Aeson.Base
( ToJson(..), FromJson(..), JsonProfunctor(..), _JsonProfunctor, JsonFormat(..)
, toJsonWithFormat, fromJsonWithFormat, parseJsonWithFormat, parseJsonWithFormat'
, dimapJsonFormat, jsonFormatWithIso, wrapJsonFormat, jsonFormatWithoutCustomError, wrappedJsonFormat
) where
import Control.Lens (AnIso', Iso, _2, Wrapped(type Unwrapped), _Wrapped', _Wrapped, iso, over, withIso)
import Control.Lens.TH (makeWrapped)
import Control.Monad.Except (withExceptT)
import Control.Monad.Morph (hoist)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Aeson.BetterErrors as ABE
import qualified Data.Aeson.BetterErrors.Internal as ABEI
import Data.Functor.Contravariant (Contravariant, contramap)
import Data.Profunctor (Profunctor(dimap))
import Data.Text (Text)
import Data.Void (Void)
newtype ToJson a = ToJson { forall a. ToJson a -> a -> Value
unToJson :: a -> Aeson.Value }
instance Contravariant ToJson where
contramap :: forall a' a. (a' -> a) -> ToJson a -> ToJson a'
contramap a' -> a
f (ToJson a -> Value
g) = forall a. (a -> Value) -> ToJson a
ToJson (a -> Value
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f)
newtype FromJson e a = FromJson { forall e a. FromJson e a -> Parse e a
unFromJson :: ABE.Parse e a }
deriving instance Functor (FromJson e)
data JsonProfunctor e a b = JsonProfunctor (a -> Aeson.Value) (ABE.Parse e b)
instance Profunctor (JsonProfunctor e) where
dimap :: forall a b c d.
(a -> b)
-> (c -> d) -> JsonProfunctor e b c -> JsonProfunctor e a d
dimap a -> b
f c -> d
g (JsonProfunctor b -> Value
o Parse e c
i) = forall e a b. (a -> Value) -> Parse e b -> JsonProfunctor e a b
JsonProfunctor (b -> Value
o forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (c -> d
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse e c
i)
_JsonProfunctor :: Iso (JsonProfunctor e a b) (JsonProfunctor e' a' b') (ToJson a, FromJson e b) (ToJson a', FromJson e' b')
_JsonProfunctor :: 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 s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\ (JsonProfunctor a -> Value
o Parse e b
i) -> (forall a. (a -> Value) -> ToJson a
ToJson a -> Value
o, forall e a. Parse e a -> FromJson e a
FromJson Parse e b
i))
(\ (ToJson a' -> Value
o, FromJson Parse e' b'
i) -> forall e a b. (a -> Value) -> Parse e b -> JsonProfunctor e a b
JsonProfunctor a' -> Value
o Parse e' b'
i)
newtype JsonFormat e a = JsonFormat { forall e a. JsonFormat e a -> JsonProfunctor e a a
unJsonFormat :: JsonProfunctor e a a }
toJsonWithFormat :: JsonFormat e a -> a -> Aeson.Value
toJsonWithFormat :: forall e a. JsonFormat e a -> a -> Value
toJsonWithFormat (JsonFormat (JsonProfunctor a -> Value
o Parse e a
_)) = a -> Value
o
fromJsonWithFormat :: JsonFormat e a -> ABE.Parse e a
fromJsonWithFormat :: forall e a. JsonFormat e a -> Parse e a
fromJsonWithFormat (JsonFormat (JsonProfunctor a -> Value
_ Parse e a
i)) = Parse e a
i
parseJsonWithFormat :: (e -> Text) -> JsonFormat e a -> Aeson.Value -> Aeson.Parser a
parseJsonWithFormat :: forall e a. (e -> Text) -> JsonFormat e a -> Value -> Parser a
parseJsonWithFormat e -> Text
showError = forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
ABE.toAesonParser e -> Text
showError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. JsonFormat e a -> Parse e a
fromJsonWithFormat
parseJsonWithFormat' :: JsonFormat Void a -> Aeson.Value -> Aeson.Parser a
parseJsonWithFormat' :: forall a. JsonFormat Void a -> Value -> Parser a
parseJsonWithFormat' = forall a. Parse' a -> Value -> Parser a
ABE.toAesonParser' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. JsonFormat e a -> Parse e a
fromJsonWithFormat
makeWrapped ''ToJson
makeWrapped ''FromJson
makeWrapped ''JsonFormat
dimapJsonFormat :: (b -> a) -> (a -> b) -> JsonFormat e a -> JsonFormat e b
dimapJsonFormat :: forall b a e.
(b -> a) -> (a -> b) -> JsonFormat e a -> JsonFormat e b
dimapJsonFormat b -> a
f a -> b
g = 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 (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap b -> a
f a -> b
g)
wrapJsonFormat :: JsonFormat e a -> (a -> Either e b) -> (b -> a) -> JsonFormat e b
wrapJsonFormat :: forall e a b.
JsonFormat e a -> (a -> Either e b) -> (b -> a) -> JsonFormat e b
wrapJsonFormat (JsonFormat (JsonProfunctor a -> Value
oa Parse e a
ia)) a -> Either e b
ab b -> a
ba = forall e a. JsonProfunctor e a a -> JsonFormat e a
JsonFormat (forall e a b. (a -> Value) -> Parse e b -> JsonProfunctor e a b
JsonProfunctor b -> Value
ob ParseT e Identity b
ib)
where
ob :: b -> Value
ob = a -> Value
oa forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
ba
ib :: ParseT e Identity b
ib = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) err a.
(Functor m, Monad m) =>
err -> ParseT err m a
ABE.throwCustomError forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either e b
ab forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parse e a
ia
jsonFormatWithoutCustomError :: Show e => JsonFormat e a -> JsonFormat e' a
jsonFormatWithoutCustomError :: forall e a e'. Show e => JsonFormat e a -> JsonFormat e' a
jsonFormatWithoutCustomError =
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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped) forall a b. (a -> b) -> a -> b
$
forall err (m :: * -> *) a err' (m' :: * -> *) a'.
(ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ReaderT ParseReader (ExceptT (ParseError err') m') a')
-> ParseT err m a -> ParseT err' m' a'
ABEI.mapParseT forall a b. (a -> b) -> a -> b
$ forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
(b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT forall a b. (a -> b) -> a -> b
$ \ case
ABEI.BadSchema [PathPiece]
pos (ABEI.KeyMissing Text
k) -> forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (forall err. Text -> ErrorSpecifics err
ABEI.KeyMissing Text
k)
ABEI.BadSchema [PathPiece]
pos (ABEI.OutOfBounds Int
i) -> forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (forall err. Int -> ErrorSpecifics err
ABEI.OutOfBounds Int
i)
ABEI.BadSchema [PathPiece]
pos (ABEI.WrongType JSONType
t Value
v) -> forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (forall err. JSONType -> Value -> ErrorSpecifics err
ABEI.WrongType JSONType
t Value
v)
ABEI.BadSchema [PathPiece]
pos (ABEI.ExpectedIntegral Double
d) -> forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (forall err. Double -> ErrorSpecifics err
ABEI.ExpectedIntegral Double
d)
ABEI.BadSchema [PathPiece]
pos (ABEI.FromAeson String
e) -> forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (forall err. String -> ErrorSpecifics err
ABEI.FromAeson String
e)
ABEI.BadSchema [PathPiece]
pos (ABEI.CustomError e
e) -> forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (forall err. String -> ErrorSpecifics err
ABEI.FromAeson (forall a. Show a => a -> String
show e
e))
ABEI.InvalidJSON String
msg -> forall err. String -> ParseError err
ABEI.InvalidJSON String
msg
jsonFormatWithIso :: AnIso' b a -> JsonFormat e a -> JsonFormat e b
jsonFormatWithIso :: forall b a e. AnIso' b a -> JsonFormat e a -> JsonFormat e b
jsonFormatWithIso AnIso' b a
i = forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso' b a
i forall b a e.
(b -> a) -> (a -> b) -> JsonFormat e a -> JsonFormat e b
dimapJsonFormat
wrappedJsonFormat :: Wrapped a => JsonFormat e (Unwrapped a) -> JsonFormat e a
wrappedJsonFormat :: forall a e.
Wrapped a =>
JsonFormat e (Unwrapped a) -> JsonFormat e a
wrappedJsonFormat = forall b a e. AnIso' b a -> JsonFormat e a -> JsonFormat e b
jsonFormatWithIso forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'