module Servant.Docs.Simple.Render
( ApiDocs (..)
, Details (..)
, Renderable (..)
, Parameter
, Route
, Json (..)
, Pretty (..)
, PlainText (..)
) where
import Data.Aeson (ToJSON (..), Value (..))
import Data.HashMap.Strict (fromList)
import Data.List (intersperse)
import Data.Map.Ordered (OMap, assocs)
import Data.Text (Text, pack)
import Data.Text.Prettyprint.Doc (Doc, cat, line, nest, pretty, vcat, vsep)
newtype ApiDocs = ApiDocs (OMap Route Details) deriving stock (ApiDocs -> ApiDocs -> Bool
(ApiDocs -> ApiDocs -> Bool)
-> (ApiDocs -> ApiDocs -> Bool) -> Eq ApiDocs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiDocs -> ApiDocs -> Bool
$c/= :: ApiDocs -> ApiDocs -> Bool
== :: ApiDocs -> ApiDocs -> Bool
$c== :: ApiDocs -> ApiDocs -> Bool
Eq, Int -> ApiDocs -> ShowS
[ApiDocs] -> ShowS
ApiDocs -> String
(Int -> ApiDocs -> ShowS)
-> (ApiDocs -> String) -> ([ApiDocs] -> ShowS) -> Show ApiDocs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiDocs] -> ShowS
$cshowList :: [ApiDocs] -> ShowS
show :: ApiDocs -> String
$cshow :: ApiDocs -> String
showsPrec :: Int -> ApiDocs -> ShowS
$cshowsPrec :: Int -> ApiDocs -> ShowS
Show)
type Route = Text
data Details = Details (OMap Parameter Details)
| Detail Text
deriving stock (Details -> Details -> Bool
(Details -> Details -> Bool)
-> (Details -> Details -> Bool) -> Eq Details
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Details -> Details -> Bool
$c/= :: Details -> Details -> Bool
== :: Details -> Details -> Bool
$c== :: Details -> Details -> Bool
Eq, Int -> Details -> ShowS
[Details] -> ShowS
Details -> String
(Int -> Details -> ShowS)
-> (Details -> String) -> ([Details] -> ShowS) -> Show Details
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Details] -> ShowS
$cshowList :: [Details] -> ShowS
show :: Details -> String
$cshow :: Details -> String
showsPrec :: Int -> Details -> ShowS
$cshowsPrec :: Int -> Details -> ShowS
Show)
type Parameter = Text
class Renderable a where
render :: ApiDocs -> a
newtype Json = Json { Json -> Value
getJson :: Value } deriving stock (Json -> Json -> Bool
(Json -> Json -> Bool) -> (Json -> Json -> Bool) -> Eq Json
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Json -> Json -> Bool
$c/= :: Json -> Json -> Bool
== :: Json -> Json -> Bool
$c== :: Json -> Json -> Bool
Eq, Int -> Json -> ShowS
[Json] -> ShowS
Json -> String
(Int -> Json -> ShowS)
-> (Json -> String) -> ([Json] -> ShowS) -> Show Json
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Json] -> ShowS
$cshowList :: [Json] -> ShowS
show :: Json -> String
$cshow :: Json -> String
showsPrec :: Int -> Json -> ShowS
$cshowsPrec :: Int -> Json -> ShowS
Show)
instance Renderable Json where
render :: ApiDocs -> Json
render = Value -> Json
Json (Value -> Json) -> (ApiDocs -> Value) -> ApiDocs -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiDocs -> Value
forall a. ToJSON a => a -> Value
toJSON
instance ToJSON ApiDocs where
toJSON :: ApiDocs -> Value
toJSON (ApiDocs endpoints :: OMap Route Details
endpoints) = HashMap Route Details -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Route Details -> Value)
-> (OMap Route Details -> HashMap Route Details)
-> OMap Route Details
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Route, Details)] -> HashMap Route Details
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(Route, Details)] -> HashMap Route Details)
-> (OMap Route Details -> [(Route, Details)])
-> OMap Route Details
-> HashMap Route Details
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap Route Details -> [(Route, Details)]
forall k v. OMap k v -> [(k, v)]
assocs (OMap Route Details -> Value) -> OMap Route Details -> Value
forall a b. (a -> b) -> a -> b
$ OMap Route Details
endpoints
instance ToJSON Details where
toJSON :: Details -> Value
toJSON (Detail t :: Route
t) = Route -> Value
String Route
t
toJSON (Details ls :: OMap Route Details
ls) = HashMap Route Details -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Route Details -> Value)
-> (OMap Route Details -> HashMap Route Details)
-> OMap Route Details
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Route, Details)] -> HashMap Route Details
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(Route, Details)] -> HashMap Route Details)
-> (OMap Route Details -> [(Route, Details)])
-> OMap Route Details
-> HashMap Route Details
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap Route Details -> [(Route, Details)]
forall k v. OMap k v -> [(k, v)]
assocs (OMap Route Details -> Value) -> OMap Route Details -> Value
forall a b. (a -> b) -> a -> b
$ OMap Route Details
ls
newtype Pretty ann = Pretty { Pretty ann -> Doc ann
getPretty :: Doc ann }
instance Renderable (Pretty ann) where
render :: ApiDocs -> Pretty ann
render = Doc ann -> Pretty ann
forall ann. Doc ann -> Pretty ann
Pretty (Doc ann -> Pretty ann)
-> (ApiDocs -> Doc ann) -> ApiDocs -> Pretty ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiDocs -> Doc ann
forall ann. ApiDocs -> Doc ann
prettyPrint
prettyPrint :: ApiDocs -> Doc ann
prettyPrint :: ApiDocs -> Doc ann
prettyPrint (ApiDocs endpoints :: OMap Route Details
endpoints) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ann] -> Doc ann)
-> ([Doc ann] -> [Doc ann]) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse Doc ann
forall ann. Doc ann
line
([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Route -> Details -> Doc ann) -> (Route, Details) -> Doc ann
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Route -> Details -> Doc ann
forall ann. Int -> Route -> Details -> Doc ann
toDoc 0) ((Route, Details) -> Doc ann) -> [(Route, Details)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OMap Route Details -> [(Route, Details)]
forall k v. OMap k v -> [(k, v)]
assocs OMap Route Details
endpoints
toDoc :: Int -> Text -> Details -> Doc ann
toDoc :: Int -> Route -> Details -> Doc ann
toDoc i :: Int
i t :: Route
t d :: Details
d = case Details
d of
Detail a :: Route
a -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
cat [Route -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Route
t, ": ", Route -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Route
a]
Details as :: OMap Route Details
as -> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
i (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Route -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Route
t Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ":"
Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: ((Route -> Details -> Doc ann) -> (Route, Details) -> Doc ann
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Route -> Details -> Doc ann
forall ann. Int -> Route -> Details -> Doc ann
toDoc (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4)) ((Route, Details) -> Doc ann) -> [(Route, Details)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OMap Route Details -> [(Route, Details)]
forall k v. OMap k v -> [(k, v)]
assocs OMap Route Details
as)
newtype PlainText = PlainText { PlainText -> Route
getPlainText :: Text } deriving stock (PlainText -> PlainText -> Bool
(PlainText -> PlainText -> Bool)
-> (PlainText -> PlainText -> Bool) -> Eq PlainText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlainText -> PlainText -> Bool
$c/= :: PlainText -> PlainText -> Bool
== :: PlainText -> PlainText -> Bool
$c== :: PlainText -> PlainText -> Bool
Eq, Int -> PlainText -> ShowS
[PlainText] -> ShowS
PlainText -> String
(Int -> PlainText -> ShowS)
-> (PlainText -> String)
-> ([PlainText] -> ShowS)
-> Show PlainText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlainText] -> ShowS
$cshowList :: [PlainText] -> ShowS
show :: PlainText -> String
$cshow :: PlainText -> String
showsPrec :: Int -> PlainText -> ShowS
$cshowsPrec :: Int -> PlainText -> ShowS
Show)
instance Renderable PlainText where
render :: ApiDocs -> PlainText
render = Route -> PlainText
PlainText (Route -> PlainText) -> (ApiDocs -> Route) -> ApiDocs -> PlainText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Route
pack (String -> Route) -> (ApiDocs -> String) -> ApiDocs -> Route
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> (ApiDocs -> Doc Any) -> ApiDocs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty Any -> Doc Any
forall ann. Pretty ann -> Doc ann
getPretty (Pretty Any -> Doc Any)
-> (ApiDocs -> Pretty Any) -> ApiDocs -> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiDocs -> Pretty Any
forall a. Renderable a => ApiDocs -> a
render