module Web.Minion.Examples.Introspection (app) where

import Data.CaseInsensitive qualified as CI
import Data.List (nub)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text.Encoding
import Data.Text.IO qualified
import GHC.Generics (Generic)
import Network.HTTP.Media
import Web.Minion
import Web.Minion.Auth.Basic
import Web.Minion.Introspect qualified as I
import Web.Minion.Media
import Web.Minion.Router

{-
GET api/post/:postId | Post api; Get post by ID
  Basic auth required
  Response: application/json

POST api/post/:postId | Post api; Create or update post
  Basic auth required
  Request body: text/plain
  Response: application/json

GET api/comments | Comments api; Get comments for post
  Query params: postId!, size?, page?
  Basic auth required
  Response: application/json

POST api/comments/:commentId | Comments api; Create or update comment
  Basic auth required
  Request body: text/plain
  Response: application/json

GET api/images/:pathToImage.. | Images api
  Basic auth required
  Response: raw bytes
-}
app :: IO ()
app :: IO ()
app = Text -> IO ()
Data.Text.IO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Router' Pretty Void IO -> Text
forall (m :: * -> *). Router' Pretty Void m -> Text
prettyApi Router' Pretty Void IO
api

prettyApi :: Router' Pretty Void m -> Text
prettyApi :: forall (m :: * -> *). Router' Pretty Void m -> Text
prettyApi = [Text] -> Text
Text.unlines ([Text] -> Text)
-> (Router' Pretty Void m -> [Text])
-> Router' Pretty Void m
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrettyInfo -> Text) -> [PrettyInfo] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PrettyInfo -> Text
prettyInfoToText ([PrettyInfo] -> [Text])
-> (Router' Pretty Void m -> [PrettyInfo])
-> Router' Pretty Void m
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Router' Pretty Void m -> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go
 where
  prependPath :: Text -> PrettyInfo -> PrettyInfo
prependPath Text
txt PrettyInfo{[(Text, Bool)]
[Text]
Text
path :: [Text]
headers :: [(Text, Bool)]
queryParams :: [(Text, Bool)]
request :: [Text]
response :: Text
method :: Text
descriptions :: [Text]
$sel:path:PrettyInfo :: PrettyInfo -> [Text]
$sel:headers:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:queryParams:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:request:PrettyInfo :: PrettyInfo -> [Text]
$sel:response:PrettyInfo :: PrettyInfo -> Text
$sel:method:PrettyInfo :: PrettyInfo -> Text
$sel:descriptions:PrettyInfo :: PrettyInfo -> [Text]
..} = PrettyInfo{$sel:path:PrettyInfo :: [Text]
path = Text
txt Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
path, [(Text, Bool)]
[Text]
Text
headers :: [(Text, Bool)]
queryParams :: [(Text, Bool)]
request :: [Text]
response :: Text
method :: Text
descriptions :: [Text]
$sel:headers:PrettyInfo :: [(Text, Bool)]
$sel:queryParams:PrettyInfo :: [(Text, Bool)]
$sel:request:PrettyInfo :: [Text]
$sel:response:PrettyInfo :: Text
$sel:method:PrettyInfo :: Text
$sel:descriptions:PrettyInfo :: [Text]
..}
  addQueryParam :: ByteString -> Bool -> PrettyInfo -> PrettyInfo
addQueryParam ByteString
qn Bool
isReq PrettyInfo{[(Text, Bool)]
[Text]
Text
$sel:path:PrettyInfo :: PrettyInfo -> [Text]
$sel:headers:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:queryParams:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:request:PrettyInfo :: PrettyInfo -> [Text]
$sel:response:PrettyInfo :: PrettyInfo -> Text
$sel:method:PrettyInfo :: PrettyInfo -> Text
$sel:descriptions:PrettyInfo :: PrettyInfo -> [Text]
path :: [Text]
headers :: [(Text, Bool)]
queryParams :: [(Text, Bool)]
request :: [Text]
response :: Text
method :: Text
descriptions :: [Text]
..} = PrettyInfo{$sel:queryParams:PrettyInfo :: [(Text, Bool)]
queryParams = (ByteString -> Text
Text.Encoding.decodeUtf8 ByteString
qn, Bool
isReq) (Text, Bool) -> [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> [a] -> [a]
: [(Text, Bool)]
queryParams, [(Text, Bool)]
[Text]
Text
$sel:path:PrettyInfo :: [Text]
$sel:headers:PrettyInfo :: [(Text, Bool)]
$sel:request:PrettyInfo :: [Text]
$sel:response:PrettyInfo :: Text
$sel:method:PrettyInfo :: Text
$sel:descriptions:PrettyInfo :: [Text]
path :: [Text]
headers :: [(Text, Bool)]
request :: [Text]
response :: Text
method :: Text
descriptions :: [Text]
..}
  addDescription :: Text -> PrettyInfo -> PrettyInfo
addDescription Text
txt PrettyInfo{[(Text, Bool)]
[Text]
Text
$sel:path:PrettyInfo :: PrettyInfo -> [Text]
$sel:headers:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:queryParams:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:request:PrettyInfo :: PrettyInfo -> [Text]
$sel:response:PrettyInfo :: PrettyInfo -> Text
$sel:method:PrettyInfo :: PrettyInfo -> Text
$sel:descriptions:PrettyInfo :: PrettyInfo -> [Text]
path :: [Text]
headers :: [(Text, Bool)]
queryParams :: [(Text, Bool)]
request :: [Text]
response :: Text
method :: Text
descriptions :: [Text]
..} = PrettyInfo{$sel:descriptions:PrettyInfo :: [Text]
descriptions = Text
txt Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
descriptions, [(Text, Bool)]
[Text]
Text
$sel:path:PrettyInfo :: [Text]
$sel:headers:PrettyInfo :: [(Text, Bool)]
$sel:queryParams:PrettyInfo :: [(Text, Bool)]
$sel:request:PrettyInfo :: [Text]
$sel:response:PrettyInfo :: Text
$sel:method:PrettyInfo :: Text
path :: [Text]
headers :: [(Text, Bool)]
queryParams :: [(Text, Bool)]
request :: [Text]
response :: Text
method :: Text
..}
  addHeader :: CI ByteString -> Bool -> PrettyInfo -> PrettyInfo
addHeader CI ByteString
hn Bool
isReq PrettyInfo{[(Text, Bool)]
[Text]
Text
$sel:path:PrettyInfo :: PrettyInfo -> [Text]
$sel:headers:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:queryParams:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:request:PrettyInfo :: PrettyInfo -> [Text]
$sel:response:PrettyInfo :: PrettyInfo -> Text
$sel:method:PrettyInfo :: PrettyInfo -> Text
$sel:descriptions:PrettyInfo :: PrettyInfo -> [Text]
path :: [Text]
headers :: [(Text, Bool)]
queryParams :: [(Text, Bool)]
request :: [Text]
response :: Text
method :: Text
descriptions :: [Text]
..} = PrettyInfo{$sel:headers:PrettyInfo :: [(Text, Bool)]
headers = (ByteString -> Text
Text.Encoding.decodeUtf8 (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
hn), Bool
isReq) (Text, Bool) -> [(Text, Bool)] -> [(Text, Bool)]
forall a. a -> [a] -> [a]
: [(Text, Bool)]
headers, [(Text, Bool)]
[Text]
Text
$sel:path:PrettyInfo :: [Text]
$sel:queryParams:PrettyInfo :: [(Text, Bool)]
$sel:request:PrettyInfo :: [Text]
$sel:response:PrettyInfo :: Text
$sel:method:PrettyInfo :: Text
$sel:descriptions:PrettyInfo :: [Text]
path :: [Text]
queryParams :: [(Text, Bool)]
request :: [Text]
response :: Text
method :: Text
descriptions :: [Text]
..}
  addRequest :: Text -> PrettyInfo -> PrettyInfo
addRequest Text
req PrettyInfo{[(Text, Bool)]
[Text]
Text
$sel:path:PrettyInfo :: PrettyInfo -> [Text]
$sel:headers:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:queryParams:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:request:PrettyInfo :: PrettyInfo -> [Text]
$sel:response:PrettyInfo :: PrettyInfo -> Text
$sel:method:PrettyInfo :: PrettyInfo -> Text
$sel:descriptions:PrettyInfo :: PrettyInfo -> [Text]
path :: [Text]
headers :: [(Text, Bool)]
queryParams :: [(Text, Bool)]
request :: [Text]
response :: Text
method :: Text
descriptions :: [Text]
..} = PrettyInfo{$sel:request:PrettyInfo :: [Text]
request = Text
req Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
request, [(Text, Bool)]
[Text]
Text
$sel:path:PrettyInfo :: [Text]
$sel:headers:PrettyInfo :: [(Text, Bool)]
$sel:queryParams:PrettyInfo :: [(Text, Bool)]
$sel:response:PrettyInfo :: Text
$sel:method:PrettyInfo :: Text
$sel:descriptions:PrettyInfo :: [Text]
path :: [Text]
headers :: [(Text, Bool)]
queryParams :: [(Text, Bool)]
response :: Text
method :: Text
descriptions :: [Text]
..}

  go :: Router' Pretty a m -> [PrettyInfo]
  go :: forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go = \case
    Piece Text
txt Router' Pretty a m
cont -> (PrettyInfo -> PrettyInfo) -> [PrettyInfo] -> [PrettyInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PrettyInfo -> PrettyInfo
prependPath Text
txt) (Router' Pretty a m -> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go Router' Pretty a m
cont)
    Capture MakeError -> Text -> m a
_ Text
txt Router' Pretty (a :+ WithPiece a) m
cont -> (PrettyInfo -> PrettyInfo) -> [PrettyInfo] -> [PrettyInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PrettyInfo -> PrettyInfo
prependPath (Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt)) (Router' Pretty (a :+ WithPiece a) m -> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go Router' Pretty (a :+ WithPiece a) m
cont)
    Captures MakeError -> [Text] -> m [a]
_ Text
txt Router' Pretty (a :+ WithPieces a) m
cont -> (PrettyInfo -> PrettyInfo) -> [PrettyInfo] -> [PrettyInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PrettyInfo -> PrettyInfo
prependPath (Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..")) (Router' Pretty (a :+ WithPieces a) m -> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go Router' Pretty (a :+ WithPieces a) m
cont)
    QueryParam @_ @presence ByteString
qn MakeError -> Maybe (Maybe ByteString) -> m (Arg presence parsing a)
_ Router' Pretty (a :+ WithQueryParam presence parsing m a) m
cont -> (PrettyInfo -> PrettyInfo) -> [PrettyInfo] -> [PrettyInfo]
forall a b. (a -> b) -> [a] -> [b]
map
      do ByteString -> Bool -> PrettyInfo -> PrettyInfo
addQueryParam ByteString
qn (forall a. IsRequired a => Bool
forall {k} (a :: k). IsRequired a => Bool
isRequired @presence)
      do Router' Pretty (a :+ WithQueryParam presence parsing m a) m
-> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go Router' Pretty (a :+ WithQueryParam presence parsing m a) m
cont
    Description desc
d Router' Pretty a m
cont -> (PrettyInfo -> PrettyInfo) -> [PrettyInfo] -> [PrettyInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PrettyInfo -> PrettyInfo
addDescription (desc -> Text
forall a. PrettyDescription a => a -> Text
prettyDescription desc
d)) (Router' Pretty a m -> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go Router' Pretty a m
cont)
    Middleware MiddlewareM m
_ Router' Pretty a m
cont -> Router' Pretty a m -> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go Router' Pretty a m
cont
    Header @_ @presence CI ByteString
hn MakeError -> [ByteString] -> m (Arg presence parsing a)
_ Router' Pretty (a :+ WithHeader presence parsing m a) m
cont -> (PrettyInfo -> PrettyInfo) -> [PrettyInfo] -> [PrettyInfo]
forall a b. (a -> b) -> [a] -> [b]
map
      do CI ByteString -> Bool -> PrettyInfo -> PrettyInfo
addHeader CI ByteString
hn (forall a. IsRequired a => Bool
forall {k} (a :: k). IsRequired a => Bool
isRequired @presence)
      do Router' Pretty (a :+ WithHeader presence parsing m a) m
-> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go Router' Pretty (a :+ WithHeader presence parsing m a) m
cont
    Request @r ErrorBuilder -> Request -> m r
_ Router' Pretty (a :+ WithReq m r) m
cont -> (PrettyInfo -> PrettyInfo) -> [PrettyInfo] -> [PrettyInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PrettyInfo -> PrettyInfo
addRequest (forall a. PrettyBody a => Text
forall {k} (a :: k). PrettyBody a => Text
prettyBody @r)) (Router' Pretty (a :+ WithReq m r) m -> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go Router' Pretty (a :+ WithReq m r) m
cont)
    Alt [Router' Pretty a m]
alts -> (Router' Pretty a m -> [PrettyInfo])
-> [Router' Pretty a m] -> [PrettyInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Router' Pretty a m -> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go [Router' Pretty a m]
alts
    Handle @o ByteString
method HList (DelayedArgs st) -> m o
_ -> [[Text]
-> [(Text, Bool)]
-> [(Text, Bool)]
-> [Text]
-> Text
-> Text
-> [Text]
-> PrettyInfo
PrettyInfo [] [] [] [] (forall a. PrettyBody a => Text
forall {k} (a :: k). PrettyBody a => Text
prettyBody @o) (ByteString -> Text
Text.Encoding.decodeUtf8 ByteString
method) []]
    MapArgs RHList a -> RHList ts'
_ Router' Pretty ts' m
cont -> Router' Pretty ts' m -> [PrettyInfo]
forall a (m :: * -> *). Router' Pretty a m -> [PrettyInfo]
go Router' Pretty ts' m
cont
    HideIntrospection Router' i1 a m
_ -> []

api :: Router' Pretty Void IO
api :: Router' Pretty Void IO
api = Router' Pretty Void IO -> Router' Pretty Void IO
"api" (Router' Pretty Void IO -> Router' Pretty Void IO)
-> Router' Pretty Void IO -> Router' Pretty Void IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> ValueCombinator Pretty (WithReq IO (Auth '[Basic] UserId)) Void IO
forall {ts}.
ValueCombinator Pretty (WithReq IO (Auth '[Basic] UserId)) ts IO
myAuth ValueCombinator Pretty (WithReq IO (Auth '[Basic] UserId)) Void IO
-> ValueCombinator
     Pretty (WithReq IO (Auth '[Basic] UserId)) Void IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> [Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
"post" (Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
 -> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO)
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
postApi, Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
"comments" (Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
 -> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO)
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
commentsApi, Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
"images" (Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
 -> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO)
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
imagesApi]
 where
  imagesApi :: Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
imagesApi = Text
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
forall i a ts (m :: * -> *).
Introspection i 'Description a =>
a -> Combinator i ts m
description Text
"Images api" (Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
 -> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO)
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> forall b (m :: * -> *) i ts.
(FromHttpApiData b, Introspection i 'Captures b, MonadThrow m) =>
Text -> ValueCombinator i (WithPieces b) ts m
captures @String Text
"pathToImage" ValueCombinator
  Pretty
  (WithPieces String)
  (Void :+ WithReq IO (Auth '[Basic] UserId))
  IO
-> ValueCombinator
     Pretty
     (WithPieces String)
     (Void :+ WithReq IO (Auth '[Basic] UserId))
     IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToResponse m o, CanRespond o,
 Introspection i 'Response o) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handle @Chunks ByteString
GET DelayedArgs '[WithReq IO (Auth '[Basic] UserId), WithPieces String]
~> IO Chunks
forall a. HasCallStack => a
undefined
  postApi :: Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
postApi =
    Text
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
forall i a ts (m :: * -> *).
Introspection i 'Description a =>
a -> Combinator i ts m
description Text
"Post api"
      (Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
 -> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO)
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> forall b (m :: * -> *) i ts.
(FromHttpApiData b, Introspection i 'Capture b, MonadThrow m) =>
Text -> ValueCombinator i (WithPiece b) ts m
capture @PostId Text
"postId"
      ValueCombinator
  Pretty
  (WithPiece UserId)
  (Void :+ WithReq IO (Auth '[Basic] UserId))
  IO
-> ValueCombinator
     Pretty
     (WithPiece UserId)
     (Void :+ WithReq IO (Auth '[Basic] UserId))
     IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> [ Text
-> Combinator
     Pretty
     ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
     IO
forall i a ts (m :: * -> *).
Introspection i 'Description a =>
a -> Combinator i ts m
description Text
"Get post by ID" Combinator
  Pretty
  ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
  IO
-> Combinator
     Pretty
     ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
     IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToJSON o, MonadIO m,
 Introspection i 'Response (RespBody '[Json] o)) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handleJson @Text ByteString
GET DelayedArgs '[WithReq IO (Auth '[Basic] UserId), WithPiece UserId]
~> IO Text
forall a. HasCallStack => a
undefined
         , Text
-> Combinator
     Pretty
     ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
     IO
forall i a ts (m :: * -> *).
Introspection i 'Description a =>
a -> Combinator i ts m
description Text
"Create or update post"
            Combinator
  Pretty
  ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
  IO
-> Combinator
     Pretty
     ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
     IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> forall r (m :: * -> *) i ts.
(Introspection i 'Request (ReqBody '[PlainText] r), MonadIO m,
 MonadThrow m, Decode PlainText r) =>
ValueCombinator i (WithReq m (ReqBody '[PlainText] r)) ts m
reqPlainText @Text
            ValueCombinator
  Pretty
  (WithReq IO (ReqBody '[PlainText] Text))
  ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
  IO
-> ValueCombinator
     Pretty
     (WithReq IO (ReqBody '[PlainText] Text))
     ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
     IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToJSON o, MonadIO m,
 Introspection i 'Response (RespBody '[Json] o)) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handleJson @() ByteString
POST DelayedArgs
  '[WithReq IO (Auth '[Basic] UserId), WithPiece UserId,
    WithReq IO (ReqBody '[PlainText] Text)]
~> IO ()
forall a. HasCallStack => a
undefined
         ]
  commentsApi :: Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
commentsApi =
    Text
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
forall i a ts (m :: * -> *).
Introspection i 'Description a =>
a -> Combinator i ts m
description Text
"Comments api"
      (Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
 -> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO)
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
-> Router' Pretty (Void :+ WithReq IO (Auth '[Basic] UserId)) IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> [
           [ forall a (m :: * -> *) i ts.
(FromHttpApiData a, Introspection i 'QueryParam a, MonadThrow m) =>
Text -> ValueCombinator i (WithQueryParam Required Strict m a) ts m
queryParam' @PostId Text
"postId"
              ValueCombinator
  Pretty
  (WithQueryParam Required Strict IO UserId)
  (Void :+ WithReq IO (Auth '[Basic] UserId))
  IO
-> ValueCombinator
     Pretty
     (WithQueryParam Required Strict IO UserId)
     (Void :+ WithReq IO (Auth '[Basic] UserId))
     IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> forall a (m :: * -> *) i ts.
(FromHttpApiData a, Introspection i 'QueryParam a, MonadThrow m) =>
Text -> ValueCombinator i (WithQueryParam Optional Strict m a) ts m
queryParam @Size Text
"size"
              ValueCombinator
  Pretty
  (WithQueryParam Optional Strict IO UserId)
  ((Void :+ WithReq IO (Auth '[Basic] UserId))
   :+ WithQueryParam Required Strict IO UserId)
  IO
-> ValueCombinator
     Pretty
     (WithQueryParam Optional Strict IO UserId)
     ((Void :+ WithReq IO (Auth '[Basic] UserId))
      :+ WithQueryParam Required Strict IO UserId)
     IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> forall a (m :: * -> *) i ts.
(FromHttpApiData a, Introspection i 'QueryParam a, MonadThrow m) =>
Text -> ValueCombinator i (WithQueryParam Optional Strict m a) ts m
queryParam @Page Text
"page"
              ValueCombinator
  Pretty
  (WithQueryParam Optional Strict IO UserId)
  (((Void :+ WithReq IO (Auth '[Basic] UserId))
    :+ WithQueryParam Required Strict IO UserId)
   :+ WithQueryParam Optional Strict IO UserId)
  IO
-> ValueCombinator
     Pretty
     (WithQueryParam Optional Strict IO UserId)
     (((Void :+ WithReq IO (Auth '[Basic] UserId))
       :+ WithQueryParam Required Strict IO UserId)
      :+ WithQueryParam Optional Strict IO UserId)
     IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> Text
-> Combinator
     Pretty
     ((((Void :+ WithReq IO (Auth '[Basic] UserId))
        :+ WithQueryParam Required Strict IO UserId)
       :+ WithQueryParam Optional Strict IO UserId)
      :+ WithQueryParam Optional Strict IO UserId)
     IO
forall i a ts (m :: * -> *).
Introspection i 'Description a =>
a -> Combinator i ts m
description Text
"Get comments for post"
              Combinator
  Pretty
  ((((Void :+ WithReq IO (Auth '[Basic] UserId))
     :+ WithQueryParam Required Strict IO UserId)
    :+ WithQueryParam Optional Strict IO UserId)
   :+ WithQueryParam Optional Strict IO UserId)
  IO
-> Combinator
     Pretty
     ((((Void :+ WithReq IO (Auth '[Basic] UserId))
        :+ WithQueryParam Required Strict IO UserId)
       :+ WithQueryParam Optional Strict IO UserId)
      :+ WithQueryParam Optional Strict IO UserId)
     IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToJSON o, MonadIO m,
 Introspection i 'Response (RespBody '[Json] o)) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handleJson @[Text] ByteString
GET DelayedArgs
  '[WithReq IO (Auth '[Basic] UserId),
    WithQueryParam Required Strict IO UserId,
    WithQueryParam Optional Strict IO UserId,
    WithQueryParam Optional Strict IO UserId]
~> IO [Text]
forall a. HasCallStack => a
undefined
           , forall b (m :: * -> *) i ts.
(FromHttpApiData b, Introspection i 'Capture b, MonadThrow m) =>
Text -> ValueCombinator i (WithPiece b) ts m
capture @CommentId Text
"commentId"
              ValueCombinator
  Pretty
  (WithPiece UserId)
  (Void :+ WithReq IO (Auth '[Basic] UserId))
  IO
-> ValueCombinator
     Pretty
     (WithPiece UserId)
     (Void :+ WithReq IO (Auth '[Basic] UserId))
     IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> Text
-> Combinator
     Pretty
     ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
     IO
forall i a ts (m :: * -> *).
Introspection i 'Description a =>
a -> Combinator i ts m
description Text
"Create or update comment"
              Combinator
  Pretty
  ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
  IO
-> Combinator
     Pretty
     ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
     IO
forall i ts (r :: * -> *).
(Router' i ts r -> Router' i ts r)
-> Router' i ts r -> Router' i ts r
/> forall r (m :: * -> *) i ts.
(Introspection i 'Request (ReqBody '[PlainText] r), MonadIO m,
 MonadThrow m, Decode PlainText r) =>
ValueCombinator i (WithReq m (ReqBody '[PlainText] r)) ts m
reqPlainText @Text
              ValueCombinator
  Pretty
  (WithReq IO (ReqBody '[PlainText] Text))
  ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
  IO
-> ValueCombinator
     Pretty
     (WithReq IO (ReqBody '[PlainText] Text))
     ((Void :+ WithReq IO (Auth '[Basic] UserId)) :+ WithPiece UserId)
     IO
forall i ts' (r :: * -> *) ts.
(Router' i ts' r -> Router' i ts r)
-> Router' i ts' r -> Router' i ts r
.> forall o (m :: * -> *) ts i (st :: [*]).
(HandleArgs ts st m, ToJSON o, MonadIO m,
 Introspection i 'Response (RespBody '[Json] o)) =>
ByteString -> (DelayedArgs st ~> m o) -> Router' i ts m
handleJson @() ByteString
POST DelayedArgs
  '[WithReq IO (Auth '[Basic] UserId), WithPiece UserId,
    WithReq IO (ReqBody '[PlainText] Text)]
~> IO ()
forall a. HasCallStack => a
undefined
           ]
         ]
  myAuth :: ValueCombinator Pretty (WithReq IO (Auth '[Basic] UserId)) ts IO
myAuth =
    forall (auths :: [*]) a (m :: * -> *) (ctx :: [*]) ts i.
(Introspection i 'Request (Auth auths a), UnwindAuth ctx auths m a,
 MonadThrow m) =>
m (HList ctx)
-> (MakeError -> AuthResult Void -> m Void)
-> ValueCombinator i (WithReq m (Auth auths a)) ts m
auth @'[Basic] @UserId
      (HList '[BasicAuthSettings IO UserId]
-> IO (HList '[BasicAuthSettings IO UserId])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HList '[BasicAuthSettings IO UserId]
 -> IO (HList '[BasicAuthSettings IO UserId]))
-> HList '[BasicAuthSettings IO UserId]
-> IO (HList '[BasicAuthSettings IO UserId])
forall a b. (a -> b) -> a -> b
$ (BasicAuthSettings IO UserId
forall a. HasCallStack => a
undefined :: BasicAuthSettings IO UserId) BasicAuthSettings IO UserId
-> HList '[] -> HList '[BasicAuthSettings IO UserId]
forall t (ts1 :: [*]). t -> HList ts1 -> HList (t : ts1)
:# HList '[]
HNil)
      MakeError -> AuthResult Void -> IO Void
forall a. HasCallStack => a
undefined

data Pretty

type instance I.Introspection Pretty I.QueryParam = I.AbsolutelyNothing
type instance I.Introspection Pretty I.Capture = I.AbsolutelyNothing
type instance I.Introspection Pretty I.Captures = I.AbsolutelyNothing
type instance I.Introspection Pretty I.Header = I.AbsolutelyNothing
type instance I.Introspection Pretty I.Request = PrettyBody
type instance I.Introspection Pretty I.Response = PrettyBody
type instance I.Introspection Pretty I.Description = PrettyDescription

class PrettyBody a where
  prettyBody :: Text

class PrettyDescription a where
  prettyDescription :: a -> Text

instance (a ~ Text) => PrettyDescription a where
  prettyDescription :: a -> Text
prettyDescription = a -> a
a -> Text
forall a. a -> a
id

instance (AllContentTypes cts) => PrettyBody (ReqBody cts a) where
  prettyBody :: Text
prettyBody = Text
"Request body: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" or " (forall (cts :: [*]). AllContentTypes cts => [Text]
forall {k} (cts :: k). AllContentTypes cts => [Text]
mediaTypes @cts)

instance PrettyBody Chunks where
  prettyBody :: Text
prettyBody = Text
"Response: raw bytes"

instance PrettyBody (Auth '[Basic] a) where
  prettyBody :: Text
prettyBody = Text
"Basic auth required"

instance (AllContentTypes cts) => PrettyBody (RespBody cts a) where
  prettyBody :: Text
prettyBody = Text
"Response: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" or " (forall (cts :: k). AllContentTypes cts => [Text]
forall {k} (cts :: k). AllContentTypes cts => [Text]
mediaTypes @cts)

mediaTypes :: forall cts. (AllContentTypes cts) => [Text]
mediaTypes :: forall {k} (cts :: k). AllContentTypes cts => [Text]
mediaTypes =
  [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub
    ([Text] -> [Text])
-> ([MediaType] -> [Text]) -> [MediaType] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MediaType -> Text) -> [MediaType] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map
      do \MediaType
a -> ByteString -> Text
Text.Encoding.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
CI.original (MediaType -> CI ByteString
mainType MediaType
a) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> CI ByteString -> ByteString
forall s. CI s -> s
CI.original (MediaType -> CI ByteString
subType MediaType
a)
    ([MediaType] -> [Text]) -> [MediaType] -> [Text]
forall a b. (a -> b) -> a -> b
$ forall (cts :: k). AllContentTypes cts => [MediaType]
forall {k} (cts :: k). AllContentTypes cts => [MediaType]
allContentTypes @cts

type PostId = Int
type UserId = Int
type CommentId = Int
type Size = Int
type Page = Int

data PrettyInfo = PrettyInfo
  { PrettyInfo -> [Text]
path :: [Text]
  , PrettyInfo -> [(Text, Bool)]
headers :: [(Text, Bool)]
  , PrettyInfo -> [(Text, Bool)]
queryParams :: [(Text, Bool)]
  , PrettyInfo -> [Text]
request :: [Text]
  , PrettyInfo -> Text
response :: Text
  , PrettyInfo -> Text
method :: Text
  , PrettyInfo -> [Text]
descriptions :: [Text]
  }
  deriving ((forall x. PrettyInfo -> Rep PrettyInfo x)
-> (forall x. Rep PrettyInfo x -> PrettyInfo) -> Generic PrettyInfo
forall x. Rep PrettyInfo x -> PrettyInfo
forall x. PrettyInfo -> Rep PrettyInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrettyInfo -> Rep PrettyInfo x
from :: forall x. PrettyInfo -> Rep PrettyInfo x
$cto :: forall x. Rep PrettyInfo x -> PrettyInfo
to :: forall x. Rep PrettyInfo x -> PrettyInfo
Generic)

ifNotNull :: [x] -> ([x] -> a) -> Maybe a
ifNotNull :: forall x a. [x] -> ([x] -> a) -> Maybe a
ifNotNull [] [x] -> a
_ = Maybe a
forall a. Maybe a
Nothing
ifNotNull [x]
list [x] -> a
f = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [x] -> a
f [x]
list

reqOpt :: (Text, Bool) -> Text
reqOpt :: (Text, Bool) -> Text
reqOpt (Text
a, Bool
r) = Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
r then Text
"!" else Text
"?"

prettyInfoToText :: PrettyInfo -> Text
prettyInfoToText :: PrettyInfo -> Text
prettyInfoToText PrettyInfo{[(Text, Bool)]
[Text]
Text
$sel:path:PrettyInfo :: PrettyInfo -> [Text]
$sel:headers:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:queryParams:PrettyInfo :: PrettyInfo -> [(Text, Bool)]
$sel:request:PrettyInfo :: PrettyInfo -> [Text]
$sel:response:PrettyInfo :: PrettyInfo -> Text
$sel:method:PrettyInfo :: PrettyInfo -> Text
$sel:descriptions:PrettyInfo :: PrettyInfo -> [Text]
path :: [Text]
headers :: [(Text, Bool)]
queryParams :: [(Text, Bool)]
request :: [Text]
response :: Text
method :: Text
descriptions :: [Text]
..} =
  [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    Text
method Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"/" [Text]
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
" | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> ([Text] -> Text) -> Maybe Text
forall x a. [x] -> ([x] -> a) -> Maybe a
ifNotNull [Text]
descriptions (Text -> [Text] -> Text
Text.intercalate Text
"; "))
      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map
        (Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
        ( [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
            [ (Text
"Query params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Bool)] -> ([(Text, Bool)] -> Text) -> Maybe Text
forall x a. [x] -> ([x] -> a) -> Maybe a
ifNotNull [(Text, Bool)]
queryParams (Text -> [Text] -> Text
Text.intercalate Text
", " ([Text] -> Text)
-> ([(Text, Bool)] -> [Text]) -> [(Text, Bool)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Bool) -> Text) -> [(Text, Bool)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Bool) -> Text
reqOpt)
            , (Text
"Headers: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Bool)] -> ([(Text, Bool)] -> Text) -> Maybe Text
forall x a. [x] -> ([x] -> a) -> Maybe a
ifNotNull [(Text, Bool)]
headers (Text -> [Text] -> Text
Text.intercalate Text
", " ([Text] -> Text)
-> ([(Text, Bool)] -> [Text]) -> [(Text, Bool)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Bool) -> Text) -> [(Text, Bool)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Bool) -> Text
reqOpt)
            ]
            [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
request
            [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
Item [Text]
response]
        )