git.iko.soy/typeable/swagger2
on master help sign in
typeable/swagger2/examples/hackage.hs
86 lines 2.6 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
16import Data.Swagger.Operation
18type Username = Text
20data UserSummary = UserSummary
21 { summaryUsername :: Username
22 , summaryUserid :: Int
23 } deriving (Generic)
25instance ToSchema UserSummary where
26 declareNamedSchema _ = do
27 usernameSchema <- declareSchemaRef (Proxy :: Proxy Username)
28 useridSchema <- declareSchemaRef (Proxy :: Proxy Int)
29 return $ NamedSchema (Just "UserSummary") $ mempty
30 & type_ ?~ SwaggerObject
31 & properties .~
32 [ ("summaryUsername", usernameSchema )
33 , ("summaryUserid" , useridSchema )
34 ]
35 & required .~ [ "summaryUsername"
36 , "summaryUserid" ]
39type Group = Text
41data UserDetailed = UserDetailed
42 { username :: Username
43 , userid :: Int
44 , groups :: [Group]
45 } deriving (Generic, ToSchema)
47newtype Package = Package { packageName :: Text }
48 deriving (Generic, ToSchema)
50hackageSwagger :: Swagger
51hackageSwagger = spec & definitions .~ defs
52 where
53 (defs, spec) = runDeclare declareHackageSwagger mempty
55declareHackageSwagger :: Declare (Definitions Schema) Swagger
56declareHackageSwagger = do
57 -- param schemas
58 let usernameParamSchema = toParamSchema (Proxy :: Proxy Username)
60 -- responses
61 userSummaryResponse <- declareResponse (Proxy :: Proxy UserSummary)
62 userDetailedResponse <- declareResponse (Proxy :: Proxy UserDetailed)
63 packagesResponse <- declareResponse (Proxy :: Proxy [Package])
65 return $ mempty
66 & paths .~
67 [ ("/users", mempty & get ?~ (mempty
68 & produces ?~ MimeList ["application/json"]
69 & at 200 ?~ Inline userSummaryResponse))
70 , ("/user/{username}", mempty & get ?~ (mempty
71 & produces ?~ MimeList ["application/json"]
72 & parameters .~ [ Inline $ mempty
73 & name .~ "username"
74 & required ?~ True
75 & schema .~ ParamOther (mempty
76 & in_ .~ ParamPath
77 & paramSchema .~ usernameParamSchema) ]
78 & at 200 ?~ Inline userDetailedResponse))
79 , ("/packages", mempty & get ?~ (mempty
80 & produces ?~ MimeList ["application/json"]
81 & at 200 ?~ Inline packagesResponse))
82 ]
84main :: IO ()
85main = putStrLn . read . show . encode $ hackageSwagger