{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TemplateHaskell            #-}

{-|
Module: Data.Aeson.Embedded
Description: Type for a JSON value embedded within a JSON string value
-}
module Data.Aeson.Embedded where

import           Control.Lens.TH
import           Data.Aeson
import qualified Data.ByteString.Lazy as LBS
import           Data.Text.Encoding    (decodeUtf8, encodeUtf8)
import           Network.AWS.Data.Text (FromText (..), ToText (..), fromText,
                                        takeText)

-- | Type for a JSON value embedded within a JSON string value
newtype Embedded a = Embedded { Embedded a -> a
_unEmbed :: a } deriving (Embedded a -> Embedded a -> Bool
(Embedded a -> Embedded a -> Bool)
-> (Embedded a -> Embedded a -> Bool) -> Eq (Embedded a)
forall a. Eq a => Embedded a -> Embedded a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Embedded a -> Embedded a -> Bool
$c/= :: forall a. Eq a => Embedded a -> Embedded a -> Bool
== :: Embedded a -> Embedded a -> Bool
$c== :: forall a. Eq a => Embedded a -> Embedded a -> Bool
Eq, Int -> Embedded a -> ShowS
[Embedded a] -> ShowS
Embedded a -> String
(Int -> Embedded a -> ShowS)
-> (Embedded a -> String)
-> ([Embedded a] -> ShowS)
-> Show (Embedded a)
forall a. Show a => Int -> Embedded a -> ShowS
forall a. Show a => [Embedded a] -> ShowS
forall a. Show a => Embedded a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Embedded a] -> ShowS
$cshowList :: forall a. Show a => [Embedded a] -> ShowS
show :: Embedded a -> String
$cshow :: forall a. Show a => Embedded a -> String
showsPrec :: Int -> Embedded a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Embedded a -> ShowS
Show)

instance FromJSON a =>
         FromText (Embedded a) where
  parser :: Parser (Embedded a)
parser =
    (a -> Embedded a) -> Parser Text a -> Parser (Embedded a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Embedded a
forall a. a -> Embedded a
Embedded (Parser Text a -> Parser (Embedded a))
-> (Text -> Parser Text a) -> Text -> Parser (Embedded a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Parser Text a)
-> (a -> Parser Text a) -> Either String a -> Parser Text a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> Parser Text a)
-> (Text -> Either String a) -> Text -> Parser Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (ByteString -> Either String a)
-> (Text -> ByteString) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Parser (Embedded a))
-> Parser Text Text -> Parser (Embedded a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser Text Text
takeText

instance FromJSON a =>
         FromJSON (Embedded a) where
  parseJSON :: Value -> Parser (Embedded a)
parseJSON Value
v = (String -> Parser (Embedded a))
-> (Embedded a -> Parser (Embedded a))
-> Either String (Embedded a)
-> Parser (Embedded a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (Embedded a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Embedded a -> Parser (Embedded a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Embedded a) -> Parser (Embedded a))
-> (Text -> Either String (Embedded a))
-> Text
-> Parser (Embedded a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Embedded a)
forall a. FromText a => Text -> Either String a
fromText (Text -> Parser (Embedded a)) -> Parser Text -> Parser (Embedded a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON a => ToText (Embedded a) where
  toText :: Embedded a -> Text
toText = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (Embedded a -> ByteString) -> Embedded a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (Embedded a -> ByteString) -> Embedded a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode (a -> ByteString) -> (Embedded a -> a) -> Embedded a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Embedded a -> a
forall a. Embedded a -> a
_unEmbed

instance ToJSON a => ToJSON (Embedded a) where
  toJSON :: Embedded a -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Embedded a -> Text) -> Embedded a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Embedded a -> Text
forall a. ToText a => a -> Text
toText
  toEncoding :: Embedded a -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (Embedded a -> Text) -> Embedded a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Embedded a -> Text
forall a. ToText a => a -> Text
toText

$(makeLenses ''Embedded)