@@ -18,7 +18,8 @@ module Gen.Types
1818 , module Gen.Types.NS
1919 ) where
2020
21−import Data.Aeson
21+import Control.Applicative
22+import Data.Aeson hiding (String)
2223import Data.Aeson.TH
2324import qualified Data.Attoparsec.Text as A
2425import Data.Char
@@ -117,6 +118,66 @@ instance FromJSON Protocol where
117118instance ToJSON Protocol where
118119 toJSON = toJSON . map toLower . show
119120
121+data Location
122+ = Query
123+ | Path
124+ deriving (Eq, Show)
125+
126+deriveJSON (js "") ''Location
127+
128+data Info = Info
129+ { _infoDescription :: Maybe Text
130+ , _infoDefault :: Maybe Text
131+ } deriving (Eq, Show)
132+
133+deriveJSON (js "_info") ''Info
134+
135+data Lit
136+ = String
137+ | Boolean
138+ deriving (Eq, Show)
139+
140+deriveToJSON (js "") ''Lit
141+
142+data Schema
143+ = Obj Info (Map Text Schema)
144+ | Arr Info Schema
145+ | Enum Info [Text] [Text]
146+ | Lit Info Lit
147+ | Ref Text
148+ | Any' -- String or Number
149+ deriving (Eq, Show)
150+
151+instance FromJSON Schema where
152+ parseJSON = withObject "schema" $ \o -> schema o <|> ref o
153+ where
154+ schema o = do
155+ i <- parseJSON (Object o)
156+ t <- o .: "type" -- <|> fail ("Missing 'type' in " ++ show o)
157+ case t of
158+ "object" -> Obj i <$> o .: "properties"
159+ "array" -> Arr i <$> o .: "items"
160+ "string" -> enum i o <|> pure (Lit i String)
161+ "boolean" -> pure (Lit i Boolean)
162+ "any" -> pure Any'
163+ _ -> fail $
164+ "Unable to parse Schema from: '" ++ Text.unpack t ++ "'"
165+
166+ enum i o = Enum i <$> o .: "enum" <*> o .: "enumDescriptions"
167+
168+ ref o = Ref <$> o .: "$ref"
169+
170+deriveToJSON (js "") ''Schema
171+
172+data Param = Param Location Schema
173+ deriving (Eq, Show)
174+
175+instance FromJSON Param where
176+ parseJSON = withObject "parameter" $ \o ->
177+ Param <$> o .: "location" <*> parseJSON (Object o)
178+
179+deriveToJSON (js "") ''Param
180+
120181data Service = Service
121182 { _svcLibrary :: Text
122183 , _svcTitle :: Text
@@ -134,9 +195,10 @@ data Service = Service
134195 , _svcRootUrl :: Text
135196 , _svcServicePath :: Text
136197 , _svcBatchPath :: Text
137− , _svcParameters :: Object
138198 , _svcAuth :: Maybe Object
139− , _svcSchemas :: Object
199+ , _svcParameters :: Map Text Param
200+ , _svcSchemas :: Map Text Schema
201+ , _svcResources :: Object
140202 } deriving (Show, Generic)
141203
142204deriveFromJSON (js "_svc") ''Service