module Wire.API.Presence (Presence (..), URI (..), parse) where
import Control.Lens ((?~))
import Data.Aeson qualified as A
import Data.Aeson.Types qualified as A
import Data.Attoparsec.ByteString (takeByteString)
import Data.ByteString.Char8 qualified as Bytes
import Data.ByteString.Conversion
import Data.ByteString.Lazy qualified as Lazy
import Data.Id
import Data.Misc (Milliseconds)
import Data.OpenApi qualified as S
import Data.Proxy
import Data.Schema
import Data.Text qualified as Text
import Data.Text.Encoding (decodeUtf8)
import Imports
import Network.URI qualified as Net
import Servant.API (ToHttpApiData (toUrlPiece))
newtype URI = URI
{ URI -> URI
fromURI :: Net.URI
}
deriving (URI -> URI -> Bool
(URI -> URI -> Bool) -> (URI -> URI -> Bool) -> Eq URI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
/= :: URI -> URI -> Bool
Eq, Eq URI
Eq URI =>
(URI -> URI -> Ordering)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> URI)
-> (URI -> URI -> URI)
-> Ord URI
URI -> URI -> Bool
URI -> URI -> Ordering
URI -> URI -> URI
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: URI -> URI -> Ordering
compare :: URI -> URI -> Ordering
$c< :: URI -> URI -> Bool
< :: URI -> URI -> Bool
$c<= :: URI -> URI -> Bool
<= :: URI -> URI -> Bool
$c> :: URI -> URI -> Bool
> :: URI -> URI -> Bool
$c>= :: URI -> URI -> Bool
>= :: URI -> URI -> Bool
$cmax :: URI -> URI -> URI
max :: URI -> URI -> URI
$cmin :: URI -> URI -> URI
min :: URI -> URI -> URI
Ord, Int -> URI -> ShowS
[URI] -> ShowS
URI -> String
(Int -> URI -> ShowS)
-> (URI -> String) -> ([URI] -> ShowS) -> Show URI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URI -> ShowS
showsPrec :: Int -> URI -> ShowS
$cshow :: URI -> String
show :: URI -> String
$cshowList :: [URI] -> ShowS
showList :: [URI] -> ShowS
Show)
instance A.FromJSON URI where
parseJSON :: Value -> Parser URI
parseJSON = String -> (Text -> Parser URI) -> Value -> Parser URI
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"URI" (String -> Parser URI
forall (m :: * -> *). MonadFail m => String -> m URI
parse (String -> Parser URI) -> (Text -> String) -> Text -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)
instance A.ToJSON URI where
toJSON :: URI -> Value
toJSON URI
uri = Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (URI -> String
forall a. Show a => a -> String
show (URI -> URI
fromURI URI
uri))
instance ToByteString URI where
builder :: URI -> Builder
builder = String -> Builder
forall a. ToByteString a => a -> Builder
builder (String -> Builder) -> (URI -> String) -> URI -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show (URI -> String) -> (URI -> URI) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> URI
fromURI
instance FromByteString URI where
parser :: Parser URI
parser = Parser ByteString
takeByteString Parser ByteString -> (ByteString -> Parser URI) -> Parser URI
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Parser URI
forall (m :: * -> *). MonadFail m => String -> m URI
parse (String -> Parser URI)
-> (ByteString -> String) -> ByteString -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
Bytes.unpack
instance ToHttpApiData URI where
toUrlPiece :: URI -> Text
toUrlPiece = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (URI -> ByteString) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'
instance S.ToParamSchema URI where
toParamSchema :: Proxy URI -> Schema
toParamSchema Proxy URI
_ =
Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
S.toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString
Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
-> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Valid URI"
parse :: (MonadFail m) => String -> m URI
parse :: forall (m :: * -> *). MonadFail m => String -> m URI
parse = m URI -> (URI -> m URI) -> Maybe URI -> m URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m URI
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid URI") (URI -> m URI
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URI -> m URI) -> (URI -> URI) -> URI -> m URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> URI
URI) (Maybe URI -> m URI) -> (String -> Maybe URI) -> String -> m URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
Net.parseURI
data Presence = Presence
{ Presence -> UserId
userId :: !UserId,
Presence -> ConnId
connId :: !ConnId,
Presence -> URI
resource :: !URI,
Presence -> Maybe ClientId
clientId :: !(Maybe ClientId),
Presence -> Milliseconds
createdAt :: !Milliseconds,
Presence -> ByteString
__field :: !Lazy.ByteString
}
deriving (Presence -> Presence -> Bool
(Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool) -> Eq Presence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Presence -> Presence -> Bool
== :: Presence -> Presence -> Bool
$c/= :: Presence -> Presence -> Bool
/= :: Presence -> Presence -> Bool
Eq, Eq Presence
Eq Presence =>
(Presence -> Presence -> Ordering)
-> (Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool)
-> (Presence -> Presence -> Bool)
-> (Presence -> Presence -> Presence)
-> (Presence -> Presence -> Presence)
-> Ord Presence
Presence -> Presence -> Bool
Presence -> Presence -> Ordering
Presence -> Presence -> Presence
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Presence -> Presence -> Ordering
compare :: Presence -> Presence -> Ordering
$c< :: Presence -> Presence -> Bool
< :: Presence -> Presence -> Bool
$c<= :: Presence -> Presence -> Bool
<= :: Presence -> Presence -> Bool
$c> :: Presence -> Presence -> Bool
> :: Presence -> Presence -> Bool
$c>= :: Presence -> Presence -> Bool
>= :: Presence -> Presence -> Bool
$cmax :: Presence -> Presence -> Presence
max :: Presence -> Presence -> Presence
$cmin :: Presence -> Presence -> Presence
min :: Presence -> Presence -> Presence
Ord, Int -> Presence -> ShowS
[Presence] -> ShowS
Presence -> String
(Int -> Presence -> ShowS)
-> (Presence -> String) -> ([Presence] -> ShowS) -> Show Presence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Presence -> ShowS
showsPrec :: Int -> Presence -> ShowS
$cshow :: Presence -> String
show :: Presence -> String
$cshowList :: [Presence] -> ShowS
showList :: [Presence] -> ShowS
Show)
deriving (Value -> Parser [Presence]
Value -> Parser Presence
(Value -> Parser Presence)
-> (Value -> Parser [Presence]) -> FromJSON Presence
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Presence
parseJSON :: Value -> Parser Presence
$cparseJSONList :: Value -> Parser [Presence]
parseJSONList :: Value -> Parser [Presence]
A.FromJSON, [Presence] -> Value
[Presence] -> Encoding
Presence -> Value
Presence -> Encoding
(Presence -> Value)
-> (Presence -> Encoding)
-> ([Presence] -> Value)
-> ([Presence] -> Encoding)
-> ToJSON Presence
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Presence -> Value
toJSON :: Presence -> Value
$ctoEncoding :: Presence -> Encoding
toEncoding :: Presence -> Encoding
$ctoJSONList :: [Presence] -> Value
toJSONList :: [Presence] -> Value
$ctoEncodingList :: [Presence] -> Encoding
toEncodingList :: [Presence] -> Encoding
A.ToJSON, Typeable Presence
Typeable Presence =>
(Proxy Presence -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Presence
Proxy Presence -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Presence -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Presence -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema Presence)
instance ToSchema Presence where
schema :: ValueSchema NamedSwaggerDoc Presence
schema =
Text
-> SchemaP SwaggerDoc Object [Pair] Presence Presence
-> ValueSchema NamedSwaggerDoc Presence
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Presence" (SchemaP SwaggerDoc Object [Pair] Presence Presence
-> ValueSchema NamedSwaggerDoc Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence Presence
-> ValueSchema NamedSwaggerDoc Presence
forall a b. (a -> b) -> a -> b
$
( UserId
-> ConnId
-> URI
-> Maybe ClientId
-> Milliseconds
-> ByteString
-> Presence
Presence
(UserId
-> ConnId
-> URI
-> Maybe ClientId
-> Milliseconds
-> ByteString
-> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence UserId
-> SchemaP
SwaggerDoc
Object
[Pair]
Presence
(ConnId
-> URI -> Maybe ClientId -> Milliseconds -> ByteString -> Presence)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Presence -> UserId
userId (Presence -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] Presence UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"user_id" SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
SchemaP
SwaggerDoc
Object
[Pair]
Presence
(ConnId
-> URI -> Maybe ClientId -> Milliseconds -> ByteString -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence ConnId
-> SchemaP
SwaggerDoc
Object
[Pair]
Presence
(URI -> Maybe ClientId -> Milliseconds -> ByteString -> Presence)
forall a b.
SchemaP SwaggerDoc Object [Pair] Presence (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Presence a
-> SchemaP SwaggerDoc Object [Pair] Presence b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Presence -> ConnId
connId (Presence -> ConnId)
-> SchemaP SwaggerDoc Object [Pair] ConnId ConnId
-> SchemaP SwaggerDoc Object [Pair] Presence ConnId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ConnId ConnId
-> SchemaP SwaggerDoc Object [Pair] ConnId ConnId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"device_id" SchemaP NamedSwaggerDoc Value Value ConnId ConnId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
SchemaP
SwaggerDoc
Object
[Pair]
Presence
(URI -> Maybe ClientId -> Milliseconds -> ByteString -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence URI
-> SchemaP
SwaggerDoc
Object
[Pair]
Presence
(Maybe ClientId -> Milliseconds -> ByteString -> Presence)
forall a b.
SchemaP SwaggerDoc Object [Pair] Presence (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Presence a
-> SchemaP SwaggerDoc Object [Pair] Presence b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Presence -> URI
resource (Presence -> URI)
-> SchemaP SwaggerDoc Object [Pair] URI URI
-> SchemaP SwaggerDoc Object [Pair] Presence URI
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value URI URI
-> SchemaP SwaggerDoc Object [Pair] URI URI
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"resource" SchemaP NamedSwaggerDoc Value Value URI URI
uriSchema
SchemaP
SwaggerDoc
Object
[Pair]
Presence
(Maybe ClientId -> Milliseconds -> ByteString -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence (Maybe ClientId)
-> SchemaP
SwaggerDoc
Object
[Pair]
Presence
(Milliseconds -> ByteString -> Presence)
forall a b.
SchemaP SwaggerDoc Object [Pair] Presence (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Presence a
-> SchemaP SwaggerDoc Object [Pair] Presence b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Presence -> Maybe ClientId
clientId (Presence -> Maybe ClientId)
-> SchemaP
SwaggerDoc Object [Pair] (Maybe ClientId) (Maybe ClientId)
-> SchemaP SwaggerDoc Object [Pair] Presence (Maybe ClientId)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value (Maybe ClientId) ClientId
-> SchemaP
SwaggerDoc Object [Pair] (Maybe ClientId) (Maybe ClientId)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"client_id" (Value
-> SchemaP NamedSwaggerDoc Value Value ClientId ClientId
-> SchemaP NamedSwaggerDoc Value Value (Maybe ClientId) ClientId
forall w d v a b.
w -> SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybeWithDefault Value
A.Null SchemaP NamedSwaggerDoc Value Value ClientId ClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
SchemaP
SwaggerDoc
Object
[Pair]
Presence
(Milliseconds -> ByteString -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence Milliseconds
-> SchemaP
SwaggerDoc Object [Pair] Presence (ByteString -> Presence)
forall a b.
SchemaP SwaggerDoc Object [Pair] Presence (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Presence a
-> SchemaP SwaggerDoc Object [Pair] Presence b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Presence -> Milliseconds
createdAt (Presence -> Milliseconds)
-> SchemaP SwaggerDoc Object [Pair] Milliseconds Milliseconds
-> SchemaP SwaggerDoc Object [Pair] Presence Milliseconds
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Milliseconds -> Maybe Milliseconds -> Milliseconds
forall a. a -> Maybe a -> a
fromMaybe Milliseconds
0 (Maybe Milliseconds -> Milliseconds)
-> SchemaP
SwaggerDoc Object [Pair] Milliseconds (Maybe Milliseconds)
-> SchemaP SwaggerDoc Object [Pair] Milliseconds Milliseconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
-> SchemaP NamedSwaggerDoc Value Value Milliseconds Milliseconds
-> SchemaP
SwaggerDoc Object [Pair] Milliseconds (Maybe Milliseconds)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"created_at" SchemaP NamedSwaggerDoc Value Value Milliseconds Milliseconds
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
)
SchemaP SwaggerDoc Object [Pair] Presence (ByteString -> Presence)
-> ((ByteString -> Presence) -> Presence)
-> SchemaP SwaggerDoc Object [Pair] Presence Presence
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((ByteString -> Presence) -> ByteString -> Presence
forall a b. (a -> b) -> a -> b
$ (ByteString
"" :: Lazy.ByteString))
uriSchema :: ValueSchema NamedSwaggerDoc URI
uriSchema :: SchemaP NamedSwaggerDoc Value Value URI URI
uriSchema = NamedSwaggerDoc
-> (Value -> Parser URI)
-> (URI -> Maybe Value)
-> SchemaP NamedSwaggerDoc Value Value URI URI
forall doc v b a w.
doc -> (v -> Parser b) -> (a -> Maybe w) -> SchemaP doc v w a b
mkSchema NamedSwaggerDoc
desc Value -> Parser URI
uriFromJSON (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (URI -> Value) -> URI -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Value
uriToJSON)
where
desc :: NamedSwaggerDoc
desc :: NamedSwaggerDoc
desc =
forall a. ToSchema a => NamedSwaggerDoc
swaggerDoc @Text
NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema)
-> (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> OpenApiType -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString)
NamedSwaggerDoc
-> (NamedSwaggerDoc -> NamedSwaggerDoc) -> NamedSwaggerDoc
forall a b. a -> (a -> b) -> b
& ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasSchema s a => Lens' s a
Lens' NamedSwaggerDoc Schema
S.schema ((Schema -> Identity Schema)
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> ((Maybe Text -> Identity (Maybe Text))
-> Schema -> Identity Schema)
-> (Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc
-> Identity NamedSwaggerDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"Valid URI.")
uriFromJSON :: A.Value -> A.Parser URI
uriFromJSON :: Value -> Parser URI
uriFromJSON = String -> (Text -> Parser URI) -> Value -> Parser URI
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"URI" (String -> Parser URI
forall (m :: * -> *). MonadFail m => String -> m URI
p (String -> Parser URI) -> (Text -> String) -> Text -> Parser URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)
where
p :: (MonadFail m) => String -> m URI
p :: forall (m :: * -> *). MonadFail m => String -> m URI
p = m URI -> (URI -> m URI) -> Maybe URI -> m URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m URI
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid URI") URI -> m URI
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe URI -> m URI) -> (String -> Maybe URI) -> String -> m URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
forall (m :: * -> *). MonadFail m => String -> m URI
parse
uriToJSON :: URI -> A.Value
uriToJSON :: URI -> Value
uriToJSON (URI URI
uri) = Text -> Value
A.String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ ShowS -> URI -> ShowS
Net.uriToString ShowS
forall a. a -> a
id URI
uri String
forall a. Monoid a => a
mempty