on develop help sign in
Re-enabling resource nesting
commit6cf3c41aac58931123d83f5692f89708c830212d authorBrendan Hay <brendan.g.hay@gmail.com> dateSat 26 Sep 2015, 07:07 (11 years ago) parent7ca7756
3 files changed+22−14
gen/src/Gen/AST.hs+15−9 gen/src/Gen/Solve.hs+2−2 gen/src/Gen/Types.hs+5−3
gen/src/Gen/AST.hs+15−9
@@ -52,9 +52,9 @@ runAST svc = evalState (runExceptT (render ss)) (initial (_svcSchemas ss))
5252
5353render :: Service (Schema Id) Resource -> AST (Service Data API)
5454render svc = do
55− x <- kvTraverseMaybe typ (_svcSchemas svc)
56− y <- Map.traverseWithKey api (_svcResources svc)
57− return $! svc { _svcSchemas = x, _svcResources = mempty }
55+ x <- kvTraverseMaybe typ (_svcSchemas svc)
56+ y <- api (_svcResources svc)
57+ return $! svc { _svcSchemas = x, _svcResources = y }
5858 where
5959 typ :: Id -> Schema Id -> AST (Maybe Data)
6060 typ k = \case
@@ -91,20 +91,26 @@ render svc = do
9191 "' with the minimum fields required to make a request.\n")
9292 k
9393
94− api :: Id -> Resource -> AST API
95− api k = fmap (API (aname k) . Map.fromList) . res k
94+ api :: Resource -> AST API
95+ api = fmap (API "API" . Map.fromList) . res Nothing
9696 where
97− res :: Id -> Resource -> AST [(Name, [Rendered])]
97+ res :: Maybe Id -> Resource -> AST [(Name, [Rendered])]
9898 res p = \case
9999 Parent rs -> traverse (parent p) (Map.toList rs) <&> concat
100− Sub ms -> traverse (sub p) (Map.toList ms)
100+ Sub ms | Just x <- p
101+ -> traverse (sub x) (Map.toList ms)
101102
102− parent :: Id -> (Local, Resource) -> AST [(Name, [Rendered])]
103− parent p (n, r) = res (mkProp p n) r
103+ parent :: Maybe Id -> (Local, Resource) -> AST [(Name, [Rendered])]
104+ parent p (n, r) = res (Just (pid p n)) r
104105
105106 sub :: Id -> (Local, Method) -> AST (Name, [Rendered])
106107 sub p (n, m) = (mname p n,) <$> traverse (pp None) (apiTypes svc p m)
107108
109+ -- FIXME: This breaks all naming invariants.
110+ pid :: Maybe Id -> Local -> Id
111+ pid Nothing = Free . Global . local
112+ pid (Just p) = mkProp p
113+
108114flatten :: Service (Fix Schema) Resource -> Service (Schema Id) Resource
109115flatten svc = svc { _svcSchemas = execState run mempty }
110116 where
gen/src/Gen/Solve.hs+2−2
@@ -137,7 +137,7 @@ derive k = loc "derive" k $ memo derived k go
137137 Obj _ rs -> foldM props base (Map.elems rs)
138138 Arr _ r -> mappend monoid . intersect base <$> derive r
139139 Enum {} -> pure enum
140− Ref _ r -> derive (Free r)
140+ Ref _ r -> pure base -- derive (Free r)
141141 Any _ -> pure base
142142 Lit _ l -> pure $
143143 case l of
@@ -231,4 +231,4 @@ acronymPrefixes (idToText -> n) = map CI.mk (xs ++ map suffix ys)
231231 r6 = Text.take limit <$> listToMaybe (splitWords a)
232232
233233loc :: String -> Id -> a -> a
234−loc n r = trace (n ++ ": " ++ Text.unpack (idToText r))
234+loc n r = id -- trace (n ++ ": " ++ Text.unpack (idToText r))
gen/src/Gen/Types.hs+5−3
@@ -369,8 +369,8 @@ data Resource
369369
370370instance FromJSON Resource where
371371 parseJSON = withObject "resource" $ \o ->
372− Parent <$> o .: "resources"
373− <|> Sub <$> o .: "methods"
372+ Sub <$> o .: "methods"
373+ <|> Parent <$> o .: "resources"
374374
375375data Service s r = Service
376376 { _svcLibrary :: Text
@@ -392,9 +392,11 @@ data Service s r = Service
392392 , _svcAuth :: Maybe Object
393393 , _svcParameters :: Map Local Param
394394 , _svcSchemas :: Map Id s
395− , _svcResources :: Map Id r
395+ , _svcResources :: r
396396 } deriving (Generic)
397397
398+Have to manually write the fromjson instance due to resources?
399+
398400deriveFromJSON (js "_svc") ''Service
399401
400402instance ToJSON (Service Data API) where