586ecc1 · gogol · git.iko.soy

git.iko.soy/gogol

on develop help sign in

Tweaking stylistic naming

586ecc1Brendan Hay11 years ago

gen/src/Gen/AST/Flatten.hs+45−32

compare with develop

unifiedsplit

@@ -30,6 +30,7 @@ import qualified Data.HashMap.Strict as Map

30import Data.Maybe

31import Data.Semigroup ((<>))

32import qualified Data.Text as Text

33+import Debug.Trace

33import Gen.Formatting

34import Gen.Formatting

34import Gen.Types

35import Gen.Types

35import Prelude hiding (sum)

36import Prelude hiding (sum)

@@ -60,35 +61,47 @@ globalSchema :: Global -> Fix Schema -> AST Global

60globalSchema g = schema g Nothing

61globalSchema g = schema g Nothing

62localSchema :: Global -> Local -> Fix Schema -> AST Global

63localSchema :: Global -> Local -> Fix Schema -> AST Global

63−localSchema g l s = do

64+localSchema g l = schema g (Just l)

65+

66+ -- -- unsafe due to depth first adding of a single schema's properties.

64− let r = globalise l

67+ -- let r = globalise l

65− p <- uses schemas (Map.member r)

68+ -- p <- uses schemas (Map.member r)

66− if p

69+ -- if p

67− then schema g (Just l) s

70+ -- then schema g (Just l) s

68− else schema r Nothing s

71+ -- else schema r Nothing s

69− -- local schema, check if the local schema exists and then just add it as

70− -- a global?

72schema :: Global -> Maybe Local -> Fix Schema -> AST Global

73schema :: 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

74 where

75 where

75− this :: Global

76− this = maybe g (reference g) ml

77−

78− go :: Schema (Fix Schema) -> AST (Schema Global)

76+ go :: Global -> Schema (Fix Schema) -> AST (Global, Schema Global)

79− go = \case

77+ go p = \case

80− SAny i a -> pure (SAny i a)

78+ SAny i a -> pure (p, SAny i a)

81− SRef i r -> pure (SRef i r)

79+ SRef i r -> pure (p, SRef i r)

82− SLit i l -> pure (SLit i l)

80+ SLit i l -> pure (p, SLit i l)

83− SEnm i e -> pure (SEnm i e)

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− SArr i a -> SArr i <$> array a

84+ (u,) . SArr i <$> array u a

85+ SObj i o -> do

86+ u <- name i p ["Schema", "Object"]

85− SObj i o -> SObj i <$> object o

87+ (u,) . SObj i <$> object u o

86−

88+

87− array (Arr e) =

89+ array p (Arr e) =

88− Arr <$> schema this (Just "item") (setRequired e)

90+ Arr <$> schema p (Just "item") (setRequired e)

89−

91+

90− object (Obj aps ps) =

92+ object p (Obj aps ps) =

91− Obj Nothing <$> Map.traverseWithKey (localSchema this) 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

105

93globalParam :: Local -> Param (Fix Schema) -> AST (Param Global)

106globalParam :: Local -> Param (Fix Schema) -> AST (Param Global)

94globalParam l p = ($ p) $ case l of

107globalParam l p = ($ p) $ case l of

@@ -126,15 +139,15 @@ method :: Map Local (Param Global)

126 -> Method (Fix Schema)

139 -> Method (Fix Schema)

127 -> AST (Method Global)

140 -> AST (Method Global)

128method qs suf m@Method {..} = do

141method qs suf m@Method {..} = do

129− ps <- Map.traverseWithKey (localParam _mId) _mParameters

142+ ps <- Map.traverseWithKey (localParam (abbreviate _mId)) _mParameters

130 cn <- use sCanonicalName

143 cn <- use sCanonicalName

131

144

132 let (_, typ, _) = mname cn suf _mId

145 let (_, typ, _) = mname cn suf _mId

133

146

134 b <- body typ

147 b <- body typ

135

148

136− let params = ps <> qs

149+ let params = ps <> qs

137− fields = Map.delete "alt" $ b (upload (Map.map _pParam params))

150+ fields = Map.delete "alt" $ b (upload (Map.map _pParam params))

138

151

139 void $ insert typ (SObj schemaInfo (Obj Nothing fields))

152 void $ insert typ (SObj schemaInfo (Obj Nothing fields))

140 pure $! m { _mParameters = params }

153 pure $! m { _mParameters = params }

@@ -177,7 +190,7 @@ insert g s = do

177 schemas %= Map.insert g s

190 schemas %= Map.insert g s

178 pure g

191 pure g

179 where

192 where

180− exists n x =

193+ exists n s' =

181 format ("Schema exists: " % stext % " - " % gid %

194 format ("Schema exists: " % stext % " - " % gid %

182− "\n\n[Current]\n" % shown % "\n[Tried]\n\n" % shown)

195+ "\n\n[Current]\n" % shown % "\n\n[Tried]\n" % shown % "\n\n")

183− n g x s

196+ n g s' s

gen/src/Gen/AST/Solve.hs+9−3

@@ -39,6 +39,7 @@ import Data.Semigroup ((<>))

39import Data.Text (Text)

40import qualified Data.Text as Text

41import Data.Text.Manipulate

42+import Debug.Trace

42import Gen.Formatting

43import Gen.Formatting

43import Gen.Text

44import Gen.Text

44import Gen.Types

45import Gen.Types

@@ -90,12 +91,17 @@ getType g = loc "getType" g $ memo typed g go

90 where

91 where

91 go s = case s of

92 go s = case s of

92 SAny {} -> res (TType "JSONValue")

93 SAny {} -> res (TType "JSONValue")

93− SRef _ r -> req <$> getType (ref r)

94 --- FIXME: add natural/numeric manipulations

95− SLit i l -> res (TLit l)

95+ SLit _ l -> res (TLit l)

96 SEnm {} -> res (TType g)

97 SArr _ (Arr e) -> (TList <$> (getType e)) >>= pure . may

98 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

99 where

105 where

100 res = pure . may . rep

106 res = pure . may . rep

101

107

@@ -246,4 +252,4 @@ memo l g f = do

246 pure x

252 pure x

247

253

248loc :: String -> Global -> a -> a

254loc :: 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

100 Path -> Nothing

101

102 media :: [Type]

103− media | Just b <- _mRequest m =

103+ media | Just b <- _mRequest m

104− let g = ref b

105− in if _mSupportsMediaUpload m

104+ , _mSupportsMediaUpload m =

106− then [TyApp (TyApp (TyApp (TyCon "MultipartRelated") json)

105+ [TyApp (TyApp (TyApp (TyCon "MultipartRelated") json)

107− (tycon g))

106+ (tycon (ref b)))

108− (TyCon "Body")]

107+ (TyCon "Body")]

108+

109+ | Just b <- _mRequest m =

110+ [TyApp (TyApp (TyCon "ReqBody") octet) (tycon (ref b))]

111+

112+ | _mSupportsMediaUpload m =

109− else [TyApp (TyApp (TyCon "ReqBody") json) (tycon g)]

113+ [TyApp (TyApp (TyCon "ReqBody") json) (TyCon "Body")]

114+

110 | otherwise = []

115 | otherwise = []

111

116

112 verb = TyApp (TyApp meth json) $

117 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

211 , ("Cse$", "CSE")

212 , ("Gan$", "GAN")

213

214+ , ("([^ypn])load", "$1Load")

214 , ("access", "Access")

215 , ("access", "Access")

215 , ("account", "Account")

216 , ("account", "Account")

217+ , ("app", "App")

216 , ("bid", "Bid")

218 , ("bid", "Bid")

217 , ("billing", "Billing")

219 , ("billing", "Billing")

218 , ("busy", "Busy")

220 , ("busy", "Busy")

@@ -220,39 +222,40 @@ upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs

220 , ("click", "Click")

222 , ("click", "Click")

221 , ("client", "Client")

223 , ("client", "Client")

222 , ("config", "Config")

224 , ("config", "Config")

225+ , ("crawl", "Crawl")

223 , ("deal", "Deal")

226 , ("deal", "Deal")

224 , ("debug", "Debug")

227 , ("debug", "Debug")

225 , ("device", "Device")

228 , ("device", "Device")

226 , ("download", "Download")

229 , ("download", "Download")

227 , ("engine", "Engine")

230 , ("engine", "Engine")

228 , ("enterprise", "Enterprise")

231 , ("enterprise", "Enterprise")

232+ , ("error", "Error")

229 , ("info", "Info")

233 , ("info", "Info")

230 , ("library", "Library")

234 , ("library", "Library")

231 , ("list", "List")

235 , ("list", "List")

232− , ("([^ypn])load", "$1Load")

233 , ("manager", "Manager")

236 , ("manager", "Manager")

234 , ("model", "Model")

237 , ("model", "Model")

235 , ("monitor", "Monitor")

238 , ("monitor", "Monitor")

236 , ("note", "Note")

239 , ("note", "Note")

240+ , ("observe", "Observe")

237 , ("offer", "Offer")

241 , ("offer", "Offer")

242+ , ("order", "Order")

238 , ("part", "Part")

243 , ("part", "Part")

244+ , ("position", "Position")

245+ , ("product", "Product")

239 , ("proper", "Proper")

246 , ("proper", "Proper")

240 , ("publish", "Publish")

247 , ("publish", "Publish")

241 , ("resource", "Resource")

248 , ("resource", "Resource")

242 , ("round", "Round")

249 , ("round", "Round")

250+ , ("sample", "Sample")

243 , ("service", "Service")

251 , ("service", "Service")

252+ , ("session", "Session")

244 , ("state", "State")

253 , ("state", "State")

245 , ("transfer", "Transfer")

254 , ("transfer", "Transfer")

246 , ("unit", "Unit")

255 , ("unit", "Unit")

247 , ("upload", "Upload")

256 , ("upload", "Upload")

248 , ("user", "User")

257 , ("user", "User")

249− , ("observe", "Observe")

258+ , ("file", "File")

250− , ("order", "Order")

251− , ("position", "Position")

252− , ("crawl", "Crawl")

253− , ("error", "Error")

254− , ("sample", "Sample")

255− , ("session", "Session")

256 ]

259 ]

257

260

258acronyms :: [(String, String)]

261acronyms :: [(String, String)]

gen/src/Gen/Types/Id.hs+14−1

@@ -26,6 +26,7 @@ module Gen.Types.Id

26 , global

27 , local

29+ , abbreviate

29 , globalise

30 , globalise

30 , localise

31 , localise

@@ -126,7 +127,14 @@ newtype Prefix = Prefix Text

126 deriving (Show, Monoid)

127 deriving (Show, Monoid)

127

128

128newtype Global = Global [Text]

129newtype 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)

130

138

131instance IsString Global where

139instance IsString Global where

132 fromString = mkGlobal . fromString

140 fromString = mkGlobal . fromString

@@ -164,6 +172,11 @@ reference (Global g) (Local l) = Global

164 . filter (not . Text.null)

172 . filter (not . Text.null)

165 $ Text.split (== '.') l

173 $ Text.split (== '.') l

166

174

175+abbreviate :: Global -> Global

176+abbreviate (Global g)

177+ | length g > 2 = Global (drop 1 g)

178+ | otherwise = Global g

179+

167localise :: Global -> Local

180localise :: Global -> Local

168localise = Local . global

181localise = Local . global

169

182

gen/src/Gen/Types/Schema.hs+8−1

@@ -31,6 +31,7 @@ import Data.Aeson hiding (Array, Bool, Object, String)

31import qualified Data.Aeson as A

32import Data.Aeson.TH

33import Data.Aeson.Types (Parser)

34+import Data.Function (on)

34import qualified Data.HashMap.Strict as Map

35import qualified Data.HashMap.Strict as Map

35import Data.Maybe

36import Data.Maybe

36import Data.Semigroup ((<>))

37import Data.Semigroup ((<>))

@@ -72,10 +73,16 @@ data Info = Info

72 , _iMaximum :: Maybe Text

73 , _iMaximum :: Maybe Text

73 , _iRepeated :: Bool

74 , _iRepeated :: Bool

74 , _iAnnotations :: Ann

75 , _iAnnotations :: Ann

75− } deriving (Eq, Show)

76+ } deriving (Show)

77makeClassy ''Info

78makeClassy ''Info

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+

79instance FromJSON Info where

86instance FromJSON Info where

80 parseJSON = withObject "info" $ \o -> Info

87 parseJSON = withObject "info" $ \o -> Info

81 <$> o .:? "id"

88 <$> o .:? "id"