git.iko.soy/gogol
on develop help sign in
Parsing basic schema type
78639e1Brendan Hay
gen/src/Gen/Tree.hs−1
compare with develop
unifiedsplit
@@ -36,7 +36,6 @@ import qualified Data.Text as Text
36import qualified Data.Text.Lazy as LText
36import qualified Data.Text.Lazy as LText
37import Filesystem.Path.CurrentOS hiding (FilePath, root)
37import Filesystem.Path.CurrentOS hiding (FilePath, root)
38import Gen.Formatting (failure, shown)
38import Gen.Formatting (failure, shown)
39−import Gen.Import
40import qualified Gen.JSON as JS
39import qualified Gen.JSON as JS
41import Gen.Types
40import Gen.Types
42import Prelude hiding (mod)
41import Prelude hiding (mod)
gen/src/Gen/Types.hs+65−3
@@ -18,7 +18,8 @@ module Gen.Types
18 , module Gen.Types.NS
18 , module Gen.Types.NS
19 ) where
19 ) where
20
20
21+import Control.Applicative
21−import Data.Aeson
22+import Data.Aeson hiding (String)
22import Data.Aeson.TH
23import Data.Aeson.TH
23import qualified Data.Attoparsec.Text as A
24import qualified Data.Attoparsec.Text as A
24import Data.Char
25import Data.Char
@@ -117,6 +118,66 @@ instance FromJSON Protocol where
117instance ToJSON Protocol where
118instance ToJSON Protocol where
118 toJSON = toJSON . map toLower . show
119 toJSON = toJSON . map toLower . show
119
120
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+
120data Service = Service
181data Service = Service
121 { _svcLibrary :: Text
182 { _svcLibrary :: Text
122 , _svcTitle :: Text
183 , _svcTitle :: Text
@@ -134,9 +195,10 @@ data Service = Service
134 , _svcRootUrl :: Text
195 , _svcRootUrl :: Text
135 , _svcServicePath :: Text
196 , _svcServicePath :: Text
136 , _svcBatchPath :: Text
197 , _svcBatchPath :: Text
137− , _svcParameters :: Object
138 , _svcAuth :: Maybe Object
198 , _svcAuth :: Maybe Object
199+ , _svcParameters :: Map Text Param
139− , _svcSchemas :: Object
200+ , _svcSchemas :: Map Text Schema
201+ , _svcResources :: Object
140 } deriving (Show, Generic)
202 } deriving (Show, Generic)
141
203
142deriveFromJSON (js "_svc") ''Service
204deriveFromJSON (js "_svc") ''Service