git.iko.soy/typeable/swagger2
on v1.1 help sign in
typeable/swagger2/examples/hackage.hs
70 lines 2.5 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveAnyClass #-}
3{-# LANGUAGE OverloadedLists #-}
4{-# LANGUAGE OverloadedStrings #-}
5module Main where
7import Control.Lens
8import Data.Aeson
9import Data.Proxy
10import Data.Text (Text)
11import GHC.Generics
13import Data.Swagger
14import Data.Swagger.Declare
15import Data.Swagger.Lens
17type Username = Text
19data UserSummary = UserSummary
20 { summaryUsername :: Username
21 , summaryUserid :: Int
22 } deriving (Generic, ToSchema)
24type Group = Text
26data UserDetailed = UserDetailed
27 { username :: Username
28 , userid :: Int
29 , groups :: [Group]
30 } deriving (Generic, ToSchema)
32newtype Package = Package { packageName :: Text }
33 deriving (Generic, ToSchema)
35hackageSwagger :: Swagger
36hackageSwagger = spec & definitions .~ defs
37 where
38 (defs, spec) = runDeclare declareHackageSwagger mempty
40declareHackageSwagger :: Declare Definitions Swagger
41declareHackageSwagger = do
42 let usernameParamSchema = toParamSchema (Proxy :: Proxy Username)
43 userSummarySchemaRef <- declareSchemaRef (Proxy :: Proxy UserSummary)
44 userDetailedSchemaRef <- declareSchemaRef (Proxy :: Proxy UserDetailed)
45 packagesSchemaRef <- declareSchemaRef (Proxy :: Proxy [Package])
46 return $ mempty
47 & paths.pathsMap .~
48 [ ("/users", mempty & pathItemGet ?~ (mempty
49 & operationProduces ?~ MimeList ["application/json"]
50 & operationResponses .~ (mempty
51 & responsesResponses . at 200 ?~ Inline (mempty & responseSchema ?~ userSummarySchemaRef))))
52 , ("/user/{username}", mempty & pathItemGet ?~ (mempty
53 & operationProduces ?~ MimeList ["application/json"]
54 & operationParameters .~ [ Inline $ mempty
55 & paramName .~ "username"
56 & paramRequired ?~ True
57 & paramSchema .~ ParamOther (mempty
58 & paramOtherSchemaIn .~ ParamPath
59 & paramOtherSchemaParamSchema .~ usernameParamSchema) ]
60 & operationResponses .~ (mempty
61 & responsesResponses . at 200 ?~ Inline (mempty & responseSchema ?~ userDetailedSchemaRef))))
62 , ("/packages", mempty & pathItemGet ?~ (mempty
63 & operationProduces ?~ MimeList ["application/json"]
64 & operationResponses .~ (mempty
65 & responsesResponses . at 200 ?~ Inline (mempty & responseSchema ?~ packagesSchemaRef))))
66 ]
68main :: IO ()
69main = putStrLn . read . show . encode $ hackageSwagger