git.iko.soy/gogol
on develop help sign in
Re-namespacing all REST methods based on their respective ids
commit2e330366855af38dad628690e0da834f40468f0e authorBrendan Hay <brendan.g.hay@gmail.com> dateMon 28 Sep 2015, 17:17 (11 years ago) parentfff7443
17 files changed+126−60
compare with develop
unifiedsplit
gen/annex/admin/datatransfer.json+1−1 gen/annex/admin/directory.json+1−1 gen/annex/admin/email_migration.json+1−1 gen/annex/admin/reports.json+1−1 gen/annex/replicapool.json+2−2 gen/annex/replicapoolupdater.json+2−2 gen/annex/resourceviews.json+2−2 gen/annex/youtubeanalytics.json+1−1 gen/src/Gen/AST.hs+36−16 gen/src/Gen/Syntax.hs+29−17 gen/src/Gen/Text.hs+1 gen/src/Gen/Types.hs+18−7 gen/src/Gen/Types/Id.hs+5−5 gen/src/Gen/Types/NS.hs+1 gen/template/action.ede+10−2 gen/template/toc.ede+6−1 gen/template/types.ede+9−1
gen/annex/admin/datatransfer.json+1−1
@@ -1,5 +1,5 @@
11{
2− "library": "admin",
2+ "library": "admin-datatransfer",
33 "canonicalName": "Admin.DataTransfer"
44}
55
gen/annex/admin/directory.json+1−1
@@ -1,5 +1,5 @@
11{
2− "library": "admin",
2+ "library": "admin-directory",
33 "canonicalName": "Admin.Directory"
44}
55
gen/annex/admin/email_migration.json+1−1
@@ -1,5 +1,5 @@
11{
2− "library": "admin",
2+ "library": "admin-emailmigration",
33 "canonicalName": "Admin.EmailMigration"
44}
55
gen/annex/admin/reports.json+1−1
@@ -1,5 +1,5 @@
11{
2− "library": "admin",
2+ "library": "admin-reports",
33 "canonicalName": "Admin.Reports"
44}
55
gen/annex/replicapool.json+2−2
@@ -1,4 +1,4 @@
11{
2− "library": "compute-instancegroups-manager",
3− "canonicalName": "Compute.InstanceGroups.Manager"
2+ "library": "instancegroups-manager",
3+ "canonicalName": "InstanceGroups.Manager"
44}
gen/annex/replicapoolupdater.json+2−2
@@ -1,5 +1,5 @@
11{
2− "library": "compute-instancegroups-updater",
3− "canonicalName": "Compute.InstanceGroups.Updater"
2+ "library": "instancegroups-updater",
3+ "canonicalName": "InstanceGroups.Updater"
44}
55
gen/annex/resourceviews.json+2−2
@@ -1,5 +1,5 @@
11{
2− "library": "compute-instancegroups",
3− "canonicalName": "Compute.InstanceGroups"
2+ "library": "instancegroups",
3+ "canonicalName": "InstanceGroups"
44}
55
gen/annex/youtubeanalytics.json+1−1
@@ -1,5 +1,5 @@
11{
22 "library": "youtube-analytics",
3− "canonicalName": "YouTube.Analytics"
3+ "canonicalName": "YouTubeAnalytics"
44}
55
gen/src/Gen/AST.hs+36−16
@@ -52,7 +52,12 @@ render :: Typed -> AST Printed
5252render svc = do
5353 x <- traverse typ (_svcSchemas svc)
5454 y <- api (_svcApi svc)
55− return $! svc { _svcSchemas = catMaybes x, _svcParameters = (), _svcApi = y }
55+
56+ let as = map actionTypeName (Map.elems (_apiActions y))
57+ f d = elem (dataName d) as
58+ z = filter (not . f) (catMaybes x)
59+
60+ return $! svc { _svcSchemas = z, _svcParameters = (), _svcApi = y }
5661 where
5762 typ :: Solved -> AST (Maybe Data)
5863 typ Solved{..} = case _schema of
@@ -94,31 +99,46 @@ render svc = do
9499 as <- Map.fromList <$> top x
95100 API n <$> pp Print (apiAlias n (Map.keys as))
96101 <*> pure as
102+ <*> url
97103 where
98− n = name (Text.unpack (svcAbbrev svc))
104+ n = name (Text.unpack (svcAbbrev svc))
105+ un = name (Text.unpack (svcURL svc))
106+
107+ url = Fun' un (Just (rawHelpText h))
108+ <$> pp None (urlSig un)
109+ <*> pp Print url
110+ where
111+ url | "http://" `Text.isPrefixOf` u = urlDecl un "Http" u 80
112+ | otherwise = urlDecl un "Https" u 443
113+
114+ u = _svcBaseUrl svc
115+
116+ h = sformat ("URL referring to version @" % stext %
117+ "@ of the " % stext % ".")
118+ (_svcVersion svc) (_svcTitle svc)
99119
100120 top = \case
101− Top rs -> traverse (uncurry sub) (Map.toList rs) <&> concat
102− Sub ms -> traverse (uncurry (verb "")) (Map.toList ms)
121+ Top rs -> traverse (uncurry sub) (Map.toList rs) <&> concat
122+ Sub ms -> traverse (uncurry verb) (Map.toList ms)
103123
104124 sub l = \case
105− Top rs -> traverse (uncurry sub) (Map.toList rs) <&> concat
106− Sub ms -> traverse (uncurry (verb l)) (Map.toList ms)
125+ Top rs -> traverse (uncurry sub) (Map.toList rs) <&> concat
126+ Sub ms -> traverse (uncurry verb) (Map.toList ms)
107127
108− verb p l m = do
109− let (k, i) = vname p l
128+ verb l m = do
129+ let (k, i, ns) = vname (_mId m)
110130 s <- solve i
111131 Just d <- typ s
112132 fmap (k,) $
113− Action k (apretty p l) (actionNS svc p l) (_mDescription m)
114− <$> pp Print (verbAlias svc k m)
115− <*> reset m s d
133+ Action k (_mId m) (actionNS ns) (_mDescription m)
134+ <$> pp Print (verbAlias k m)
135+ <*> reset k m s d
116136
117− reset m s = \case
137+ reset k m s = \case
118138 d@Sum {} -> pure d
119139 Prod n' h r c ls _ ->
120140 Prod n' h r c ls . (:[]) <$> pp Print
121− (requestDecl (_ident s) (_prefix s) (fields (_schema s))
141+ (requestDecl (_ident s) (_prefix s) k un (fields (_schema s))
122142 (fmap Free (_mResponse m)))
123143
124144 fields = \case
@@ -181,7 +201,7 @@ flatten svc = do
181201 Sub ms -> Sub <$> Map.traverseWithKey (verb l) ms
182202
183203 verb p l m = do
184− let (_, i) = vname p l
204+ let (_, i, _) = vname (_mId m)
185205 rs <- Map.traverseWithKey (prm i) (_mParameters m)
186206 _ <- ins i $
187207 Obj (Info (_mDescription m) Nothing False Nothing) (Map.map _prmSchema (rs <> qs))
@@ -192,9 +212,9 @@ flatten svc = do
192212 ms <- uses schemas (Map.lookup n)
193213 case ms of
194214 Just y | x /= y -> throwError $
195− format ("Schema exists: " % fid %
215+ format ("Schema exists: " % stext % " - " % fid %
196216 "\nCurrent: " % shown % "\nTried: " % shown)
197− n y x
217+ (_svcCanonicalName svc) n y x
198218 _ -> schemas %= Map.insert n x
199219
200220 return n
gen/src/Gen/Syntax.hs+29−17
@@ -31,6 +31,14 @@ import Language.Haskell.Exts.Build
3131import Language.Haskell.Exts.SrcLoc
3232import Language.Haskell.Exts.Syntax hiding (Int, Lit)
3333
34+urlSig :: Name -> Decl
35+urlSig n = TypeSig noLoc [n] (tycon "BaseUrl")
36+
37+urlDecl :: Name -> String -> Text -> Integer -> Decl
38+urlDecl n s u p = sfun noLoc n [] (UnGuardedRhs rhs) noBinds
39+ where
40+ rhs = appFun (var "BaseUrl") [var (name s), str u, intE p]
41+
3442 -- type API = :<|> ...
3543apiAlias :: Name -> [Name] -> Decl
3644apiAlias n ls = TypeDecl noLoc n [] alias
@@ -40,8 +48,8 @@ apiAlias n ls = TypeDecl noLoc n [] alias
4048 x:xs -> foldl' (\l r -> TyInfix l (UnQual (sym ":<|>")) r) x xs
4149
4250-- type Method = :> ...
43−verbAlias :: Typed -> Name -> Method Solved -> Decl
44−verbAlias s n m = TypeDecl noLoc n [] alias
51+verbAlias :: Name -> Method Solved -> Decl
52+verbAlias n m = TypeDecl noLoc n [] alias
4553 where
4654 alias = foldr' (\l r -> TyInfix l (UnQual (sym ":>")) r) verb (path ++ qry)
4755
@@ -51,8 +59,7 @@ verbAlias s n m = TypeDecl noLoc n [] alias
5159 path :: [Type]
5260 path = map match
5361 . filter (not . Text.null)
54− $ Text.split (== '/') (_svcServicePath s)
55− <> Text.split (== '/') (_mPath m)
62+ $ Text.split (== '/') (_mPath m)
5663 where
5764 -- FIXME: should error if '{' '}' is found and cannot find the ref.
5865 match x
@@ -87,8 +94,8 @@ verbAlias s n m = TypeDecl noLoc n [] alias
8794 typ = tycon "'[JSON]"
8895 res = maybe (tycon "()") (tycon . Free) (_mResponse m)
8996
90−requestDecl :: Id -> Pre -> [Local] -> Maybe Id -> Decl
91−requestDecl n p fs r =
97+requestDecl :: Id -> Pre -> Name -> Name -> [Local] -> Maybe Id -> Decl
98+requestDecl n p api url fs rq =
9299 -- FIXME: associated Rs type
93100 InstDecl noLoc Nothing [] [] (unqual "GoogleRequest") [tycon n]
94101 [ response
@@ -97,23 +104,28 @@ requestDecl n p fs r =
97104 ]
98105 where
99106 response = InsType noLoc (TyApp (tycon "Rs") (tycon n)) $
100− maybe unit_tycon tycon r
107+ maybe unit_tycon tycon rq
101108
102109 request = funD "request" $
103− appFun (var "requestWithRoute") [var "defReq", var "serviceURL"]
110+ appFun (var "requestWithRoute") [var "defReq", var url]
104111
105− requestWithRoute =
106− InsDecl (FunBind [match "requestWithRoute" e])
112+ requestWithRoute = InsDecl (FunBind [match])
107113 where
108− e = appFun (var "clientWithRoute") $
109− [ ExpTypeSig noLoc (var "Proxy") (TyApp (tycon "Proxy") (tycon n))
110− , var "r"
111− , var "u"
112− ] ++ map (var . fname p) fs
114+ match = Match noLoc (name "requestWithRoute") pats Nothing rhs decls
115+
116+ decls = BDecls
117+ [ patBind noLoc (pvar "go") $
118+ appFun (var "clientWithRoute") $
119+ [ ExpTypeSig noLoc (var "Proxy") $
120+ TyApp (tycon "Proxy") (TyCon (UnQual api))
121+ , var "r"
122+ , var "u"
123+ ]
124+ ]
113125
114− match f e = Match noLoc (name f) pats Nothing (UnGuardedRhs e) noBinds
126+ rhs = UnGuardedRhs . appFun (var "go") $ map (var . fname p) fs
115127
116− pats = [prec, pvar "r", pvar "u"]
128+ pats = [pvar "r", pvar "u", prec]
117129 prec = PRec (UnQual (dname n)) [PFieldWildcard]
118130
119131jsonDecls :: Id -> Pre -> Map Local Solved -> [Decl]
gen/src/Gen/Text.hs+1
@@ -191,6 +191,7 @@ upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs
191191 , ("Lt$", "LT")
192192 , ("Gt$", "GT")
193193 , ("Nat", "NAT")
194+ , ("Youtube", "YouTube")
194195 ]
195196
196197acronyms :: [(String, String)]
gen/src/Gen/Types.hs+18−7
@@ -373,6 +373,11 @@ instance ToJSON Data where
373373 , "instances" .= is
374374 ]
375375
376+dataName :: Data -> Name
377+dataName = \case
378+ Sum n _ _ -> n
379+ Prod n _ _ _ _ _ -> n
380+
376381data Action = Action
377382 { _actName :: Name
378383 , _actPrettyName :: Text
@@ -382,6 +387,9 @@ data Action = Action
382387 , _actData :: Data
383388 }
384389
390+actionTypeName :: Action -> Name
391+actionTypeName = dataName . _actData
392+
385393instance ToJSON Action where
386394 toJSON Action {..} = object
387395 [ "name" .= Syn _actName
@@ -396,6 +404,7 @@ data API = API
396404 { _apiName :: Name
397405 , _apiDecl :: Rendered
398406 , _apiActions :: Map Name Action
407+ , _apiURL :: Fun
399408 }
400409
401410instance ToJSON API where
@@ -403,6 +412,7 @@ instance ToJSON API where
403412 [ "name" .= Syn _apiName
404413 , "decl" .= _apiDecl
405414 , "actions" .= sortOn _actName (Map.elems _apiActions)
415+ , "url" .= _apiURL
406416 ]
407417
408418data Method a = Method
@@ -504,17 +514,18 @@ type Flattened = Service [Id] [Param Id] (Resource Id)
504514type Typed = Service [Solved] [Param Solved] (Resource Solved)
505515type Printed = Service [Data] () API
506516
507−svcAbbrev :: Service s p r -> Text
517+svcAbbrev, svcURL :: Service s p r -> Text
508518svcAbbrev = upperHead . renameAbbrev . _svcCanonicalName
519+svcURL = (<> "URL") . lowerHead . svcAbbrev
509520
510521svcActions :: Service s p API -> [Action]
511522svcActions = Map.elems . _apiActions . _svcApi
512523
513524typeImports, prodImports, sumImports, actionImports :: Service s p r -> [NS]
514−typeImports s = sort ["Network.Google.Prelude", prodNS s, sumNS s]
515−prodImports s = sort ["Network.Google.Prelude", sumNS s]
516−sumImports _ = sort ["Network.Google.Prelude"]
517−actionImports = typeImports
525+typeImports s = sort ["Network.Google.Prelude", prodNS s, sumNS s]
526+prodImports s = sort ["Network.Google.Prelude", sumNS s]
527+sumImports _ = sort ["Network.Google.Prelude"]
528+actionImports s = sort ["Network.Google.Prelude", typesNS s]
518529
519530tocNS, typesNS, prodNS, sumNS :: Service s p r -> NS
520531tocNS s = NS $ "Network" : "Google" : Text.split (== '.') (_svcCanonicalName s)
@@ -522,8 +533,8 @@ typesNS = (<> "Types") . tocNS
522533prodNS = (<> "Product") . typesNS
523534sumNS = (<> "Sum") . typesNS
524535
525−actionNS :: Service s p r -> Local -> Local -> NS
526−actionNS s x y = tocNS s <> NS [upperHead (local x), upperHead (local y)]
536+actionNS :: [Text] -> NS
537+actionNS = mappend (NS ["Network", "Google", "API"]) . NS
527538
528539exposedModules :: Service s p API -> [NS]
529540exposedModules s = sort (tocNS s : typesNS s : map _actNS (svcActions s))
gen/src/Gen/Types/Id.hs+5−5
@@ -42,12 +42,12 @@ import Language.Haskell.Exts.Build
4242import Language.Haskell.Exts.Pretty (prettyPrint)
4343import Language.Haskell.Exts.Syntax (Name)
4444
45−vname :: Local -> Local -> (Name, Id)
46−vname p l = (dname (g (n <> "'")), g n)
45+vname :: Text -> (Name, Id, [Text])
46+vname n = (dname (g (x <> "API")), g x, ns)
4747 where
48− g = Free . Global
49− n = f p <> f l
50− f = upperHead . local
48+ g = Free . Global
49+ x = mconcat (drop 1 ns)
50+ ns = map (upperAcronym . upperHead) $ Text.split (== '.') n
5151
5252dname, cname :: Id -> Name
5353dname = name . Text.unpack . upperHead . idToText
gen/src/Gen/Types/NS.hs+1
@@ -18,6 +18,7 @@ import Data.String
1818import Data.Text (Text)
1919import qualified Data.Text as Text
2020import qualified Filesystem.Path.CurrentOS as Path
21+import Gen.Text
2122
2223newtype NS = NS [Text]
2324 deriving (Eq, Ord, Show)
gen/template/action.ede+10−2
@@ -1,5 +1,9 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE TypeOperators #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE RecordWildCards #-}
5+{-# LANGUAGE TypeFamilies #-}
6+{-# LANGUAGE TypeOperators #-}
37
48{-# OPTIONS_GHC -fno-warn-unused-imports #-}
59{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
@@ -26,6 +30,10 @@ module {{ action.ns }}
2630 {% endfor %}
2731 ) where
2832
33+{% for import in moduleImports %}
34+import {{ import.value }}
35+{% endfor %}
36+
2937-- | A resource alias for {{ action.prettyName }} which the
3038-- '{{ action.type.name }}' request conforms to.
3139{{ action.alias }}
gen/template/toc.ede+6−1
@@ -12,8 +12,11 @@
1212module {{ moduleName }}
1313 (
1414 -- * REST Resources
15+
16+ -- ** {{ title }}
1517 {{ api.name }}
1618 , {{ api.name | lowerHead }}
19+ , {{ api.url.name }}
1720 {% for action in api.actions %}
1821
1922 -- ** {{ action.value.prettyName }}
@@ -39,7 +42,9 @@ module {{ moduleName }}
3942 {% endfor %}
4043 ) where
4144
42−import Network.Google.Prelude
45+{% for import in moduleImports %}
46+import {{ import.value }}
47+{% endfor %}
4348{% for module in exposedModules %}
4449 {% if module.value != moduleName %}
4550import {{ module.value }}
gen/template/types.ede+9−1
@@ -8,12 +8,14 @@
88--
99module {{ moduleName }}
1010 (
11+ -- * Service URL
12+ {{ api.url.name }}
1113 {% for schema in schemas %}
1214 {% case schema.value.type %}
1315 {% when "prod" %}
1416
1517 -- * {{ schema.value.name }}
16− {% if schema.first %} {% else %},{% endif %} {{ schema.value.name }}
18+ , {{ schema.value.name }}
1719 , {{ schema.value.ctor.name }}
1820 {% for lens in schema.value.lenses %}
1921 , {{ lens.value.name }}
@@ -29,3 +31,9 @@ module {{ moduleName }}
2931{% for import in moduleImports %}
3032import {{ import.value }}
3133{% endfor %}
34+
35+{% if api.url.help %}
36+{{ api.url.help }}
37+{% endif %}
38+{{ api.url.sig }}
39+{{ api.url.decl }}