module Servant.Docs.Simple.Render ( Details (..)
, Endpoints (..)
, Node (..)
, Renderable (..)
, Json (..)
, Pretty (..)
, PlainText (..)
) where
import Data.Aeson (ToJSON (..), Value (..), object, (.=))
import Data.List (intersperse)
import Data.Text (Text, pack)
import Data.Text.Prettyprint.Doc (Doc, cat, line, nest, pretty, vcat, vsep)
newtype Endpoints = Endpoints [Node] deriving stock (Endpoints -> Endpoints -> Bool
(Endpoints -> Endpoints -> Bool)
-> (Endpoints -> Endpoints -> Bool) -> Eq Endpoints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endpoints -> Endpoints -> Bool
$c/= :: Endpoints -> Endpoints -> Bool
== :: Endpoints -> Endpoints -> Bool
$c== :: Endpoints -> Endpoints -> Bool
Eq, Int -> Endpoints -> ShowS
[Endpoints] -> ShowS
Endpoints -> String
(Int -> Endpoints -> ShowS)
-> (Endpoints -> String)
-> ([Endpoints] -> ShowS)
-> Show Endpoints
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endpoints] -> ShowS
$cshowList :: [Endpoints] -> ShowS
show :: Endpoints -> String
$cshow :: Endpoints -> String
showsPrec :: Int -> Endpoints -> ShowS
$cshowsPrec :: Int -> Endpoints -> ShowS
Show)
data Node = Node Text
Details
deriving stock (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show)
data Details = Details [Node]
| 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)
class Renderable a where
render :: Endpoints -> 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 :: Endpoints -> Json
render = Value -> Json
Json (Value -> Json) -> (Endpoints -> Value) -> Endpoints -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoints -> Value
forall a. ToJSON a => a -> Value
toJSON
instance ToJSON Endpoints where
toJSON :: Endpoints -> Value
toJSON (Endpoints endpoints :: [Node]
endpoints) = Details -> Value
forall a. ToJSON a => a -> Value
toJSON (Details -> Value) -> Details -> Value
forall a b. (a -> b) -> a -> b
$ [Node] -> Details
Details [Node]
endpoints
instance ToJSON Details where
toJSON :: Details -> Value
toJSON (Detail t :: Text
t) = Text -> Value
String Text
t
toJSON (Details ls :: [Node]
ls) = [Pair] -> Value
object ([Pair] -> Value) -> ([Node] -> [Pair]) -> [Node] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Pair) -> [Node] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node -> Pair
forall kv. KeyValue kv => Node -> kv
jsonify ([Node] -> Value) -> [Node] -> Value
forall a b. (a -> b) -> a -> b
$ [Node]
ls
where jsonify :: Node -> kv
jsonify (Node name :: Text
name details :: Details
details) = Text
name Text -> Value -> kv
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Details -> Value
forall a. ToJSON a => a -> Value
toJSON Details
details
newtype Pretty ann = Pretty { Pretty ann -> Doc ann
getPretty :: Doc ann }
instance Renderable (Pretty ann) where
render :: Endpoints -> Pretty ann
render = Doc ann -> Pretty ann
forall ann. Doc ann -> Pretty ann
Pretty (Doc ann -> Pretty ann)
-> (Endpoints -> Doc ann) -> Endpoints -> Pretty ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoints -> Doc ann
forall ann. Endpoints -> Doc ann
prettyPrint
prettyPrint :: Endpoints -> Doc ann
prettyPrint :: Endpoints -> Doc ann
prettyPrint (Endpoints ls :: [Node]
ls) = [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
$ Int -> Node -> Doc ann
forall ann. Int -> Node -> Doc ann
toDoc 0 (Node -> Doc ann) -> [Node] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
ls
toDoc :: Int -> Node -> Doc ann
toDoc :: Int -> Node -> Doc ann
toDoc i :: Int
i (Node t :: Text
t d :: Details
d) = case Details
d of
Detail a :: Text
a -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
cat [Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t, ": ", Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
a]
Details as :: [Node]
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
$ Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
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]
: (Int -> Node -> Doc ann
forall ann. Int -> Node -> Doc ann
toDoc (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4) (Node -> Doc ann) -> [Node] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
as)
newtype PlainText = PlainText { PlainText -> Text
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 :: Endpoints -> PlainText
render = Text -> PlainText
PlainText (Text -> PlainText)
-> (Endpoints -> Text) -> Endpoints -> PlainText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Endpoints -> String) -> Endpoints -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String)
-> (Endpoints -> Doc Any) -> Endpoints -> 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)
-> (Endpoints -> Pretty Any) -> Endpoints -> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoints -> Pretty Any
forall a. Renderable a => Endpoints -> a
render