@@ -32,6 +32,7 @@ import Data.Semigroup ((<>))
3232import qualified Data.Text as Text
3333import qualified Data.Text.Lazy as LText
3434import qualified Data.Text.Lazy.Builder as Build
35+import Data.Traversable (for)
3536import Gen.Formatting
3637import Gen.Solve
3738import Gen.Syntax
@@ -67,69 +68,64 @@ render svc = do
6768 branch p v = Branch (bname p v) v
6869
6970 Obj i rs -> do
70− p <- prefix k
71− Just <$> (Map.traverseWithKey (const . solve . mkProp k) rs >>= prod p)
72− where
73− prod p ts = Prod (dname k) (i ^. description)
74− <$> (objDecl k p ts >>= pp Indent)
75− <*> ctor p ts
76− <*> traverse (lens p) (Map.toList ts)
77− <*> traverse (pp Print) (jsonDecls k p ts)
78−
79− ctor p ts = Fun' (cname k) (Just help)
80− <$> (pp None (ctorSig k ts) <&> comments ts)
81− <*> pp Indent (ctorDecl k p ts)
71+ p <- prefix k
72+ ds <- derive k
73+ dd <- Map.traverseWithKey (const . solve . mkProp k) rs
74+ Just <$> prod k p i ds dd
75+
76+ prod :: Id -> Pre -> Info -> [Derive] -> Map Local Solved -> AST Data
77+ prod k p i ds ts = Prod (dname k) (i ^. description)
78+ <$> pp Indent (objDecl k p ds ts)
79+ <*> ctor
80+ <*> traverse lens (Map.toList ts)
81+ <*> traverse (pp Print) (jsonDecls k p ts)
82+ where
83+ ctor = Fun' (cname k) (Just help)
84+ <$> (pp None (ctorSig k ts) <&> comments ts)
85+ <*> pp Indent (ctorDecl k p ts)
8286
83− lens p (l, v) = Fun' (lname p l) (v ^. description)
84− <$> pp None (lensSig k p l v)
85− <*> pp Print (lensDecl p l v)
87+ lens (l, v) = Fun' (lname p l) (v ^. description)
88+ <$> pp None (lensSig k p l v)
89+ <*> pp Print (lensDecl p l v)
8690
87− help = rawHelpText $
88− sformat ("Creates a value of '" % fid %
89− "' with the minimum fields required to make a request.\n")
90− k
91+ help = rawHelpText $
92+ sformat ("Creates a value of '" % fid %
93+ "' with the minimum fields required to make a request.\n")
94+ k
9195
9296 api :: Resource -> AST API
93− api x = API n <$> pp Print (apiAlias n (nouns x)) <*> top x
97+ api x = do
98+ as <- Map.fromList <$> top x
99+ API n <$> pp Print (apiAlias n (Map.keys as))
100+ <*> pure as
94101 where
95102 n = name (Text.unpack (svcAbbrev svc))
96103
97− nouns = map nname . \case
98− Top rs -> Map.keys rs
99− Sub ms -> Map.keys ms
100−
101− top :: Resource -> AST [Action]
102104 top = \case
103105 Top rs -> traverse (uncurry sub) (Map.toList rs) <&> concat
104106 Sub ms -> traverse (uncurry (verb "")) (Map.toList ms)
105107
106− sub :: Local -> Resource -> AST [Action]
107108 sub l = \case
108− t@(Top rs) -> do
109− let k = nname l
110− t <- Action k Nothing
111− <$> pp Print (apiAlias k (nouns t))
112− as <- traverse (uncurry sub) (Map.toList rs) <&> concat
113− return (t : as)
114−
115− Sub ms -> do
116− let k = nname l
117− t <- Action k Nothing
118− <$> pp Print (apiAlias k (map (vname l) $ Map.keys ms))
119− as <- traverse (uncurry (verb l)) (Map.toList ms)
120− return (t : as)
121−
122− verb :: Local -> Local -> Method -> AST Action
123− verb p l m = Action (vname p l) (_mDescription m)
124− <$> pp Print (verbDecl svc p l m)
109+ Top rs -> traverse (uncurry sub) (Map.toList rs) <&> concat
110+ Sub ms -> traverse (uncurry (verb l)) (Map.toList ms)
111+
112+ verb p l m = do
113+ let (k, i) = vname p l
114+ s <- solve i
115+ Just d <- typ i (_schema s)
116+ fmap (k,) $
117+ Action k (actionNS svc p l) (_mDescription m)
118+ <$> pp Print (verbAlias svc k m)
119+ <*> pure d
125120
126121flatten :: Service (Fix Schema) Resource -> Service (Schema Id) Resource
127122flatten svc = svc { _svcSchemas = execState run mempty }
128123 where
129− run = mapM_ (uncurry top) (Map.toList (_svcSchemas svc))
124+ run = mapM_ (uncurry sch) (Map.toList (_svcSchemas svc))
125+ >> api (_svcApi svc)
130126
131− top :: Id -> Fix Schema -> State (Map Id (Schema Id)) Id
132− top n (Fix f) = go f >>= ins n
127+ sch :: Id -> Fix Schema -> State (Map Id (Schema Id)) Id
128+ sch n (Fix f) = go f >>= ins n
133129 where
134130 go = \case
135131 Obj i ps -> Obj i <$> Map.traverseWithKey (prop n) ps
@@ -154,6 +150,22 @@ flatten svc = svc { _svcSchemas = execState run mempty }
154150
155151 this = mkProp n l
156152
153+ api :: Resource -> State (Map Id (Schema Id)) ()
154+ api = \case
155+ Top rs -> mapM_ (uncurry sub) (Map.toList rs)
156+ Sub ms -> mapM_ (uncurry (verb "")) (Map.toList ms)
157+ where
158+ sub l = \case
159+ Top rs -> mapM_ (uncurry sub) (Map.toList rs)
160+ Sub ms -> mapM_ (uncurry (verb l)) (Map.toList ms)
161+
162+ -- FIXME: Global parameters
163+ verb p l m = do
164+ let (_, i) = vname p l
165+ rs <- Map.traverseWithKey (\k v -> prop i k (paramSchema v)) (_mParameters m)
166+ void . ins i $
167+ Obj (Info (_mDescription m) Nothing False Nothing) rs
168+
157169 ins :: Id -> Schema Id -> State (Map Id (Schema Id)) Id
158170 ins n x = do
159171 s <- gets (Map.lookup n)