git.iko.soy/gogol
on develop help sign in
Ensuring non-ambiguous naming via dirty hacks
f39eb32Brendan Hay
gen/src/Gen/AST/Flatten.hs+11−5
compare with develop
unifiedsplit
@@ -36,11 +36,10 @@ import Prelude hiding (sum)
36
36
37flatten :: Service (Fix Schema) -> AST (Service Global)
37flatten :: Service (Fix Schema) -> AST (Service Global)
38flatten s = do
38flatten s = do
39− _ <- Map.traverseWithKey globalSchema (s ^. dSchemas)
40 ps <- Map.traverseWithKey globalParam (s ^. dParameters)
39 ps <- Map.traverseWithKey globalParam (s ^. dParameters)
41−
42 rs <- Map.traverseWithKey (resource ps "Resource") (s ^. dResources)
40 rs <- Map.traverseWithKey (resource ps "Resource") (s ^. dResources)
43 ms <- traverse (method ps "Method") (s ^. dMethods)
41 ms <- traverse (method ps "Method") (s ^. dMethods)
42+ _ <- Map.traverseWithKey globalSchema (s ^. dSchemas)
44
43
45 -- The horror.
44 -- The horror.
46 ss <- use schemas
45 ss <- use schemas
@@ -58,7 +57,14 @@ globalSchema :: Global -> Fix Schema -> AST Global
58globalSchema g = schema g Nothing
57globalSchema g = schema g Nothing
59
58
60localSchema :: Global -> Local -> Fix Schema -> AST Global
59localSchema :: Global -> Local -> Fix Schema -> AST Global
61−localSchema g l = schema g (Just l)
60+localSchema g l s = do
61+ let r = globalise l
62+ p <- uses schemas (Map.member r)
63+ if p
64+ then schema g (Just l) s
65+ else schema r Nothing s
66+ -- local schema, check if the local schema exists and then just add it as
67+ -- a global?
62
68
63schema :: Global -> Maybe Local -> Fix Schema -> AST Global
69schema :: Global -> Maybe Local -> Fix Schema -> AST Global
64schema g ml (Fix f) = go f >>= insert this
70schema g ml (Fix f) = go f >>= insert this
@@ -76,7 +82,7 @@ schema g ml (Fix f) = go f >>= insert this
76 SObj i o -> SObj i <$> object o
82 SObj i o -> SObj i <$> object o
77
83
78 array (Arr e) =
84 array (Arr e) =
79− Arr <$> localSchema this "" (setRequired e)
85+ Arr <$> localSchema this "item" (setRequired e)
80
86
81 object (Obj aps ps) =
87 object (Obj aps ps) =
82 Obj Nothing <$> Map.traverseWithKey (localSchema this) ps
88 Obj Nothing <$> Map.traverseWithKey (localSchema this) ps
@@ -136,7 +142,7 @@ method qs suf m@Method {..} = do
136 body p = case _mRequest of
142 body p = case _mRequest of
137 Nothing -> pure id
143 Nothing -> pure id
138 Just x -> do
144 Just x -> do
139− let f = localise (ref x)
145+ let f = "payload" -- localise (ref x)
140 g <- localSchema p f (Fix (SRef bodyInfo x))
146 g <- localSchema p f (Fix (SRef bodyInfo x))
141 pure (Map.insert f g)
147 pure (Map.insert f g)
142
148
gen/src/Gen/AST/Render.hs+1
@@ -33,6 +33,7 @@ import Data.Semigroup ((<>))
33import qualified Data.Text as Text
33import qualified Data.Text as Text
34import qualified Data.Text.Lazy as LText
34import qualified Data.Text.Lazy as LText
35import qualified Data.Text.Lazy.Builder as Build
35import qualified Data.Text.Lazy.Builder as Build
36+import Debug.Trace
36import Gen.AST.Solve (getSolved)
37import Gen.AST.Solve (getSolved)
37import Gen.Formatting
38import Gen.Formatting
38import Gen.Syntax
39import Gen.Syntax
gen/src/Gen/AST/Solve.hs+7−7
@@ -117,21 +117,21 @@ getDerive g = loc "getDerive" g $ memo derived g go
117 SObj _ (Obj _ ps) -> foldM props base (Map.elems ps)
117 SObj _ (Obj _ ps) -> foldM props base (Map.elems ps)
118
118
119 literal = \case
119 literal = \case
120− Text -> base <> [DOrd, DIsString]
120+ Text -> base <> [DRead, DOrd, DIsString]
121 Bool -> enum
121 Bool -> enum
122− Time -> base
122+ Time -> DRead : base
123− Date -> base
123+ Date -> DRead : base
124 Body -> base
124 Body -> base
125− Alt _ -> base
125+ Alt _ -> DRead : base
126− Key -> base
126+ Key -> DRead : base
127 -- FIXME: Add numeric cases
127 -- FIXME: Add numeric cases
128− _ -> [DNum, DIntegral, DReal] <> enum
128+ _ -> [DRead, DNum, DIntegral, DReal] <> enum
129
129
130 props ds x = intersect ds <$> getDerive x
130 props ds x = intersect ds <$> getDerive x
131
131
132 list = [DMonoid]
132 list = [DMonoid]
133 enum = [DOrd, DEnum] <> base
133 enum = [DOrd, DEnum] <> base
134− base = [DEq, DRead, DShow, DData, DTypeable, DGeneric]
134+ base = [DEq, DShow, DData, DTypeable, DGeneric]
135
135
136getPrefix :: Global -> AST Prefix
136getPrefix :: Global -> AST Prefix
137getPrefix g = loc "getPrefix" g $ memo prefixed g go
137getPrefix g = loc "getPrefix" g $ memo prefixed g go
gen/src/Gen/Syntax.hs+30−21
@@ -14,17 +14,18 @@ module Gen.Syntax where
14
14
15import Control.Lens hiding (iso, mapping, op, pre,
15import Control.Lens hiding (iso, mapping, op, pre,
16 strict)
16 strict)
17+import Data.Either
17import Data.Foldable (find, foldl', foldr')
18import Data.Foldable (find, foldl', foldr')
18import Data.Hashable
19import Data.Hashable
19import qualified Data.HashMap.Strict as Map
20import qualified Data.HashMap.Strict as Map
20−import Data.List (delete)
21+import Data.List (delete, nub)
21−import Data.Maybe
22import Data.Maybe
22import Data.Maybe
23import Data.Semigroup ((<>))
23import Data.Semigroup ((<>))
24import Data.String
24import Data.String
25import Data.Text (Text)
25import Data.Text (Text)
26import qualified Data.Text as Text
26import qualified Data.Text as Text
27import Data.Text.Manipulate
27import Data.Text.Manipulate
28+import Debug.Trace
28import Gen.Orphans
29import Gen.Orphans
29import Gen.Text
30import Gen.Text
30import Gen.Types
31import Gen.Types
@@ -56,26 +57,31 @@ verbAlias n m
56 where
57 where
57 rest = alias verb (path ++ qry params ++ media)
58 rest = alias verb (path ++ qry params ++ media)
58 download = TyInfix rest (UnQual (sym ":<|>")) $
59 download = TyInfix rest (UnQual (sym ":<|>")) $
59− alias (TyApp (TyApp meth octet) (TyCon "Stream"))
60+ alias (TyApp (TyApp meth octet) (TyCon "Body"))
60 (path ++ qry (Map.delete "alt" (_mParameters m)) ++ [alt] ++ media)
61 (path ++ qry (Map.delete "alt" (_mParameters m)) ++ [alt] ++ media)
61
62
62 alias = foldr' (\l r -> TyInfix l (UnQual (sym ":>")) r)
63 alias = foldr' (\l r -> TyInfix l (UnQual (sym ":>")) r)
63
64
64 path :: [Type]
65 path :: [Type]
65− path = map match
66+ path = map match $ extractPath (_mPath m)
66− . filter (not . Text.null)
67− $ Text.split (== '/') (_mPath m)
68 where
67 where
69− -- FIXME: should error if '{' '}' is found and cannot find the ref.
68+ match (Left t) = sing t
70− match x
69+ match (Right (l, c)) =
71− | Just (c, t) <- Text.uncons x
70+ case Map.lookup l (_mParameters m) of
72− , c == '{'
71+ Nothing -> error $ "Unable to find path parameter " ++ show l
73− , Just k <- Map.lookup (toKey (Text.init t)) params
72+ Just x ->
74− , _pLocation k == Path
73+ case c of
74+ Nothing ->
75− = TyApp (TyApp (TyCon "Capture")
75+ TyApp (TyApp (TyCon "Capture")
76− (sing (Text.init t)))
76+ (sing (local l)))
77− (terminalType (_type (_pParam k)))
77+ (terminalType (_type (_pParam x)))
78+
79+ Just y ->
80+ TyApp (TyApp (TyApp (TyCon "CaptureMode")
81+ (sing (local l)))
78− | otherwise = sing x
82+ (sing y))
83+ (terminalType (_type (_pParam x)))
84+
79
85
80 qry xs = mapMaybe f $ orderParams fst (Map.toList xs) (_mParameterOrder m)
86 qry xs = mapMaybe f $ orderParams fst (Map.toList xs) (_mParameterOrder m)
81 where
87 where
@@ -106,9 +112,9 @@ verbAlias n m
106 octet = tylist ["OctetStream"]
112 octet = tylist ["OctetStream"]
107 json = tylist ["JSON"]
113 json = tylist ["JSON"]
108
114
109− alt = TyApp (TyApp (TyCon "QueryParam") (sing "alt")) (TyCon "Media")
115+ alt = TyApp (TyApp (TyCon "QueryParam") (sing "alt")) (TyCon "AltMedia")
110
116
111− params = _mParameters m
117+ params = Map.filter ((/= Path) . _pLocation) (_mParameters m)
112
118
113downloadDecl :: Global
119downloadDecl :: Global
114 -> Prefix
120 -> Prefix
@@ -122,7 +128,7 @@ downloadDecl n p api url fs m =
122 where
128 where
123 rs = InsType noLoc
129 rs = InsType noLoc
124 (TyApp (TyCon "Rs") (TyApp (TyCon "Download") (tycon n)))
130 (TyApp (TyCon "Rs") (TyApp (TyCon "Download") (tycon n)))
125− (TyCon "Stream")
131+ (TyCon "Body")
126
132
127 alt = Just (var "Media")
133 alt = Just (var "Media")
128
134
@@ -191,10 +197,13 @@ googleRequestDecl g n assoc alt p api url fields m =
191 ps = _mParameters m
197 ps = _mParameters m
192 v = var . fname p
198 v = var . fname p
193
199
194− (fs', rq) | Just r <- _mRequest m = let x = localise (ref r) in (delete x fs, Just x)
200+ (fs', rq) | Just _ <- _mRequest m = (delete "payload" fs, Just "payload")
195 | otherwise = (fs, Nothing)
201 | otherwise = (fs, Nothing)
196
202
203+ fs = delete "alt"
204+ . orderParams id (Map.keys (_mParameters m))
205+ . nub
197− fs = orderParams id fields (_mParameterOrder m)
206+ $ map fst (rights (extractPath (_mPath m))) ++ _mParameterOrder m
198
207
199 pats = [pvar "r", pvar "u", prec]
208 pats = [pvar "r", pvar "u", prec]
200 prec = PRec (UnQual (dname g)) [PFieldWildcard]
209 prec = PRec (UnQual (dname g)) [PFieldWildcard]
gen/src/Gen/Text.hs+6−2
@@ -117,10 +117,13 @@ renameReserved x
117 , "object"
117 , "object"
118 , "get"
118 , "get"
119 , "group"
119 , "group"
120− , "error"
121 , "True"
120 , "True"
122 , "False"
121 , "False"
122+ , "error"
123 , "Error"
123 , "Error"
124+ , "read"
125+ , "Read"
126+ , "request"
124 ] ++ map Text.pack (reservedNames haskellDef)
127 ] ++ map Text.pack (reservedNames haskellDef)
125
128
126camelAcronym :: Text -> Text
129camelAcronym :: Text -> Text
@@ -204,6 +207,7 @@ upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs
204 , ("Oob", "OOB")
207 , ("Oob", "OOB")
205 , ("Jwk", "JWK")
208 , ("Jwk", "JWK")
206 , ("Dto", "DTO")
209 , ("Dto", "DTO")
210+ , ("Sku", "SKU")
207
211
208 , ("access", "Access")
212 , ("access", "Access")
209 , ("account", "Account")
213 , ("account", "Account")
@@ -223,7 +227,7 @@ upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs
223 , ("info", "Info")
227 , ("info", "Info")
224 , ("library", "Library")
228 , ("library", "Library")
225 , ("list", "List")
229 , ("list", "List")
226− , ("([^pn])load", "$1Load")
230+ , ("([^ypn])load", "$1Load")
227 , ("manager", "Manager")
231 , ("manager", "Manager")
228 , ("model", "Model")
232 , ("model", "Model")
229 , ("monitor", "Monitor")
233 , ("monitor", "Monitor")
gen/src/Gen/Types/Id.hs+35−4
@@ -4,6 +4,7 @@
4{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE LambdaCase #-}
5{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7+{-# LANGUAGE ViewPatterns #-}
7
8
8-- Module : Gen.Types.Id
9-- Module : Gen.Types.Id
9-- Copyright : (c) 2015 Brendan Hay
10-- Copyright : (c) 2015 Brendan Hay
@@ -24,6 +25,8 @@ module Gen.Types.Id
24
25
25 , global
26 , global
26 , local
27 , local
28+
29+ , globalise
27 , localise
30 , localise
28
31
29 , gid
32 , gid
@@ -31,6 +34,8 @@ module Gen.Types.Id
31
34
32 , reference
35 , reference
33
36
37+ -- FIXME: move these
38+ , extractPath
34 , orderParams
39 , orderParams
35
40
36 -- * Naming
41 -- * Naming
@@ -52,7 +57,9 @@ import qualified Data.CaseInsensitive as CI
52import Data.Coerce
57import Data.Coerce
53import Data.Foldable (foldl')
58import Data.Foldable (foldl')
54import Data.Hashable
59import Data.Hashable
55−import Data.List (elemIndex, sortOn)
60+import Data.List (elemIndex, nub, sortOn)
61+import Data.Maybe
62+import Data.Ord
56import Data.Semigroup hiding (Sum)
63import Data.Semigroup hiding (Sum)
57import Data.String
64import Data.String
58import Data.Text (Text)
65import Data.Text (Text)
@@ -86,7 +93,7 @@ mname abrv (Suffix suf) (Global g) =
86 x:xs = map (upperAcronym . toPascal) g
93 x:xs = map (upperAcronym . toPascal) g
87
94
88dname, cname :: Global -> Name
95dname, cname :: Global -> Name
89−dname = name . Text.unpack . upperHead . global
96+dname = name . Text.unpack . renameReserved . upperHead . global
90cname = name . Text.unpack . renameReserved . lowerHead . lowerFirstAcronym . global
97cname = name . Text.unpack . renameReserved . lowerHead . lowerFirstAcronym . global
91
98
92bname :: Prefix -> Text -> Name
99bname :: Prefix -> Text -> Name
@@ -149,15 +156,39 @@ global :: Global -> Text
149global (Global g) = foldMap (upperAcronym . upperHead) g
156global (Global g) = foldMap (upperAcronym . upperHead) g
150
157
151reference :: Global -> Local -> Global
158reference :: Global -> Local -> Global
152−reference (Global g) (Local l) = Global (g <> Text.split (== '.') l)
159+reference (Global g) (Local l) = Global
160+ . mappend g
161+ . filter (not . Text.null)
162+ $ Text.split (== '.') l
153
163
154localise :: Global -> Local
164localise :: Global -> Local
155localise = Local . global
165localise = Local . global
156
166
167+globalise :: Local -> Global
168+globalise = Global . (:[]) . local
169+
170+extractPath :: Text -> [Either Text (Local, Maybe Text)]
171+extractPath = map match . filter (not . Text.null) . Text.split (== '/')
172+ where
173+ match x =
174+ case Text.uncons x of
175+ Just (c, Text.dropWhile (== '+') -> t)
176+ | c == '{' -> Right $
177+ let y = toKey (Text.takeWhile (/= '}') t)
178+ in case Text.dropWhile (/= ':') t of
179+ "" -> (y, Nothing)
180+ z -> (y, Just z)
181+
182+ -- Resource "editId" "commit"
183+ -- "path": "{packageName}/edits/{editId}:commit",
184+
185+ _ -> Left x
186+
187+
157orderParams :: (a -> Local) -> [a] -> [Local] -> [a]
188orderParams :: (a -> Local) -> [a] -> [Local] -> [a]
158orderParams f xs ys = orderBy f zs (del zs [] ++ global)
189orderParams f xs ys = orderBy f zs (del zs [] ++ global)
159 where
190 where
160− zs = orderBy f (sortOn f xs) ys
191+ zs = orderBy f (sortOn f xs) (nub (ys ++ map f xs))
161
192
162 del _ [] = []
193 del _ [] = []
163 del [] rs = reverse rs
194 del [] rs = reverse rs