{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Sum.Pure.Aeson
(
FromJSON (..),
FromJSONKey (..),
ToJSON (..),
ToJSONKey (..),
module X,
)
where
import Data.Aeson.Types
import Data.Proxy
import Data.Sum.Pure as X
import qualified Data.Text as T
import GHC.Generics
import GHC.TypeLits
instance (FromSumText a, Generic a, GConstructorName (Rep a)) => FromJSON (PureSumWith transformation a) where
parseJSON :: Value -> Parser (PureSumWith transformation a)
parseJSON = String
-> (Text -> Parser (PureSumWith transformation a))
-> Value
-> Parser (PureSumWith transformation a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText (ConstructorName a -> String
forall x. ConstructorName x -> String
unConstructionName (ConstructorName a -> String) -> ConstructorName a -> String
forall a b. (a -> b) -> a -> b
$ (forall a x. Generic a => Rep a x -> a
to @a) (Rep a Any -> a)
-> ConstructorName (Rep a Any) -> ConstructorName a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConstructorName (Rep a Any)
forall a. ConstructorName (Rep a a)
forall (f :: * -> *) a. GConstructorName f => ConstructorName (f a)
gConstructorName) Text -> Parser (PureSumWith transformation a)
forall a transformation.
FromSumText a =>
Text -> Parser (PureSumWith transformation a)
pureSumWithParser
instance (FromSumText a, Generic a, GConstructorName (Rep a)) => FromJSONKey (PureSumWith transformation a) where
fromJSONKey :: FromJSONKeyFunction (PureSumWith transformation a)
fromJSONKey = (Text -> Parser (PureSumWith transformation a))
-> FromJSONKeyFunction (PureSumWith transformation a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser (PureSumWith transformation a)
forall a transformation.
FromSumText a =>
Text -> Parser (PureSumWith transformation a)
pureSumWithParser
pureSumWithParser :: (FromSumText a) => T.Text -> Parser (PureSumWith transformation a)
pureSumWithParser :: forall a transformation.
FromSumText a =>
Text -> Parser (PureSumWith transformation a)
pureSumWithParser Text
x =
Parser (PureSumWith transformation a)
-> (a -> Parser (PureSumWith transformation a))
-> Maybe a
-> Parser (PureSumWith transformation a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (PureSumWith transformation a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (PureSumWith transformation a))
-> String -> Parser (PureSumWith transformation a)
forall a b. (a -> b) -> a -> b
$ String
"unknown value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
x) (PureSumWith transformation a
-> Parser (PureSumWith transformation a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PureSumWith transformation a
-> Parser (PureSumWith transformation a))
-> (a -> PureSumWith transformation a)
-> a
-> Parser (PureSumWith transformation a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PureSumWith transformation a
forall transformation a. a -> PureSumWith transformation a
PureSumWith) (Maybe a -> Parser (PureSumWith transformation a))
-> Maybe a -> Parser (PureSumWith transformation a)
forall a b. (a -> b) -> a -> b
$
Text -> Maybe a
forall a. FromSumText a => Text -> Maybe a
fromSumText Text
x
newtype ConstructorName x = ConstructorName {forall x. ConstructorName x -> String
unConstructionName :: String}
instance Functor ConstructorName where
fmap :: forall a b. (a -> b) -> ConstructorName a -> ConstructorName b
fmap a -> b
_ (ConstructorName String
x) = String -> ConstructorName b
forall x. String -> ConstructorName x
ConstructorName String
x
class GConstructorName f where
gConstructorName :: ConstructorName (f a)
instance (KnownSymbol typeName) => GConstructorName (M1 D ('MetaData typeName c i b) a) where
gConstructorName :: forall a. ConstructorName (M1 D ('MetaData typeName c i b) a a)
gConstructorName = String -> ConstructorName (M1 D ('MetaData typeName c i b) a a)
forall x. String -> ConstructorName x
ConstructorName (String -> ConstructorName (M1 D ('MetaData typeName c i b) a a))
-> String -> ConstructorName (M1 D ('MetaData typeName c i b) a a)
forall a b. (a -> b) -> a -> b
$ Proxy typeName -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @typeName)
instance (ToSumText a) => ToJSON (PureSumWith transformation a) where
toJSON :: PureSumWith transformation a -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (PureSumWith transformation a -> Text)
-> PureSumWith transformation a
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToSumText a => a -> Text
toSumText (a -> Text)
-> (PureSumWith transformation a -> a)
-> PureSumWith transformation a
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureSumWith transformation a -> a
forall transformation a. PureSumWith transformation a -> a
unPureSumWith
toEncoding :: PureSumWith transformation a -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (PureSumWith transformation a -> Text)
-> PureSumWith transformation a
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToSumText a => a -> Text
toSumText (a -> Text)
-> (PureSumWith transformation a -> a)
-> PureSumWith transformation a
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureSumWith transformation a -> a
forall transformation a. PureSumWith transformation a -> a
unPureSumWith
instance (ToSumText a) => ToJSONKey (PureSumWith transformation a) where
toJSONKey :: ToJSONKeyFunction (PureSumWith transformation a)
toJSONKey = (PureSumWith transformation a -> Text)
-> ToJSONKeyFunction (PureSumWith transformation a)
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (a -> Text
forall a. ToSumText a => a -> Text
toSumText (a -> Text)
-> (PureSumWith transformation a -> a)
-> PureSumWith transformation a
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureSumWith transformation a -> a
forall transformation a. PureSumWith transformation a -> a
unPureSumWith)