{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Antiope.Messages.Types
( WithEncoded(..)
, With(..)
, FromWith(..)
, fromWith2, fromWith3, fromWith4, fromWith5, fromWith6
) where
import Data.Aeson (FromJSON (..), ToJSON (..), eitherDecodeStrict, encode, withObject, (.:), (.=))
import Data.Coerce (coerce)
import Data.Proxy
import Data.Text (Text)
import GHC.TypeLits
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
class FromWith f where
fromWith :: f a -> a
instance FromWith (With x) where
fromWith = coerce
instance FromWith (WithEncoded x) where
fromWith = coerce
fromWith2 :: (FromWith f, FromWith g) => f (g a) -> a
fromWith2 = fromWith . fromWith
{-# INLINE fromWith2 #-}
fromWith3 :: (FromWith f, FromWith g, FromWith h) => f (g (h a)) -> a
fromWith3 = fromWith . fromWith . fromWith
{-# INLINE fromWith3 #-}
fromWith4 :: (FromWith f, FromWith g, FromWith h, FromWith k) => f (g (h (k a))) -> a
fromWith4 = fromWith . fromWith . fromWith . fromWith
{-# INLINE fromWith4 #-}
fromWith5 :: (FromWith f, FromWith g, FromWith h, FromWith k, FromWith p) => f (g (h (k (p a)))) -> a
fromWith5 = fromWith . fromWith . fromWith . fromWith . fromWith
{-# INLINE fromWith5 #-}
fromWith6 :: (FromWith f, FromWith g, FromWith h, FromWith k, FromWith p, FromWith q) => f (g (h (k (p (q a))))) -> a
fromWith6 = fromWith . fromWith . fromWith . fromWith . fromWith . fromWith
{-# INLINE fromWith6 #-}
newtype WithEncoded (fld :: Symbol) a = WithEncoded a deriving (Show, Eq, Ord)
newtype With (fld :: Symbol) a = With a deriving (Show, Eq, Ord)
instance (KnownSymbol fld, FromJSON a) => FromJSON (WithEncoded fld a) where
parseJSON =
let name = symbolVal @fld Proxy
in withObject name $ \obj ->
WithEncoded <$> decodeEscaped obj (Text.pack name)
instance (KnownSymbol fld, ToJSON a) => ToJSON (WithEncoded fld a) where
toJSON (WithEncoded a) =
let name = Text.pack (symbolVal @fld Proxy)
in Aeson.object [ name .= (Text.decodeUtf8 . LBS.toStrict . encode) a ]
instance (KnownSymbol fld, FromJSON a) => FromJSON (With fld a) where
parseJSON =
let name = symbolVal @fld Proxy
in withObject name $ \obj ->
With <$> obj .: Text.pack name
instance (KnownSymbol fld, ToJSON a) => ToJSON (With fld a) where
toJSON (With a) =
let name = Text.pack (symbolVal @fld Proxy)
in Aeson.object [ name .= a ]
decodeEscaped :: FromJSON b => Aeson.Object -> Text -> Aeson.Parser b
decodeEscaped o t =
(o .: t) >>= (either fail pure . eitherDecodeStrict . Text.encodeUtf8)