@@ -0,0 +1,70 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE DeriveAnyClass #-}
3+{-# LANGUAGE OverloadedLists #-}
4+{-# LANGUAGE OverloadedStrings #-}
5+module Main where
6+
7+import Control.Lens
8+import Data.Aeson
9+import Data.Proxy
10+import Data.Text (Text)
11+import GHC.Generics
12+
13+import Data.Swagger
14+import Data.Swagger.Declare
15+import Data.Swagger.Lens
16+
17+type Username = Text
18+
19+data UserSummary = UserSummary
20+ { summaryUsername :: Username
21+ , summaryUserid :: Int
22+ } deriving (Generic, ToSchema)
23+
24+type Group = Text
25+
26+data UserDetailed = UserDetailed
27+ { username :: Username
28+ , userid :: Int
29+ , groups :: [Group]
30+ } deriving (Generic, ToSchema)
31+
32+newtype Package = Package { packageName :: Text }
33+ deriving (Generic, ToSchema)
34+
35+hackageSwagger :: Swagger
36+hackageSwagger = spec & definitions .~ defs
37+ where
38+ (defs, spec) = runDeclare declareHackageSwagger mempty
39+
40+declareHackageSwagger :: Declare Definitions Swagger
41+declareHackageSwagger = 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+ ]
67+
68+main :: IO ()
69+main = putStrLn . read . show . encode $ hackageSwagger
70+