git.iko.soy/gogol
on develop help sign in
WIP
b38c700Brendan Hay
gen/annex/translate.json+1
compare with develop
unifiedsplit
@@ -1,3 +1,4 @@
1{
1{
2+ "library": "gozen-translate"
2}
3}
3
4
gen/src/Gen/AST.hs+78−30
@@ -42,11 +42,43 @@ import HIndent
42import Language.Haskell.Exts.Pretty
42import Language.Haskell.Exts.Pretty
43import Prelude hiding (sum)
43import Prelude hiding (sum)
44
44
45−-- mapM isn't lazy here and I don't care!
45+runAST :: Versions
46−flatten :: Map Id (Fix Schema) -> Map Id (Schema Id)
46+ -> [Service (Fix Schema) (Fix Schema) (Resource (Fix Schema))]
47−flatten m = execState (mapM_ (uncurry (prop Nothing)) (Map.toList m)) mempty
47+ -> Either Error [Library]
48+runAST v ss = merge v <$> evalState (runExceptT go) initial
48 where
49 where
49− -- unfold the properties.
50+ go = traverse (flatten >=> render) ss
51+
52+flatten :: Service (Fix Schema) (Fix Schema) (Resource (Fix Schema))
53+ -> AST (Service (Schema Id) (Schema Id) (Resource (Schema Id)))
54+flatten svc = do
55+ mapM_ (uncurry (prop Nothing)) (Map.toList (_svcSchemas svc))
56+ ss <- gets (view schemas)
57+ ps <- Map.traverseWithKey global (_svcParameters svc)
58+ rs <- Map.traverseWithKey resource (_svcResources svc)
59+ return $! svc { _svcSchemas = ss, _svcParameters = ps, _svcResources = rs }
60+ where
61+ resource :: Id -> Resource (Fix Schema) -> AST (Resource (Schema Id))
62+ resource k (Resource ms) = Resource <$> traverse go ms
63+ where
64+ go m = do
65+ ps <- Map.traverseWithKey (local k) (_mParameters m)
66+ return $! m { _mParameters = ps }
67+
68+ global = param (Just "param")
69+ local k = param (Just k)
70+
71+ param :: Maybe Id -> Id -> Param (Fix Schema) -> AST (Param (Schema Id))
72+ param p k (Param l m f) = do
73+ n <- prop p k f
74+ s <- schema n
75+ return $! Param l m s
76+
77+ -- unfold a schema property.
78+ prop :: Maybe Id
79+ -> Id
80+ -> Fix Schema
81+ -> AST Id
50 prop p k (Fix f) = case f of
82 prop p k (Fix f) = case f of
51 Obj i ps -> do
83 Obj i ps -> do
52 o <- Obj i <$> Map.traverseWithKey (prop (Just this)) ps
84 o <- Obj i <$> Map.traverseWithKey (prop (Just this)) ps
@@ -60,41 +92,26 @@ flatten m = execState (mapM_ (uncurry (prop Nothing)) (Map.toList m)) mempty
60 Lit i l -> res (Lit i l)
92 Lit i l -> res (Lit i l)
61 Ref _ r -> pure r
93 Ref _ r -> pure r
62 Any i -> res (Any i)
94 Any i -> res (Any i)
63−
64 where
95 where
65 res x = do
96 res x = do
66− s <- gets (Map.lookup this)
97+ s <- gets (Map.lookup this . view schemas)
67 case s of
98 case s of
68− Nothing -> modify (Map.insert this x) >> pure this
99+ Nothing -> (schemas %= Map.insert this x) >> pure this
69 -- FIXME:
100 -- FIXME:
70 Just e -> error $ "Already exists: " ++ show (this, e, x)
101 Just e -> error $ "Already exists: " ++ show (this, e, x)
71
102
72 this = maybe k (<> k) p
103 this = maybe k (<> k) p
73
104
74−merge :: Versions -> [Service Data] -> [Library]
105+render :: Service (Schema Id) (Schema Id) (Resource (Schema Id))
75−merge v = map go . groupBy (on (==) _svcLibrary)
106+ -> AST (Service Data Solved API)
76− where
107+render svc = do
77− go [x] = mk x
78− go (x:xs) = (mk x) { _libServices = x :| xs }
79− -- FIXME:
80− go [] = error "Empty merge set!"
81−
82− mk x = Library
83− { _libName = _svcLibrary x
84− , _libTitle = renameTitle (_svcTitle x)
85− , _libVersions = v
86− , _libServices = x :| []
87− }
88−
89−render :: Service (Fix Schema) -> Either Error (Service Data)
90−render s = runAST (Memo mempty mempty ss) $ do
91− r <- kvTraverseMaybe go ss
108+ x <- kvTraverseMaybe typ (_svcSchemas svc)
109+ y <- Map.traverseWithKey prm (_svcParameters svc)
110+ z <- Map.traverseWithKey (api y) (_svcResources svc)
92− return $! s { _svcSchemas = r }
111+ return $! svc { _svcSchemas = x, _svcParameters = y, _svcResources = z }
93 where
112 where
94− ss = flatten (_svcSchemas s)
95−
96− go :: Id -> Schema Id -> AST (Maybe Data)
113+ typ :: Id -> Schema Id -> AST (Maybe Data)
97− go k = \case
114+ typ k = \case
98 Arr {} -> pure Nothing
115 Arr {} -> pure Nothing
99 Ref {} -> pure Nothing
116 Ref {} -> pure Nothing
100 Any {} -> pure Nothing
117 Any {} -> pure Nothing
@@ -124,6 +141,37 @@ render s = runAST (Memo mempty mempty ss) $ do
124 "' with the minimum fields required to make a request.\n")
141 "' with the minimum fields required to make a request.\n")
125 k
142 k
126
143
144+Make param types lit only, and fail at json parse time?
145+Then avoid any solving/id memo steps.
146+
147+ prm :: Id -> Param (Schema Id) -> AST (Param Solved)
148+ prm r p = do
149+ let k = "param" <> r
150+ traverse (const (solve k)) p
151+
152+ api :: Map Id (Param Solved) -> Id -> Resource (Schema Id) -> AST API
153+ api cmn k (methods -> Map.toList -> ms) = do
154+ z <- Map.traverseWithKey (\n p -> traverse (const $ solve (k <> n)) p) (_mParameters y)
155+ API (aname k) <$>
156+ traverse (pp None) (apiTypes svc cmn x (y { _mParameters = z }))
157+ where
158+ (x, y) = head ms
159+
160+merge :: Versions -> [Service Data Solved API] -> [Library]
161+merge v = map go . groupBy (on (==) _svcLibrary)
162+ where
163+ go [x] = mk x
164+ go (x:xs) = (mk x) { _libServices = x :| xs }
165+ -- FIXME:
166+ go [] = error "Empty merge set!"
167+
168+ mk x = Library
169+ { _libName = _svcLibrary x
170+ , _libTitle = renameTitle (_svcTitle x)
171+ , _libVersions = v
172+ , _libServices = x :| []
173+ }
174+
127data PP
175data PP
128 = Indent
176 = Indent
129 | Print
177 | Print
gen/src/Gen/Solve.hs+5−36
@@ -35,52 +35,21 @@ import Prelude hiding (sum)
35-- Just use hashmaps to lookup refs etc, and hide all the mutation
35-- Just use hashmaps to lookup refs etc, and hide all the mutation
36-- behind a StateT interface.
36-- behind a StateT interface.
37
37
38−data TType
39− = TType Id
40− | TLit Lit
41− | TMaybe TType
42− | TEither TType TType
43− | TList TType
44−
45−data Derive
46− = DEq
47− | DOrd
48− | DRead
49− | DShow
50− | DEnum
51− | DNum
52− | DIntegral
53− | DReal
54− | DMonoid
55− | DIsString
56− | DData
57− | DTypeable
58− | DGeneric
59− deriving (Eq, Show)
60−
61data Memo = Memo
38data Memo = Memo
62 { _typed :: Map Id TType
39 { _typed :: Map Id TType
63 , _derived :: Map Id [Derive]
40 , _derived :: Map Id [Derive]
64 , _schemas :: Map Id (Schema Id)
41 , _schemas :: Map Id (Schema Id)
65 }
42 }
66
43
44+initial :: Memo
45+initial = Memo mempty mempty mempty
46+
67makeLenses ''Memo
47makeLenses ''Memo
68
48
69type AST = ExceptT Error (State Memo)
49type AST = ExceptT Error (State Memo)
70
50
71−data Solved = Solved
72− { _schema :: Schema Id
73− , _type :: TType
74− , _deriving :: [Derive]
75− }
76−
77−instance HasInfo Solved where
78− info = f . info
79− where
80− f = lens _schema (\s a -> s { _schema = a })
81−
82−runAST :: Memo -> AST a -> Either Error a
51+-- runAST :: AST a -> Either Error a
83−runAST s m = evalState (runExceptT m) s
52+-- runAST m = evalState (runExceptT m) initial
84
53
85schema :: Id -> AST (Schema Id)
54schema :: Id -> AST (Schema Id)
86schema k = do
55schema k = do
gen/src/Gen/Syntax.hs+34−13
@@ -17,6 +17,7 @@ import Control.Lens hiding (iso, mapping, op, strict)
17import Data.Foldable (foldr')
17import Data.Foldable (foldr')
18import qualified Data.HashMap.Strict as Map
18import qualified Data.HashMap.Strict as Map
19import Data.Maybe
19import Data.Maybe
20+import Data.Semigroup ((<>))
20import Data.String
21import Data.String
21import Data.Text (Text)
22import Data.Text (Text)
22import qualified Data.Text as Text
23import qualified Data.Text as Text
@@ -28,11 +29,38 @@ import Language.Haskell.Exts.Build
28import Language.Haskell.Exts.SrcLoc
29import Language.Haskell.Exts.SrcLoc
29import Language.Haskell.Exts.Syntax hiding (Int)
30import Language.Haskell.Exts.Syntax hiding (Int)
30
31
31−instance IsString Name where
32+instance IsString Name where fromString = name
32− fromString = name
33+instance IsString QName where fromString = UnQual . name
34+instance IsString QOp where fromString = op . sym
33
35
34−instance IsString QOp where
36+apiTypes :: Service s p r
35− fromString = op . name
37+ -> Map Id (Param Solved)
38+ -> Id
39+ -> Method Solved
40+ -> [Type]
41+apiTypes s qps r m = map sing ps ++ qs ++ [end]
42+ where
43+ ps = filter (not . Text.null)
44+ $ Text.split (== '/') (_svcServicePath s)
45+ <> Text.split (== '/') (_mPath m)
46+
47+ -- FIXME: order by _mParameterOrder
48+ qs = map param (Map.toList qps)
49+ ++ map param (Map.toList (_mParameters m))
50+
51+ param (k, Param l _ t) =
52+ -- FIXME: types, many/repeated
53+ case l of
54+ Path -> TyApp (TyApp (tycon "Capture") (sing (idToText k))) (external (_type t))
55+ Query -> TyApp (TyApp (tycon "QueryParam") (sing (idToText k))) (external (_type t))
56+
57+ end = TyApp (TyApp meth typ) res
58+
59+ meth = TyCon . unqual . Text.unpack $ Text.toTitle (_mMethod m)
60+ typ = tycon "'[JSON]"
61+ res = maybe (tycon "()") tycon (_mResponse m)
62+
63+ -- method (titlecase) '[JSON] (responsetype)
36
64
37objDecl :: Id -> Map Id Solved -> AST Decl
65objDecl :: Id -> Map Id Solved -> AST Decl
38objDecl r rs = DataDecl noLoc arity [] d [] [conDecl d rs] <$> derivings r
66objDecl r rs = DataDecl noLoc arity [] d [] [conDecl d rs] <$> derivings r
@@ -157,19 +185,12 @@ strict = TyBang BangedTy . \case
157 t@TyApp{} -> TyParen t
185 t@TyApp{} -> TyParen t
158 t -> t
186 t -> t
159
187
160−dname, cname, fname, lname, pname :: Id -> Name
188+sing :: Text -> Type
161−dname = name . ref upperHead
189+sing = TyCon . unqual . Text.unpack . flip mappend "\"" . mappend "\""
162−cname = name . ref (renameReserved . lowerHead)
163−fname = name . ref (Text.cons '_' . lowerHead)
164−lname = name . ref lowerHead
165−pname = name . ref (flip Text.snoc '_' . Text.cons 'p' . upperHead)
166
190
167tycon :: Id -> Type
191tycon :: Id -> Type
168tycon = TyCon . unqual . ref upperHead
192tycon = TyCon . unqual . ref upperHead
169
193
170−ref :: (Text -> Text) -> Id -> String
171−ref f = Text.unpack . f . idToText
172−
173unqual :: String -> QName
194unqual :: String -> QName
174unqual = UnQual . name
195unqual = UnQual . name
175
196
gen/src/Gen/Tree.hs−1
@@ -83,7 +83,6 @@ populate d Templates{..} l = (encodeString d :/) . dir lib <$> layout
83 , file "README.md" readmeTemplate
83 , file "README.md" readmeTemplate
84 ]
84 ]
85
85
86− service :: Service Data -> [DirTree (Either Error Touch)]
87 service s =
86 service s =
88 [ write $ module' (tocNS s) mempty tocTemplate (pure svc)
87 [ write $ module' (tocNS s) mempty tocTemplate (pure svc)
89 , dir (fromText (svcAbbrev s))
88 , dir (fromText (svcAbbrev s))
gen/src/Gen/Types.hs+75−32
@@ -36,7 +36,6 @@ import Data.Aeson hiding (Bool, String)
36import Data.Aeson.TH
36import Data.Aeson.TH
37import Data.Char
37import Data.Char
38import Data.Function (on)
38import Data.Function (on)
39−import qualified Data.HashMap.Strict as Map
40import Data.List.NonEmpty (NonEmpty (..))
39import Data.List.NonEmpty (NonEmpty (..))
41import qualified Data.List.NonEmpty as NE
40import qualified Data.List.NonEmpty as NE
42import Data.Maybe
41import Data.Maybe
@@ -72,11 +71,10 @@ toTextIgnore :: Path -> Text
72toTextIgnore = either id id . Path.toText
71toTextIgnore = either id id . Path.toText
73
72
74data Templates = Templates
73data Templates = Templates
75− { cabalTemplate :: Template
74+ { cabalTemplate :: Template
76− , tocTemplate :: Template
75+ , tocTemplate :: Template
77− , readmeTemplate :: Template
76+ , readmeTemplate :: Template
78− , operationTemplate :: Template
79− , typesTemplate :: Template
77+ , typesTemplate :: Template
80 }
78 }
81
79
82newtype Version (v :: Symbol) = Version Text
80newtype Version (v :: Symbol) = Version Text
@@ -127,6 +125,8 @@ specFromPath x = Spec n p v x
127 p = toTextIgnore (Path.parent (Path.parent x))
125 p = toTextIgnore (Path.parent (Path.parent x))
128 v = toTextIgnore (Path.dirname x)
126 v = toTextIgnore (Path.dirname x)
129
127
128+
129+
130data Protocol = REST
130data Protocol = REST
131 deriving (Eq, Show)
131 deriving (Eq, Show)
132
132
@@ -257,11 +257,14 @@ instance HasInfo (Schema a) where
257 Ref _ r -> Ref i r
257 Ref _ r -> Ref i r
258 Any {} -> Any i
258 Any {} -> Any i
259
259
260−data Param = Param Location -- (Fix Schema)
260+data Param a = Param !Location !Bool a
261+ deriving (Functor, Foldable, Traversable)
261
262
262−instance FromJSON Param where
263+instance FromJSON a => FromJSON (Param a) where
263− parseJSON = withObject "parameter" $ \o ->
264+ parseJSON = withObject "parameter" $ \o -> Param
265+ <$> o .: "location"
266+ <*> o .:? "repeated" .!= False
264− Param <$> o .: "location" -- <*> parseJSON (Object o)
267+ <*> parseJSON (Object o)
265
268
266deriveToJSON (js "") ''Param
269deriveToJSON (js "") ''Param
267
270
@@ -302,27 +305,71 @@ instance ToJSON Data where
302 , "lenses" .= ls
305 , "lenses" .= ls
303 ]
306 ]
304
307
308+
309+data TType
310+ = TType Id
311+ | TLit Lit
312+ | TMaybe TType
313+ | TEither TType TType
314+ | TList TType
315+
316+data Derive
317+ = DEq
318+ | DOrd
319+ | DRead
320+ | DShow
321+ | DEnum
322+ | DNum
323+ | DIntegral
324+ | DReal
325+ | DMonoid
326+ | DIsString
327+ | DData
328+ | DTypeable
329+ | DGeneric
330+ deriving (Eq, Show)
331+
332+data Solved = Solved
333+ { _schema :: Schema Id
334+ , _type :: TType
335+ , _deriving :: [Derive]
336+ }
337+
338+instance HasInfo Solved where
339+ info = f . info
340+ where
341+ f = lens _schema (\s a -> s { _schema = a })
342+
343+deriveToJSON (js "T") ''TType
344+deriveToJSON (js "D") ''Derive
345+deriveToJSON (js "_") ''Solved
346+
347+data API = API Name [Rendered]
348+
349+instance ToJSON API where
350+ toJSON (API n d) = object ["name" .= Syn n, "types" .= d]
351+
305−data Method = Method
352+data Method a = Method
306 { _mId :: Text
353 { _mId :: Text
307 , _mPath :: Text
354 , _mPath :: Text
308 , _mMethod :: Text
355 , _mMethod :: Text
309− , _mDescription :: Help
356+ , _mDescription :: Maybe Help
310− , _mParameters :: Map Id Param
357+ , _mParameters :: Map Id (Param a)
311 , _mParameterOrder :: [Id]
358 , _mParameterOrder :: [Id]
312 , _mScopes :: [Text]
359 , _mScopes :: [Text]
313 , _mRequest :: Maybe Id
360 , _mRequest :: Maybe Id
314 , _mResponse :: Maybe Id
361 , _mResponse :: Maybe Id
315 } deriving (Generic)
362 } deriving (Generic)
316
363
317−instance FromJSON Method where
364+instance FromJSON a => FromJSON (Method a) where
318 parseJSON = withObject "method" $ \o -> Method
365 parseJSON = withObject "method" $ \o -> Method
319 <$> o .: "id"
366 <$> o .: "id"
320 <*> o .: "path"
367 <*> o .: "path"
321 <*> o .: "httpMethod"
368 <*> o .: "httpMethod"
322− <*> o .: "description"
369+ <*> o .:? "description"
323 <*> o .: "parameters"
370 <*> o .: "parameters"
324 <*> o .:? "parameterOrder" .!= mempty
371 <*> o .:? "parameterOrder" .!= mempty
325− <*> o .: "scopes"
372+ <*> o .:? "scopes" .!= mempty
326 <*> ref o "request"
373 <*> ref o "request"
327 <*> ref o "response"
374 <*> ref o "response"
328 where
375 where
@@ -331,16 +378,11 @@ instance FromJSON Method where
331
378
332deriveToJSON (js "_m") ''Method
379deriveToJSON (js "_m") ''Method
333
380
334−newtype Resource = Resource { methods :: Map Id Method }
381+newtype Resource a = Resource { methods :: Map Id (Method a) }
335− deriving (ToJSON)
336
382
337deriveFromJSON (js "") ''Resource
383deriveFromJSON (js "") ''Resource
338
384
339−-- instance FromJSON Resource where
340−-- parseJSON = withObject "resource" $ \o ->
341−-- o .: "methods" -- <|> fail (show (Map.lookup "methods" o))
342−
343−data Service a = Service
385+data Service s p r = Service
344 { _svcLibrary :: Text
386 { _svcLibrary :: Text
345 , _svcTitle :: Text
387 , _svcTitle :: Text
346 , _svcName :: Text
388 , _svcName :: Text
@@ -358,39 +400,40 @@ data Service a = Service
358 , _svcServicePath :: Text
400 , _svcServicePath :: Text
359 , _svcBatchPath :: Text
401 , _svcBatchPath :: Text
360 , _svcAuth :: Maybe Object
402 , _svcAuth :: Maybe Object
361− , _svcParameters :: Map Id Param
403+ , _svcParameters :: Map Id (Param p)
362− , _svcSchemas :: Map Id a
404+ , _svcSchemas :: Map Id s
363− , _svcResources :: Map Id Resource
405+ , _svcResources :: Map Id r
364 } deriving (Generic)
406 } deriving (Generic)
365
407
366deriveFromJSON (js "_svc") ''Service
408deriveFromJSON (js "_svc") ''Service
367
409
368−instance ToJSON (Service Data) where
410+instance ToJSON p => ToJSON (Service Data p API) where
369 toJSON s = Object (x <> y)
411 toJSON s = Object (x <> y)
370 where
412 where
371 Object x = genericToJSON (js "_svc") s
413 Object x = genericToJSON (js "_svc") s
372 Object y = object
414 Object y = object
373 [ "exposedModules" .= exposedModules s
415 [ "exposedModules" .= exposedModules s
416+ , "api" .= Syn (aname (idFromText (_svcName s)))
374 ]
417 ]
375
418
376−svcAbbrev :: Service a -> Text
419+svcAbbrev :: Service s p r -> Text
377svcAbbrev = renameAbbrev . _svcTitle
420svcAbbrev = renameAbbrev . _svcTitle
378
421
379−typeImports :: Service a -> [NS]
422+typeImports :: Service s p r -> [NS]
380typeImports _ = ["Network.Google.Prelude"]
423typeImports _ = ["Network.Google.Prelude"]
381
424
382−tocNS, typesNS :: Service a -> NS
425+tocNS, typesNS :: Service s p r -> NS
383tocNS s = NS ["Network", "Google", svcAbbrev s]
426tocNS s = NS ["Network", "Google", svcAbbrev s]
384typesNS = (<> "Types") . tocNS
427typesNS = (<> "Types") . tocNS
385
428
386−exposedModules :: Service a -> [NS]
429+exposedModules :: Service s p r -> [NS]
387exposedModules s = [tocNS s, typesNS s]
430exposedModules s = [tocNS s, typesNS s]
388
431
389data Library = Library
432data Library = Library
390 { _libName :: Text
433 { _libName :: Text
391 , _libTitle :: Text
434 , _libTitle :: Text
392 , _libVersions :: Versions
435 , _libVersions :: Versions
393− , _libServices :: NonEmpty (Service Data)
436+ , _libServices :: NonEmpty (Service Data Solved API)
394 }
437 }
395
438
396instance ToJSON Library where
439instance ToJSON Library where
gen/src/Gen/Types/Id.hs+36−10
@@ -11,34 +11,60 @@
11
11
12module Gen.Types.Id
12module Gen.Types.Id
13 ( Id
13 ( Id
14+
15+ -- * Conversion
14 , idToText
16 , idToText
15 , idFromText
17 , idFromText
18+
19+ -- * Formatting
16 , fid
20 , fid
21+ , ref
22+
23+ -- * Syntax
24+ , aname
25+ , dname
26+ , cname
27+ , fname
28+ , lname
29+ , pname
17 ) where
30 ) where
18
31
19import Control.Applicative
32import Control.Applicative
20−import Control.Lens hiding ((.=))
33+import Control.Lens hiding ((.=))
21−import Data.Aeson hiding (Bool, String)
34+import Data.Aeson hiding (Bool, String)
22import Data.Aeson.TH
35import Data.Aeson.TH
23−import qualified Data.Attoparsec.Text as A
36+import qualified Data.Attoparsec.Text as A
24import Data.Bifunctor
37import Data.Bifunctor
25import Data.Char
38import Data.Char
26−import Data.Function (on)
39+import Data.Function (on)
27import Data.Hashable
40import Data.Hashable
28−import qualified Data.HashMap.Strict as Map
41+import qualified Data.HashMap.Strict as Map
29import Data.Maybe
42import Data.Maybe
30import Data.Ord
43import Data.Ord
31−import Data.Semigroup hiding (Sum)
44+import Data.Semigroup hiding (Sum)
32import Data.String
45import Data.String
33−import Data.Text (Text)
46+import Data.Text (Text)
34−import qualified Data.Text as Text
47+import qualified Data.Text as Text
35−import qualified Data.Text.Lazy as LText
48+import qualified Data.Text.Lazy as LText
36−import qualified Data.Text.Lazy.Builder as Build
49+import qualified Data.Text.Lazy.Builder as Build
37import Data.Text.Manipulate
50import Data.Text.Manipulate
38import Formatting
51import Formatting
39import Gen.Text
52import Gen.Text
40import Gen.Types.Map
53import Gen.Types.Map
41import GHC.Generics
54import GHC.Generics
55+import Language.Haskell.Exts.Build
56+import Language.Haskell.Exts.Syntax (Name)
57+
58+aname, dname, cname, fname, lname, pname :: Id -> Name
59+aname = name . ref upperHead
60+dname = name . ref upperHead
61+cname = name . ref (renameReserved . lowerHead)
62+fname = name . ref (Text.cons '_' . lowerHead)
63+lname = name . ref lowerHead
64+pname = name . ref (flip Text.snoc '_' . Text.cons 'p' . upperHead)
65+
66+ref :: (Text -> Text) -> Id -> String
67+ref f = Text.unpack . f . idToText
42
68
43data Id
69data Id
44 = Opaque [Text]
70 = Opaque [Text]
gen/src/Main.hs+1−2
@@ -135,7 +135,6 @@ main = do
135 <$> load "cabal.ede"
135 <$> load "cabal.ede"
136 <*> load "toc.ede"
136 <*> load "toc.ede"
137 <*> load "readme.ede"
137 <*> load "readme.ede"
138− <*> load "operation.ede"
139 <*> load "types.ede"
138 <*> load "types.ede"
140 <* lift done
139 <* lift done
141
140
@@ -159,7 +158,7 @@ main = do
159
158
160 return s
159 return s
161
160
162− libs <- merge _optVersions <$> traverse (hoistEither . render) svcs
161+ libs <- hoistEither (runAST _optVersions svcs)
163
162
164 void . counter "library" libs $ \l -> do
163 void . counter "library" libs $ \l -> do
165 say ("Creating " % stext % " package.") (_libTitle l)
164 say ("Creating " % stext % " package.") (_libTitle l)
gen/template/operation.ededeleted

No changes to the content.

gen/template/toc.ede+21−1
@@ -6,11 +6,16 @@
6module {{ moduleName }}
6module {{ moduleName }}
7 (
7 (
8 -- * API Definition
8 -- * API Definition
9+ {{ api }}
9− {{ name | lowerHead }}
10+ , {{ api | lowerHead }}API
10
11
11 -- * Resources
12 -- * Resources
12 -- $resources
13 -- $resources
13
14
15+ {% for resource in resources %}
16+ , {{ resource.value.name }}
17+ {% endfor %}
18+
14 -- * Types
19 -- * Types
15 {% for schema in schemas %}
20 {% for schema in schemas %}
16 {% case schema.value.type %}
21 {% case schema.value.type %}
@@ -39,3 +44,18 @@ import {{ module.value }}
39{- $resources
44{- $resources
40TODO
45TODO
41-}
46-}
47+
48+type {{ api }} =
49+{% for resource in resources %}
50+ {% if resource.first %} {% else %}:<|>{% endif %} {{ resource.value.name }}
51+{% endfor %}
52+
53+{{ api | lowerHead }}API :: Proxy {{ api }}
54+{{ api | lowerHead }}API = Proxy
55+{% for resource in resources %}
56+
57+type {{ resource.value.name }} =
58+ {% for type in resource.value.types %}
59+ {% if type.first %} {% else %}:>{% endif %} {{ type.value }}
60+ {% endfor %}
61+{% endfor %}