53 lines
1.7 KiB
Haskell
53 lines
1.7 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE KindSignatures #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PolyKinds #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
module Servant.Docs.Internal.Pretty where
|
|
|
|
import Data.Aeson
|
|
(ToJSON (..))
|
|
import Data.Aeson.Encode.Pretty
|
|
(encodePretty)
|
|
import Data.Proxy
|
|
(Proxy (Proxy))
|
|
import Network.HTTP.Media
|
|
((//))
|
|
import Servant.API
|
|
|
|
-- | PrettyJSON content type.
|
|
data PrettyJSON
|
|
|
|
instance Accept PrettyJSON where
|
|
contentType _ = "application" // "json"
|
|
|
|
instance ToJSON a => MimeRender PrettyJSON a where
|
|
mimeRender _ = encodePretty
|
|
|
|
-- | Prettify generated JSON documentation.
|
|
--
|
|
-- @
|
|
-- 'docs' ('pretty' ('Proxy' :: 'Proxy' MyAPI))
|
|
-- @
|
|
pretty :: Proxy api -> Proxy (Pretty api)
|
|
pretty Proxy = Proxy
|
|
|
|
-- | Replace all JSON content types with PrettyJSON.
|
|
-- Kind-polymorphic so it can operate on kinds @*@ and @[*]@.
|
|
type family Pretty (api :: k) :: k where
|
|
Pretty (x :<|> y) = Pretty x :<|> Pretty y
|
|
Pretty (x :> y) = Pretty x :> Pretty y
|
|
Pretty (Get cs r) = Get (Pretty cs) r
|
|
Pretty (Post cs r) = Post (Pretty cs) r
|
|
Pretty (Put cs r) = Put (Pretty cs) r
|
|
Pretty (Delete cs r) = Delete (Pretty cs) r
|
|
Pretty (Patch cs r) = Patch (Pretty cs) r
|
|
Pretty (ReqBody cs r) = ReqBody (Pretty cs) r
|
|
Pretty (JSON ': xs) = PrettyJSON ': xs
|
|
Pretty (x ': xs) = x ': Pretty xs
|
|
Pretty x = x
|