git.iko.soy/gogol
on develop help sign in
Tweaking stylistic naming
commit586ecc1a0c5d6654d0b0368a7add83cc61134fdd authorBrendan Hay <brendan.g.hay@gmail.com> dateSun 4 Oct 2015, 17:41 (11 years ago) parent2263e96
6 files changed+99−52
compare with develop
unifiedsplit
gen/src/Gen/AST/Flatten.hs+45−32 gen/src/Gen/AST/Solve.hs+9−3 gen/src/Gen/Syntax.hs+12−7 gen/src/Gen/Text.hs+11−8 gen/src/Gen/Types/Id.hs+14−1 gen/src/Gen/Types/Schema.hs+8−1
gen/src/Gen/AST/Flatten.hs+45−32
@@ -30,6 +30,7 @@ import qualified Data.HashMap.Strict as Map
3030import Data.Maybe
3131import Data.Semigroup ((<>))
3232import qualified Data.Text as Text
33+import Debug.Trace
3334import Gen.Formatting
3435import Gen.Types
3536import Prelude hiding (sum)
@@ -60,35 +61,47 @@ globalSchema :: Global -> Fix Schema -> AST Global
6061globalSchema g = schema g Nothing
6162
6263localSchema :: Global -> Local -> Fix Schema -> AST Global
63−localSchema g l s = do
64− let r = globalise l
65− p <- uses schemas (Map.member r)
66− if p
67− then schema g (Just l) s
68− else schema r Nothing s
69− -- local schema, check if the local schema exists and then just add it as
70− -- a global?
64+localSchema g l = schema g (Just l)
65+
66+ -- -- unsafe due to depth first adding of a single schema's properties.
67+ -- let r = globalise l
68+ -- p <- uses schemas (Map.member r)
69+ -- if p
70+ -- then schema g (Just l) s
71+ -- else schema r Nothing s
7172
7273schema :: Global -> Maybe Local -> Fix Schema -> AST Global
73−schema g ml (Fix f) = go f >>= insert this
74+schema g ml (Fix f) = go (maybe g (reference g) ml) f >>= uncurry insert
7475 where
75− this :: Global
76− this = maybe g (reference g) ml
77−
78− go :: Schema (Fix Schema) -> AST (Schema Global)
79− go = \case
80− SAny i a -> pure (SAny i a)
81− SRef i r -> pure (SRef i r)
82− SLit i l -> pure (SLit i l)
83− SEnm i e -> pure (SEnm i e)
84− SArr i a -> SArr i <$> array a
85− SObj i o -> SObj i <$> object o
86−
87− array (Arr e) =
88− Arr <$> schema this (Just "item") (setRequired e)
89−
90− object (Obj aps ps) =
91− Obj Nothing <$> Map.traverseWithKey (localSchema this) ps
76+ go :: Global -> Schema (Fix Schema) -> AST (Global, Schema Global)
77+ go p = \case
78+ SAny i a -> pure (p, SAny i a)
79+ SRef i r -> pure (p, SRef i r)
80+ SLit i l -> pure (p, SLit i l)
81+ SEnm i e -> (,SEnm i e) <$> name i p ["Type", "Option"]
82+ SArr i a -> do
83+ u <- name i p ["List", "Array"]
84+ (u,) . SArr i <$> array u a
85+ SObj i o -> do
86+ u <- name i p ["Schema", "Object"]
87+ (u,) . SObj i <$> object u o
88+
89+ array p (Arr e) =
90+ Arr <$> schema p (Just "item") (setRequired e)
91+
92+ object p (Obj aps ps) =
93+ Obj Nothing <$> Map.traverseWithKey (localSchema p) ps
94+
95+ name i p xs
96+ | Just x <- i ^. iId = pure x
97+ | otherwise = do
98+ e <- uses schemas (Map.lookup p)
99+ case (e, xs) of
100+ (Nothing, _) -> pure p
101+ (Just _, z:zs) -> name i (reference g z) zs
102+ (Just x, []) -> throwError $
103+ format ("Unable to generate name for: " % gid % ", " % shown % ", " % gid % "\n" % shown)
104+ g ml p x
92105
93106globalParam :: Local -> Param (Fix Schema) -> AST (Param Global)
94107globalParam l p = ($ p) $ case l of
@@ -126,15 +139,15 @@ method :: Map Local (Param Global)
126139 -> Method (Fix Schema)
127140 -> AST (Method Global)
128141method qs suf m@Method {..} = do
129− ps <- Map.traverseWithKey (localParam _mId) _mParameters
142+ ps <- Map.traverseWithKey (localParam (abbreviate _mId)) _mParameters
130143 cn <- use sCanonicalName
131144
132145 let (_, typ, _) = mname cn suf _mId
133146
134147 b <- body typ
135148
136− let params = ps <> qs
137− fields = Map.delete "alt" $ b (upload (Map.map _pParam params))
149+ let params = ps <> qs
150+ fields = Map.delete "alt" $ b (upload (Map.map _pParam params))
138151
139152 void $ insert typ (SObj schemaInfo (Obj Nothing fields))
140153 pure $! m { _mParameters = params }
@@ -177,7 +190,7 @@ insert g s = do
177190 schemas %= Map.insert g s
178191 pure g
179192 where
180− exists n x =
193+ exists n s' =
181194 format ("Schema exists: " % stext % " - " % gid %
182− "\n\n[Current]\n" % shown % "\n[Tried]\n\n" % shown)
183− n g x s
195+ "\n\n[Current]\n" % shown % "\n\n[Tried]\n" % shown % "\n\n")
196+ n g s' s
gen/src/Gen/AST/Solve.hs+9−3
@@ -39,6 +39,7 @@ import Data.Semigroup ((<>))
3939import Data.Text (Text)
4040import qualified Data.Text as Text
4141import Data.Text.Manipulate
42+import Debug.Trace
4243import Gen.Formatting
4344import Gen.Text
4445import Gen.Types
@@ -90,12 +91,17 @@ getType g = loc "getType" g $ memo typed g go
9091 where
9192 go s = case s of
9293 SAny {} -> res (TType "JSONValue")
93− SRef _ r -> req <$> getType (ref r)
9494 --- FIXME: add natural/numeric manipulations
95− SLit i l -> res (TLit l)
95+ SLit _ l -> res (TLit l)
9696 SEnm {} -> res (TType g)
9797 SArr _ (Arr e) -> (TList <$> (getType e)) >>= pure . may
9898 SObj {} -> res (TType g)
99+ SRef _ r
100+ | ref r /= g -> req <$> getType (ref r)
101+-- | otherwise -> res (TType (ref r))
102+ | otherwise -> throwError $
103+ format ("Ref cycle detected between: " % gid % " == " % shown)
104+ g s
99105 where
100106 res = pure . may . rep
101107
@@ -246,4 +252,4 @@ memo l g f = do
246252 pure x
247253
248254loc :: String -> Global -> a -> a
249−loc _ _ = id -- trace (n ++ ": " ++ Text.unpack (fromKey g))
255+loc _ _ = id -- trace (n ++ ": " ++ Text.unpack (global g))
gen/src/Gen/Syntax.hs+12−7
@@ -100,13 +100,18 @@ verbAlias n m
100100 Path -> Nothing
101101
102102 media :: [Type]
103− media | Just b <- _mRequest m =
104− let g = ref b
105− in if _mSupportsMediaUpload m
106− then [TyApp (TyApp (TyApp (TyCon "MultipartRelated") json)
107− (tycon g))
108− (TyCon "Body")]
109− else [TyApp (TyApp (TyCon "ReqBody") json) (tycon g)]
103+ media | Just b <- _mRequest m
104+ , _mSupportsMediaUpload m =
105+ [TyApp (TyApp (TyApp (TyCon "MultipartRelated") json)
106+ (tycon (ref b)))
107+ (TyCon "Body")]
108+
109+ | Just b <- _mRequest m =
110+ [TyApp (TyApp (TyCon "ReqBody") octet) (tycon (ref b))]
111+
112+ | _mSupportsMediaUpload m =
113+ [TyApp (TyApp (TyCon "ReqBody") json) (TyCon "Body")]
114+
110115 | otherwise = []
111116
112117 verb = TyApp (TyApp meth json) $
gen/src/Gen/Text.hs+11−8
@@ -211,8 +211,10 @@ upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs
211211 , ("Cse$", "CSE")
212212 , ("Gan$", "GAN")
213213
214+ , ("([^ypn])load", "$1Load")
214215 , ("access", "Access")
215216 , ("account", "Account")
217+ , ("app", "App")
216218 , ("bid", "Bid")
217219 , ("billing", "Billing")
218220 , ("busy", "Busy")
@@ -220,39 +222,40 @@ upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs
220222 , ("click", "Click")
221223 , ("client", "Client")
222224 , ("config", "Config")
225+ , ("crawl", "Crawl")
223226 , ("deal", "Deal")
224227 , ("debug", "Debug")
225228 , ("device", "Device")
226229 , ("download", "Download")
227230 , ("engine", "Engine")
228231 , ("enterprise", "Enterprise")
232+ , ("error", "Error")
229233 , ("info", "Info")
230234 , ("library", "Library")
231235 , ("list", "List")
232− , ("([^ypn])load", "$1Load")
233236 , ("manager", "Manager")
234237 , ("model", "Model")
235238 , ("monitor", "Monitor")
236239 , ("note", "Note")
240+ , ("observe", "Observe")
237241 , ("offer", "Offer")
242+ , ("order", "Order")
238243 , ("part", "Part")
244+ , ("position", "Position")
245+ , ("product", "Product")
239246 , ("proper", "Proper")
240247 , ("publish", "Publish")
241248 , ("resource", "Resource")
242249 , ("round", "Round")
250+ , ("sample", "Sample")
243251 , ("service", "Service")
252+ , ("session", "Session")
244253 , ("state", "State")
245254 , ("transfer", "Transfer")
246255 , ("unit", "Unit")
247256 , ("upload", "Upload")
248257 , ("user", "User")
249− , ("observe", "Observe")
250− , ("order", "Order")
251− , ("position", "Position")
252− , ("crawl", "Crawl")
253− , ("error", "Error")
254− , ("sample", "Sample")
255− , ("session", "Session")
258+ , ("file", "File")
256259 ]
257260
258261acronyms :: [(String, String)]
gen/src/Gen/Types/Id.hs+14−1
@@ -26,6 +26,7 @@ module Gen.Types.Id
2626 , global
2727 , local
2828
29+ , abbreviate
2930 , globalise
3031 , localise
3132
@@ -126,7 +127,14 @@ newtype Prefix = Prefix Text
126127 deriving (Show, Monoid)
127128
128129newtype Global = Global [Text]
129− deriving (Eq, Ord, Show, Generic, Hashable)
130+ deriving (Ord, Show, Generic)
131+
132+instance Eq Global where
133+ Global xs == Global ys =
134+ map CI.mk xs == map CI.mk ys
135+
136+instance Hashable Global where
137+ hashWithSalt salt (Global g) = foldl' hashWithSalt salt (map CI.mk g)
130138
131139instance IsString Global where
132140 fromString = mkGlobal . fromString
@@ -164,6 +172,11 @@ reference (Global g) (Local l) = Global
164172 . filter (not . Text.null)
165173 $ Text.split (== '.') l
166174
175+abbreviate :: Global -> Global
176+abbreviate (Global g)
177+ | length g > 2 = Global (drop 1 g)
178+ | otherwise = Global g
179+
167180localise :: Global -> Local
168181localise = Local . global
169182
gen/src/Gen/Types/Schema.hs+8−1
@@ -31,6 +31,7 @@ import Data.Aeson hiding (Array, Bool, Object, String)
3131import qualified Data.Aeson as A
3232import Data.Aeson.TH
3333import Data.Aeson.Types (Parser)
34+import Data.Function (on)
3435import qualified Data.HashMap.Strict as Map
3536import Data.Maybe
3637import Data.Semigroup ((<>))
@@ -72,10 +73,16 @@ data Info = Info
7273 , _iMaximum :: Maybe Text
7374 , _iRepeated :: Bool
7475 , _iAnnotations :: Ann
75− } deriving (Eq, Show)
76+ } deriving (Show)
7677
7778makeClassy ''Info
7879
80+instance Eq Info where
81+ a == b = on (==) _iId a b
82+ && on (==) _iDefault a b
83+ && on (==) _iRequired a b
84+ && on (==) _iRepeated a b
85+
7986instance FromJSON Info where
8087 parseJSON = withObject "info" $ \o -> Info
8188 <$> o .:? "id"