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 { ToJson a -> a -> Value
unToJson :: a -> Aeson.Value }
instance Contravariant ToJson where
contramap :: (a -> b) -> ToJson b -> ToJson a
contramap a -> b
f (ToJson b -> Value
g) = (a -> Value) -> ToJson a
forall a. (a -> Value) -> ToJson a
ToJson (b -> Value
g (b -> Value) -> (a -> b) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
newtype FromJson e a = FromJson { 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 :: (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) = (a -> Value) -> Parse e d -> JsonProfunctor e a d
forall e a b. (a -> Value) -> Parse e b -> JsonProfunctor e a b
JsonProfunctor (b -> Value
o (b -> Value) -> (a -> b) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (c -> d
g (c -> d) -> Parse e c -> Parse e d
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 :: p (ToJson a, FromJson e b) (f (ToJson a', FromJson e' b'))
-> p (JsonProfunctor e a b) (f (JsonProfunctor e' a' b'))
_JsonProfunctor =
(JsonProfunctor e a b -> (ToJson a, FromJson e b))
-> ((ToJson a', FromJson e' b') -> JsonProfunctor e' a' b')
-> Iso
(JsonProfunctor e a b)
(JsonProfunctor e' a' b')
(ToJson a, FromJson e b)
(ToJson a', FromJson e' b')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\ (JsonProfunctor a -> Value
o Parse e b
i) -> ((a -> Value) -> ToJson a
forall a. (a -> Value) -> ToJson a
ToJson a -> Value
o, Parse e b -> FromJson e b
forall e a. Parse e a -> FromJson e a
FromJson Parse e b
i))
(\ (ToJson a' -> Value
o, FromJson Parse e' b'
i) -> (a' -> Value) -> Parse e' b' -> JsonProfunctor e' a' b'
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 { JsonFormat e a -> JsonProfunctor e a a
unJsonFormat :: JsonProfunctor e a a }
toJsonWithFormat :: JsonFormat e a -> a -> Aeson.Value
toJsonWithFormat :: 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 :: 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 :: (e -> Text) -> JsonFormat e a -> Value -> Parser a
parseJsonWithFormat e -> Text
showError = (e -> Text) -> Parse e a -> Value -> Parser a
forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
ABE.toAesonParser e -> Text
showError (Parse e a -> Value -> Parser a)
-> (JsonFormat e a -> Parse e a)
-> JsonFormat e a
-> Value
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonFormat e a -> Parse e a
forall e a. JsonFormat e a -> Parse e a
fromJsonWithFormat
parseJsonWithFormat' :: JsonFormat Void a -> Aeson.Value -> Aeson.Parser a
parseJsonWithFormat' :: JsonFormat Void a -> Value -> Parser a
parseJsonWithFormat' = Parse' a -> Value -> Parser a
forall a. Parse' a -> Value -> Parser a
ABE.toAesonParser' (Parse' a -> Value -> Parser a)
-> (JsonFormat Void a -> Parse' a)
-> JsonFormat Void a
-> Value
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonFormat Void a -> Parse' a
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 :: (b -> a) -> (a -> b) -> JsonFormat e a -> JsonFormat e b
dimapJsonFormat b -> a
f a -> b
g = ASetter
(JsonFormat e a)
(JsonFormat e b)
(JsonProfunctor e a a)
(JsonProfunctor e b b)
-> (JsonProfunctor e a a -> JsonProfunctor e b b)
-> JsonFormat e a
-> JsonFormat e b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
(JsonFormat e a)
(JsonFormat e b)
(JsonProfunctor e a a)
(JsonProfunctor e b b)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((b -> a)
-> (a -> b) -> JsonProfunctor e a a -> JsonProfunctor e b b
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 :: 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 = JsonProfunctor e b b -> JsonFormat e b
forall e a. JsonProfunctor e a a -> JsonFormat e a
JsonFormat ((b -> Value) -> Parse e b -> JsonProfunctor e b b
forall e a b. (a -> Value) -> Parse e b -> JsonProfunctor e a b
JsonProfunctor b -> Value
ob Parse e b
ib)
where
ob :: b -> Value
ob = a -> Value
oa (a -> Value) -> (b -> a) -> b -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
ba
ib :: Parse e b
ib = (e -> Parse e b) -> (b -> Parse e b) -> Either e b -> Parse e b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Parse e b
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
err -> ParseT err m a
ABE.throwCustomError b -> Parse e b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e b -> Parse e b) -> (a -> Either e b) -> a -> Parse e b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either e b
ab (a -> Parse e b) -> Parse e a -> Parse e b
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 :: JsonFormat e a -> JsonFormat e' a
jsonFormatWithoutCustomError =
ASetter
(JsonFormat e a)
(JsonFormat e' a)
(ParseT e Identity a)
(ParseT e' Identity a)
-> (ParseT e Identity a -> ParseT e' Identity a)
-> JsonFormat e a
-> JsonFormat e' a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((JsonProfunctor e a a -> Identity (JsonProfunctor e' a a))
-> JsonFormat e a -> Identity (JsonFormat e' a)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((JsonProfunctor e a a -> Identity (JsonProfunctor e' a a))
-> JsonFormat e a -> Identity (JsonFormat e' a))
-> ((ParseT e Identity a -> Identity (ParseT e' Identity a))
-> JsonProfunctor e a a -> Identity (JsonProfunctor e' a a))
-> ASetter
(JsonFormat e a)
(JsonFormat e' a)
(ParseT e Identity a)
(ParseT e' Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ToJson a, FromJson e a) -> Identity (ToJson a, FromJson e' a))
-> JsonProfunctor e a a -> Identity (JsonProfunctor e' a a)
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 (((ToJson a, FromJson e a) -> Identity (ToJson a, FromJson e' a))
-> JsonProfunctor e a a -> Identity (JsonProfunctor e' a a))
-> ((ParseT e Identity a -> Identity (ParseT e' Identity a))
-> (ToJson a, FromJson e a) -> Identity (ToJson a, FromJson e' a))
-> (ParseT e Identity a -> Identity (ParseT e' Identity a))
-> JsonProfunctor e a a
-> Identity (JsonProfunctor e' a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FromJson e a -> Identity (FromJson e' a))
-> (ToJson a, FromJson e a) -> Identity (ToJson a, FromJson e' a)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((FromJson e a -> Identity (FromJson e' a))
-> (ToJson a, FromJson e a) -> Identity (ToJson a, FromJson e' a))
-> ((ParseT e Identity a -> Identity (ParseT e' Identity a))
-> FromJson e a -> Identity (FromJson e' a))
-> (ParseT e Identity a -> Identity (ParseT e' Identity a))
-> (ToJson a, FromJson e a)
-> Identity (ToJson a, FromJson e' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseT e Identity a -> Identity (ParseT e' Identity a))
-> FromJson e a -> Identity (FromJson e' a)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped) ((ParseT e Identity a -> ParseT e' Identity a)
-> JsonFormat e a -> JsonFormat e' a)
-> (ParseT e Identity a -> ParseT e' Identity a)
-> JsonFormat e a
-> JsonFormat e' a
forall a b. (a -> b) -> a -> b
$
(ReaderT ParseReader (ExceptT (ParseError e) Identity) a
-> ReaderT ParseReader (ExceptT (ParseError e') Identity) a)
-> ParseT e Identity a -> ParseT e' Identity a
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 ((ReaderT ParseReader (ExceptT (ParseError e) Identity) a
-> ReaderT ParseReader (ExceptT (ParseError e') Identity) a)
-> ParseT e Identity a -> ParseT e' Identity a)
-> (ReaderT ParseReader (ExceptT (ParseError e) Identity) a
-> ReaderT ParseReader (ExceptT (ParseError e') Identity) a)
-> ParseT e Identity a
-> ParseT e' Identity a
forall a b. (a -> b) -> a -> b
$ (forall a.
ExceptT (ParseError e) Identity a
-> ExceptT (ParseError e') Identity a)
-> ReaderT ParseReader (ExceptT (ParseError e) Identity) a
-> ReaderT ParseReader (ExceptT (ParseError e') Identity) a
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.
ExceptT (ParseError e) Identity a
-> ExceptT (ParseError e') Identity a)
-> ReaderT ParseReader (ExceptT (ParseError e) Identity) a
-> ReaderT ParseReader (ExceptT (ParseError e') Identity) a)
-> (forall a.
ExceptT (ParseError e) Identity a
-> ExceptT (ParseError e') Identity a)
-> ReaderT ParseReader (ExceptT (ParseError e) Identity) a
-> ReaderT ParseReader (ExceptT (ParseError e') Identity) a
forall a b. (a -> b) -> a -> b
$ (ParseError e -> ParseError e')
-> ExceptT (ParseError e) Identity a
-> ExceptT (ParseError e') Identity a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ((ParseError e -> ParseError e')
-> ExceptT (ParseError e) Identity a
-> ExceptT (ParseError e') Identity a)
-> (ParseError e -> ParseError e')
-> ExceptT (ParseError e) Identity a
-> ExceptT (ParseError e') Identity a
forall a b. (a -> b) -> a -> b
$ \ case
ABEI.BadSchema [PathPiece]
pos (ABEI.KeyMissing Text
k) -> [PathPiece] -> ErrorSpecifics e' -> ParseError e'
forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (Text -> ErrorSpecifics e'
forall err. Text -> ErrorSpecifics err
ABEI.KeyMissing Text
k)
ABEI.BadSchema [PathPiece]
pos (ABEI.OutOfBounds Int
i) -> [PathPiece] -> ErrorSpecifics e' -> ParseError e'
forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (Int -> ErrorSpecifics e'
forall err. Int -> ErrorSpecifics err
ABEI.OutOfBounds Int
i)
ABEI.BadSchema [PathPiece]
pos (ABEI.WrongType JSONType
t Value
v) -> [PathPiece] -> ErrorSpecifics e' -> ParseError e'
forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (JSONType -> Value -> ErrorSpecifics e'
forall err. JSONType -> Value -> ErrorSpecifics err
ABEI.WrongType JSONType
t Value
v)
ABEI.BadSchema [PathPiece]
pos (ABEI.ExpectedIntegral Double
d) -> [PathPiece] -> ErrorSpecifics e' -> ParseError e'
forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (Double -> ErrorSpecifics e'
forall err. Double -> ErrorSpecifics err
ABEI.ExpectedIntegral Double
d)
ABEI.BadSchema [PathPiece]
pos (ABEI.FromAeson String
e) -> [PathPiece] -> ErrorSpecifics e' -> ParseError e'
forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (String -> ErrorSpecifics e'
forall err. String -> ErrorSpecifics err
ABEI.FromAeson String
e)
ABEI.BadSchema [PathPiece]
pos (ABEI.CustomError e
e) -> [PathPiece] -> ErrorSpecifics e' -> ParseError e'
forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
ABEI.BadSchema [PathPiece]
pos (String -> ErrorSpecifics e'
forall err. String -> ErrorSpecifics err
ABEI.FromAeson (e -> String
forall a. Show a => a -> String
show e
e))
ABEI.InvalidJSON String
msg -> String -> ParseError e'
forall err. String -> ParseError err
ABEI.InvalidJSON String
msg
jsonFormatWithIso :: AnIso' b a -> JsonFormat e a -> JsonFormat e b
jsonFormatWithIso :: AnIso' b a -> JsonFormat e a -> JsonFormat e b
jsonFormatWithIso AnIso' b a
i = AnIso' b a
-> ((b -> a) -> (a -> b) -> JsonFormat e a -> JsonFormat e b)
-> JsonFormat e a
-> JsonFormat e b
forall s t a b r. AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso AnIso' b a
i (b -> a) -> (a -> b) -> JsonFormat e a -> JsonFormat e b
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 :: JsonFormat e (Unwrapped a) -> JsonFormat e a
wrappedJsonFormat = AnIso' a (Unwrapped a)
-> JsonFormat e (Unwrapped a) -> JsonFormat e a
forall b a e. AnIso' b a -> JsonFormat e a -> JsonFormat e b
jsonFormatWithIso AnIso' a (Unwrapped a)
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'