{-# LANGUAGE UnicodeSyntax #-}

module Data.Aeson.Extended (
  module Data.Aeson,
  module Data.Aeson.Types,
  module Data.Aeson.Extended,
)
where

import Data.Aeson
import Data.Aeson.Types
import URI.ByteString

-- | Newtype wrapper to provide 'FromJSON' and 'ToJSON' instances for 'URI'
newtype JsonURI = JsonURI {JsonURI -> URI
_unwrapURI ∷ URI}

instance FromJSON JsonURI where
  parseJSON :: Value -> Parser JsonURI
parseJSON = String -> (Text -> Parser JsonURI) -> Value -> Parser JsonURI
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"URI" ((Text -> Parser JsonURI) -> Value -> Parser JsonURI)
-> (Text -> Parser JsonURI) -> Value -> Parser JsonURI
forall a b. (a -> b) -> a -> b
$ \Text
s →
    (URIParseError -> Parser JsonURI)
-> (URI -> Parser JsonURI)
-> Either URIParseError URI
-> Parser JsonURI
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Parser JsonURI -> URIParseError -> Parser JsonURI
forall a b. a -> b -> a
const (Parser JsonURI -> URIParseError -> Parser JsonURI)
-> Parser JsonURI -> URIParseError -> Parser JsonURI
forall a b. (a -> b) -> a -> b
$ String -> Parser JsonURI
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid URI") (JsonURI -> Parser JsonURI
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (JsonURI -> Parser JsonURI)
-> (URI -> JsonURI) -> URI -> Parser JsonURI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> JsonURI
JsonURI) (Either URIParseError URI -> Parser JsonURI)
-> Either URIParseError URI -> Parser JsonURI
forall a b. (a -> b) -> a -> b
$ URIParserOptions -> ByteString -> Either URIParseError URI
parseURI URIParserOptions
laxURIParserOptions (ByteString -> Either URIParseError URI)
-> ByteString -> Either URIParseError URI
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
s

instance ToJSON JsonURI where
  toJSON :: JsonURI -> Value
toJSON = Text -> Value
String (Text -> Value) -> (JsonURI -> Text) -> JsonURI -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> (JsonURI -> ByteString) -> JsonURI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URI -> ByteString) -> (JsonURI -> URI) -> JsonURI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonURI -> URI
_unwrapURI