f39eb32 · gogol · git.iko.soy

git.iko.soy/gogol

Ensuring non-ambiguous naming via dirty hacks

commitf39eb326d8d7c7e8a45182934c2f52de8561ae58 authorBrendan Hay <brendan.g.hay@gmail.com> dateSat 3 Oct 2015, 17:34 (11 years ago) parent58c1320

6 files changed+90−39

compare with develop

unifiedsplit

gen/src/Gen/AST/Flatten.hs+11−5 gen/src/Gen/AST/Render.hs+1 gen/src/Gen/AST/Solve.hs+7−7 gen/src/Gen/Syntax.hs+30−21 gen/src/Gen/Text.hs+6−2 gen/src/Gen/Types/Id.hs+35−4

gen/src/Gen/AST/Flatten.hs+11−5

@@ -36,11 +36,10 @@ import Prelude hiding (sum)

3636

3737flatten :: Service (Fix Schema) -> AST (Service Global)

3838flatten s = do

39− _ <- Map.traverseWithKey globalSchema (s ^. dSchemas)

4039 ps <- Map.traverseWithKey globalParam (s ^. dParameters)

41−

4240 rs <- Map.traverseWithKey (resource ps "Resource") (s ^. dResources)

4341 ms <- traverse (method ps "Method") (s ^. dMethods)

42+ _ <- Map.traverseWithKey globalSchema (s ^. dSchemas)

4443

4544 -- The horror.

4645 ss <- use schemas

@@ -58,7 +57,14 @@ globalSchema :: Global -> Fix Schema -> AST Global

5857globalSchema g = schema g Nothing

5958

6059localSchema :: 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?

6268

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

6470schema g ml (Fix f) = go f >>= insert this

@@ -76,7 +82,7 @@ schema g ml (Fix f) = go f >>= insert this

7682 SObj i o -> SObj i <$> object o

7783

7884 array (Arr e) =

79− Arr <$> localSchema this "" (setRequired e)

85+ Arr <$> localSchema this "item" (setRequired e)

8086

8187 object (Obj aps ps) =

8288 Obj Nothing <$> Map.traverseWithKey (localSchema this) ps

@@ -136,7 +142,7 @@ method qs suf m@Method {..} = do

136142 body p = case _mRequest of

137143 Nothing -> pure id

138144 Just x -> do

139− let f = localise (ref x)

145+ let f = "payload" -- localise (ref x)

140146 g <- localSchema p f (Fix (SRef bodyInfo x))

141147 pure (Map.insert f g)

142148

gen/src/Gen/AST/Render.hs+1

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

3333import qualified Data.Text as Text

3434import qualified Data.Text.Lazy as LText

3535import qualified Data.Text.Lazy.Builder as Build

36+import Debug.Trace

3637import Gen.AST.Solve (getSolved)

3738import Gen.Formatting

3839import Gen.Syntax

gen/src/Gen/AST/Solve.hs+7−7

@@ -117,21 +117,21 @@ getDerive g = loc "getDerive" g $ memo derived g go

117117 SObj _ (Obj _ ps) -> foldM props base (Map.elems ps)

118118

119119 literal = \case

120− Text -> base <> [DOrd, DIsString]

120+ Text -> base <> [DRead, DOrd, DIsString]

121121 Bool -> enum

122− Time -> base

123− Date -> base

122+ Time -> DRead : base

123+ Date -> DRead : base

124124 Body -> base

125− Alt _ -> base

126− Key -> base

125+ Alt _ -> DRead : base

126+ Key -> DRead : base

127127 -- FIXME: Add numeric cases

128− _ -> [DNum, DIntegral, DReal] <> enum

128+ _ -> [DRead, DNum, DIntegral, DReal] <> enum

129129

130130 props ds x = intersect ds <$> getDerive x

131131

132132 list = [DMonoid]

133133 enum = [DOrd, DEnum] <> base

134− base = [DEq, DRead, DShow, DData, DTypeable, DGeneric]

134+ base = [DEq, DShow, DData, DTypeable, DGeneric]

135135

136136getPrefix :: Global -> AST Prefix

137137getPrefix g = loc "getPrefix" g $ memo prefixed g go

gen/src/Gen/Syntax.hs+30−21

@@ -14,17 +14,18 @@ module Gen.Syntax where

1414

1515import Control.Lens hiding (iso, mapping, op, pre,

1616 strict)

17+import Data.Either

1718import Data.Foldable (find, foldl', foldr')

1819import Data.Hashable

1920import qualified Data.HashMap.Strict as Map

20−import Data.List (delete)

21−import Data.Maybe

21+import Data.List (delete, nub)

2222import Data.Maybe

2323import Data.Semigroup ((<>))

2424import Data.String

2525import Data.Text (Text)

2626import qualified Data.Text as Text

2727import Data.Text.Manipulate

28+import Debug.Trace

2829import Gen.Orphans

2930import Gen.Text

3031import Gen.Types

@@ -56,26 +57,31 @@ verbAlias n m

5657 where

5758 rest = alias verb (path ++ qry params ++ media)

5859 download = TyInfix rest (UnQual (sym ":<|>")) $

59− alias (TyApp (TyApp meth octet) (TyCon "Stream"))

60+ alias (TyApp (TyApp meth octet) (TyCon "Body"))

6061 (path ++ qry (Map.delete "alt" (_mParameters m)) ++ [alt] ++ media)

6162

6263 alias = foldr' (\l r -> TyInfix l (UnQual (sym ":>")) r)

6364

6465 path :: [Type]

65− path = map match

66− . filter (not . Text.null)

67− $ Text.split (== '/') (_mPath m)

66+ path = map match $ extractPath (_mPath m)

6867 where

69− -- FIXME: should error if '{' '}' is found and cannot find the ref.

70− match x

71− | Just (c, t) <- Text.uncons x

72− , c == '{'

73− , Just k <- Map.lookup (toKey (Text.init t)) params

74− , _pLocation k == Path

75− = TyApp (TyApp (TyCon "Capture")

76− (sing (Text.init t)))

77− (terminalType (_type (_pParam k)))

78− | otherwise = sing x

68+ match (Left t) = sing t

69+ match (Right (l, c)) =

70+ case Map.lookup l (_mParameters m) of

71+ Nothing -> error $ "Unable to find path parameter " ++ show l

72+ Just x ->

73+ case c of

74+ Nothing ->

75+ TyApp (TyApp (TyCon "Capture")

76+ (sing (local l)))

77+ (terminalType (_type (_pParam x)))

78+

79+ Just y ->

80+ TyApp (TyApp (TyApp (TyCon "CaptureMode")

81+ (sing (local l)))

82+ (sing y))

83+ (terminalType (_type (_pParam x)))

84+

7985

8086 qry xs = mapMaybe f $ orderParams fst (Map.toList xs) (_mParameterOrder m)

8187 where

@@ -106,9 +112,9 @@ verbAlias n m

106112 octet = tylist ["OctetStream"]

107113 json = tylist ["JSON"]

108114

109− alt = TyApp (TyApp (TyCon "QueryParam") (sing "alt")) (TyCon "Media")

115+ alt = TyApp (TyApp (TyCon "QueryParam") (sing "alt")) (TyCon "AltMedia")

110116

111− params = _mParameters m

117+ params = Map.filter ((/= Path) . _pLocation) (_mParameters m)

112118

113119downloadDecl :: Global

114120 -> Prefix

@@ -122,7 +128,7 @@ downloadDecl n p api url fs m =

122128 where

123129 rs = InsType noLoc

124130 (TyApp (TyCon "Rs") (TyApp (TyCon "Download") (tycon n)))

125− (TyCon "Stream")

131+ (TyCon "Body")

126132

127133 alt = Just (var "Media")

128134

@@ -191,10 +197,13 @@ googleRequestDecl g n assoc alt p api url fields m =

191197 ps = _mParameters m

192198 v = var . fname p

193199

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")

195201 | otherwise = (fs, Nothing)

196202

197− fs = orderParams id fields (_mParameterOrder m)

203+ fs = delete "alt"

204+ . orderParams id (Map.keys (_mParameters m))

205+ . nub

206+ $ map fst (rights (extractPath (_mPath m))) ++ _mParameterOrder m

198207

199208 pats = [pvar "r", pvar "u", prec]

200209 prec = PRec (UnQual (dname g)) [PFieldWildcard]

gen/src/Gen/Text.hs+6−2

@@ -117,10 +117,13 @@ renameReserved x

117117 , "object"

118118 , "get"

119119 , "group"

120− , "error"

121120 , "True"

122121 , "False"

122+ , "error"

123123 , "Error"

124+ , "read"

125+ , "Read"

126+ , "request"

124127 ] ++ map Text.pack (reservedNames haskellDef)

125128

126129camelAcronym :: Text -> Text

@@ -204,6 +207,7 @@ upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs

204207 , ("Oob", "OOB")

205208 , ("Jwk", "JWK")

206209 , ("Dto", "DTO")

210+ , ("Sku", "SKU")

207211

208212 , ("access", "Access")

209213 , ("account", "Account")

@@ -223,7 +227,7 @@ upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs

223227 , ("info", "Info")

224228 , ("library", "Library")

225229 , ("list", "List")

226− , ("([^pn])load", "$1Load")

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

227231 , ("manager", "Manager")

228232 , ("model", "Model")

229233 , ("monitor", "Monitor")

gen/src/Gen/Types/Id.hs+35−4

@@ -4,6 +4,7 @@

44{-# LANGUAGE LambdaCase #-}

55{-# LANGUAGE OverloadedStrings #-}

66{-# LANGUAGE ScopedTypeVariables #-}

7+{-# LANGUAGE ViewPatterns #-}

89-- Module : Gen.Types.Id

@@ -24,6 +25,8 @@ module Gen.Types.Id

2425

2526 , global

2627 , local

28+

29+ , globalise

2730 , localise

2831

2932 , gid

@@ -31,6 +34,8 @@ module Gen.Types.Id

3134

3235 , reference

3336

37+ -- FIXME: move these

38+ , extractPath

3439 , orderParams

3540

3641 -- * Naming

@@ -52,7 +57,9 @@ import qualified Data.CaseInsensitive as CI

5257import Data.Coerce

5358import Data.Foldable (foldl')

5459import Data.Hashable

55−import Data.List (elemIndex, sortOn)

60+import Data.List (elemIndex, nub, sortOn)

61+import Data.Maybe

62+import Data.Ord

5663import Data.Semigroup hiding (Sum)

5764import Data.String

5865import Data.Text (Text)

@@ -86,7 +93,7 @@ mname abrv (Suffix suf) (Global g) =

8693 x:xs = map (upperAcronym . toPascal) g

8794

8895dname, cname :: Global -> Name

89−dname = name . Text.unpack . upperHead . global

96+dname = name . Text.unpack . renameReserved . upperHead . global

9097cname = name . Text.unpack . renameReserved . lowerHead . lowerFirstAcronym . global

9198

9299bname :: Prefix -> Text -> Name

@@ -149,15 +156,39 @@ global :: Global -> Text

149156global (Global g) = foldMap (upperAcronym . upperHead) g

150157

151158reference :: 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

153163

154164localise :: Global -> Local

155165localise = Local . global

156166

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+

157188orderParams :: (a -> Local) -> [a] -> [Local] -> [a]

158189orderParams f xs ys = orderBy f zs (del zs [] ++ global)

159190 where

160− zs = orderBy f (sortOn f xs) ys

191+ zs = orderBy f (sortOn f xs) (nub (ys ++ map f xs))

161192

162193 del _ [] = []

163194 del [] rs = reverse rs