72a9840 · gogol · git.iko.soy

git.iko.soy/gogol

Ensuring enums and other schema types are parsed before literals

commit72a98409f025ae1124b24c4dc6b0e2e6965174c4 authorBrendan Hay <brendan.g.hay@gmail.com> dateWed 30 Sep 2015, 16:11 (11 years ago) parent7901693

11 files changed+128−111

compare with develop

unifiedsplit

gen/src/Gen/AST/Flatten.hs+23−15 gen/src/Gen/AST/Render.hs+22−20 gen/src/Gen/AST/Solve.hs+2−2 gen/src/Gen/Syntax.hs+48−48 gen/src/Gen/Text.hs+1−1 gen/src/Gen/Tree.hs+3−2 gen/src/Gen/Types.hs+6−2 gen/src/Gen/Types/Data.hs+1−11 gen/src/Gen/Types/Id.hs+19−8 gen/src/Gen/Types/Schema.hs+2−2 gen/template/action.ede+1

gen/src/Gen/AST/Flatten.hs+23−15

@@ -35,6 +35,7 @@ import qualified Data.Text as Text

3535import qualified Data.Text.Lazy as LText

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

3737import Debug.Trace

38+import Debug.Trace

3839import Gen.Formatting

3940import Gen.Types

4041import HIndent

@@ -44,13 +45,17 @@ import Prelude hiding (sum)

4445

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

4647flatten s = do

47− ss <- Map.traverseWithKey globalSchema (s ^. dSchemas)

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

49− rs <- Map.traverseWithKey (resource ps) (s ^. dResources)

50− ms <- traverse (method ps) (s ^. dMethods)

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

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

50+

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

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

53+

54+ -- The horror.

55+ ss <- use schemas

5156

5257 let d = (s ^. sDescription)

53− { _dSchemas = ss

58+ { _dSchemas = Map.fromList $ map (join (,)) (Map.keys ss)

5459 , _dParameters = ps

5560 , _dResources = rs

5661 , _dMethods = ms

@@ -80,13 +85,13 @@ schema g ml (Fix f) = go f >>= insert this

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

8186

8287 array (Arr e) =

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

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

8489

8590 object (Obj aps ps) =

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

8792

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

89−globalParam = localParam "param"

94+globalParam = localParam ""

9095

9196localParam :: Global -> Local -> Param (Fix Schema) -> AST (Param Global)

9297localParam g l p = do

@@ -94,28 +99,31 @@ localParam g l p = do

9499 pure $! p { _pParam = x }

95100

96101resource :: Map Local (Param Global)

102+ -> Suffix

97103 -> Global

98104 -> Resource (Fix Schema)

99105 -> AST (Resource Global)

100−resource qs g r@Resource {..} = do

101− rs <- Map.traverseWithKey (\l -> resource qs (reference g l)) _rResources

102− ms <- traverse (method qs) _rMethods

106+resource qs suf g r@Resource {..} = do

107+ rs <- Map.traverseWithKey (\l -> resource qs suf (reference g l)) _rResources

108+ ms <- traverse (method qs suf) _rMethods

103109 pure $! r

104110 { _rResources = rs

105111 , _rMethods = ms

106112 }

107113

108114method :: Map Local (Param Global)

115+ -> Suffix

109116 -> Method (Fix Schema)

110117 -> AST (Method Global)

111−method qs m@Method {..} = do

118+method qs suf m@Method {..} = do

112119 ps <- Map.traverseWithKey (localParam _mId) _mParameters

113120 cn <- use sCanonicalName

114− let (_, typ, _) = mname cn _mId

115− void $ insert typ (fresh ps)

116− pure $! m { _mParameters = ps }

121+ let (_, typ, _) = mname cn suf _mId

122+ params = ps <> qs

123+ void $ insert typ (fresh params)

124+ pure $! m { _mParameters = params }

117125 where

118− fresh ps = SObj info' $ Obj Nothing (Map.map _pParam (ps <> qs))

126+ fresh ps = SObj info' $ Obj Nothing (Map.map _pParam ps)

119127

120128 info' = Info

121129 { _iId = Nothing

gen/src/Gen/AST/Render.hs+22−20

@@ -55,13 +55,14 @@ import Prelude hiding (sum)

5555render :: Service Solved -> AST (API, [Data])

5656render s = do

5757 a <- renderAPI s

58− ds <- traverse renderSchema (Map.elems (s ^. dSchemas)) <&> catMaybes

59− pure (a, ds)

6058

61− -- FIXME: filter out action/methods types

62−-- let as = map actionTypeName (Map.elems (_apiActions y))

63−-- f d = elem (dataName d) as

64−-- z = trace (show as) $ filter (not . f) (catMaybes x)

59+ let actions = map _actType (_apiResources a <> _apiMethods a)

60+ valid = Map.keys . Map.filter (\v -> _unique v `notElem` actions)

61+

62+ ss <- traverse getSolved $ valid (s ^. dSchemas)

63+ ds <- traverse renderSchema ss <&> catMaybes

64+

65+ pure (a, ds)

6566

6667renderSchema :: Solved -> AST (Maybe Data)

6768renderSchema s = go (_schema s)

@@ -99,18 +100,18 @@ renderSchema s = go (_schema s)

99100 "' with the minimum fields required to make a request.\n")

100101 k

101102

102−renderMethod :: Service a -> Method Solved -> AST Action

103−renderMethod s m@Method {..} = do

103+renderMethod :: Service a -> NS -> Suffix -> Method Solved -> AST Action

104+renderMethod s root suf m@Method {..} = do

104105 x@Solved {..} <- getSolved typ

105106 Just d <- renderSchema x

106107

107108 i <- pp Print $ requestDecl _unique _prefix alias url (props _schema) m

108109

109− Action _mId (mkNS ns) _mDescription alias

110+ Action _mId _unique (root <> mkNS ns) _mDescription alias

110111 <$> pp Print (verbAlias alias m)

111112 <*> pure (insts [i] d)

112113 where

113− (alias, typ, ns) = mname (_sCanonicalName s) _mId

114+ (alias, typ, ns) = mname (_sCanonicalName s) suf _mId

114115

115116 url = name (Text.unpack (urlName s))

116117

@@ -122,25 +123,26 @@ renderMethod s m@Method {..} = do

122123 SObj _ (Obj _ ps) -> Map.keys ps

123124 _ -> mempty

124125

125−renderResource :: Service a -> Resource Solved -> AST [Action]

126−renderResource s Resource {..} =

126+renderResource :: Service a -> NS -> Suffix -> Resource Solved -> AST [Action]

127+renderResource s root suf Resource {..} =

127128 liftA2 (<>)

128− (traverse (renderResource s) (Map.elems _rResources) <&> concat)

129− (traverse (renderMethod s) _rMethods)

129+ (traverse (renderResource s root suf) (Map.elems _rResources) <&> concat)

130+ (traverse (renderMethod s root suf) _rMethods)

130131

131132renderAPI :: Service Solved -> AST API

132133renderAPI s = do

133− rs <- traverse (renderResource s) (Map.elems (s ^. dResources)) <&> concat

134− ms <- traverse (renderMethod s) (s ^. dMethods)

135− d <- pp Print (apiAlias alias names)

134+ rs <- traverse (renderResource s resourceNS "Resource")

135+ (Map.elems (s ^. dResources)) <&> concat

136+

137+ ms <- traverse (renderMethod s methodNS "Method")

138+ (s ^. dMethods)

139+

140+ d <- pp Print $ apiAlias alias (map _actAliasName (rs <> ms))

136141

137142 API alias d rs ms <$> serviceURL

138143 where

139144 alias = aname (_sCanonicalName s)

140145

141− names = map _mId (s ^. dMethods)

142− <> Map.keys (s ^. dResources)

143−

144146 url = name (Text.unpack (urlName s))

145147

146148 serviceURL = Fun' url (Just (rawHelpText h))

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

@@ -83,14 +83,14 @@ getSchema g = do

8383 Just x -> pure x

8484 Nothing -> throwError $

8585 format ("Missing Schema: " % gid % "\n" % shown)

86− g (map global (Map.keys ss))

86+ g (map dname (Map.keys ss))

8787

8888getType :: Global -> AST TType

8989getType g = loc "getType" g $ memo typed g go

9090 where

9191 go s = fmap (may s) $

9292 case s of

93− SAny {} -> pure (TType "JSON")

93+ SAny {} -> pure (TType "JSONValue")

9494 SRef _ r -> getType (ref r)

9595 --- FIXME: add natural/numeric manipulations

9696 SLit _ l -> pure (TLit l)

gen/src/Gen/Syntax.hs+48−48

@@ -32,7 +32,7 @@ import Language.Haskell.Exts.SrcLoc

3232import Language.Haskell.Exts.Syntax hiding (Int, Lit)

3333

3434urlSig :: Name -> Decl

35−urlSig n = TypeSig noLoc [n] (tycon "BaseUrl")

35+urlSig n = TypeSig noLoc [n] (TyCon "BaseUrl")

3636

3737urlDecl :: Name -> String -> Text -> Integer -> Decl

3838urlDecl n s u p = sfun noLoc n [] (UnGuardedRhs rhs) noBinds

@@ -40,10 +40,10 @@ urlDecl n s u p = sfun noLoc n [] (UnGuardedRhs rhs) noBinds

4040 rhs = appFun (var "BaseUrl") [var (name s), str u, intE p]

4141

4242 -- type API = :<|> ...

43−apiAlias :: Name -> [Global] -> Decl

43+apiAlias :: Name -> [Name] -> Decl

4444apiAlias n ls = TypeDecl noLoc n [] alias

4545 where

46− alias = case map tycon ls of

46+ alias = case map (TyCon . UnQual) ls of

4747 [] -> unit_tycon

4848 x:xs -> foldl' (\l r -> TyInfix l (UnQual (sym ":<|>")) r) x xs

4949

@@ -67,7 +67,7 @@ verbAlias n m = TypeDecl noLoc n [] alias

6767 , c == '{'

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

6969 , _pLocation k == Path

70− = TyApp (TyApp (tycon "Capture")

70+ = TyApp (TyApp (TyCon "Capture")

7171 (sing (Text.init t)))

7272 (terminalType (_type (_pParam k)))

7373 | otherwise = sing x

@@ -81,8 +81,8 @@ verbAlias n m = TypeDecl noLoc n [] alias

8181 n = sing (local k)

8282 in case _pLocation x of

8383 Query | x ^. iRepeated

84− -> Just $ TyApp (TyApp (tycon "QueryParams") n) t

85− Query -> Just $ TyApp (TyApp (tycon "QueryParam") n) t

84+ -> Just $ TyApp (TyApp (TyCon "QueryParams") n) t

85+ Query -> Just $ TyApp (TyApp (TyCon "QueryParam") n) t

8686 Path -> Nothing

8787

8888 params = _mParameters m

@@ -91,8 +91,8 @@ verbAlias n m = TypeDecl noLoc n [] alias

9191 verb = TyApp (TyApp meth typ) res

9292 where

9393 meth = TyCon . unqual . Text.unpack $ Text.toTitle (_mHttpMethod m)

94− typ = tycon "'[JSON]"

95− res = maybe (tycon "()") (tycon . ref) (_mResponse m)

94+ typ = TyCon "'[JSON]"

95+ res = maybe (TyCon "()") (tycon . ref) (_mResponse m)

9696

9797requestDecl :: Global

9898 -> Prefix

@@ -108,7 +108,7 @@ requestDecl n p api url fs m =

108108 , requestWithRoute

109109 ]

110110 where

111− response = InsType noLoc (TyApp (tycon "Rs") (tycon n)) $

111+ response = InsType noLoc (TyApp (TyCon "Rs") (tycon n)) $

112112 maybe unit_tycon (tycon . ref) (_mResponse m)

113113

114114 request = funD "request" $

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

122122 [ patBind noLoc (pvar "go") $

123123 appFun (var "clientWithRoute") $

124124 [ ExpTypeSig noLoc (var "Proxy") $

125− TyApp (tycon "Proxy") (TyCon (UnQual api))

125+ TyApp (TyCon "Proxy") (TyCon (UnQual api))

126126 , var "r"

127127 , var "u"

128128 ]

@@ -142,13 +142,13 @@ requestDecl n p api url fs m =

142142 prec = PRec (UnQual (dname n)) [PFieldWildcard]

143143

144144jsonDecls :: Global -> Prefix -> Map Local Solved -> [Decl]

145−jsonDecls n p (Map.toList -> rs) = [from, to]

145+jsonDecls g p (Map.toList -> rs) = [from, to]

146146 where

147− from = InstDecl noLoc Nothing [] [] (unqual "FromJSON") [tycon n]

147+ from = InstDecl noLoc Nothing [] [] (unqual "FromJSON") [tycon g]

148148 [ funD "parseJSON" $

149− app (app (var "withObject") (str (global n))) $

149+ app (app (var "withObject") (dstr g)) $

150150 lamE noLoc [pvar "o"] $

151− ctorE n (map decode rs)

151+ ctorE g (map decode rs)

152152 ]

153153

154154 decode (l, s)

@@ -157,8 +157,8 @@ jsonDecls n p (Map.toList -> rs) = [from, to]

157157 | monoid s = defJS l (var "mempty")

158158 | otherwise = optJS l

159159

160− to = InstDecl noLoc Nothing [] [] (unqual "ToJSON") [tycon n]

161− [ wildcardD "toJSON" n omit none (map encode rs)

160+ to = InstDecl noLoc Nothing [] [] (unqual "ToJSON") [tycon g]

161+ [ wildcardD "toJSON" g omit none (map encode rs)

162162 ]

163163

164164 omit = app (var "object")

@@ -171,7 +171,7 @@ jsonDecls n p (Map.toList -> rs) = [from, to]

171171 | TMaybe {} <- _type s = infixApp (paren (app n o)) "<$>" a

172172 | otherwise = app (var "Just") (infixApp n ".=" a)

173173 where

174− n = str (local l)

174+ n = fstr l

175175 a = var (fname p l)

176176 o = var ".="

177177

@@ -191,13 +191,13 @@ wildcardD f n enc x = \case

191191 prec = PRec (UnQual (dname n)) [PFieldWildcard]

192192

193193defJS :: Local -> Exp -> Exp

194−defJS n x = infixApp (infixApp (var "o") ".:?" (str (local n))) ".!=" x

194+defJS n x = infixApp (infixApp (var "o") ".:?" (fstr n)) ".!=" x

195195

196196reqJS :: Local -> Exp

197−reqJS = infixApp (var "o") ".:" . str . local

197+reqJS = infixApp (var "o") ".:" . fstr

198198

199199optJS :: Local -> Exp

200−optJS = infixApp (var "o") ".:?" . str . local

200+optJS = infixApp (var "o") ".:?" . fstr

201201

202202funD :: String -> Exp -> InstDecl

203203funD f = InsDecl . patBind noLoc (pvar (name f))

@@ -263,7 +263,7 @@ fieldUpdate p l s = FieldUpdate (UnQual (fname p l)) rhs

263263

264264lensSig :: Global -> Prefix -> Local -> Solved -> Decl

265265lensSig n p l s = TypeSig noLoc [lname p l] $

266− TyApp (TyApp (tycon "Lens'") (tycon n))

266+ TyApp (TyApp (TyCon "Lens'") (tycon n))

267267 (externalType (_type s))

268268

269269lensDecl :: Prefix -> Local -> Solved -> Decl

@@ -305,46 +305,46 @@ externalType :: TType -> Type

305305externalType = \case

306306 TType r -> tycon r

307307 TMaybe t@TList {} -> externalType t

308− TMaybe t -> TyApp (tycon "Maybe") (externalType t)

308+ TMaybe t -> TyApp (TyCon "Maybe") (externalType t)

309309 TList t -> TyList (externalType t)

310310 TLit l -> externalLit l

311311

312312internalType :: TType -> Type

313313internalType = \case

314314 TType r -> tycon r

315− TMaybe t -> TyApp (tycon "Maybe") (internalType t)

315+ TMaybe t -> TyApp (TyCon "Maybe") (internalType t)

316316 TList t -> TyList (internalType t)

317317 TLit l -> internalLit l

318318

319319externalLit :: Lit -> Type

320320externalLit = \case

321− Text -> tycon "Text"

322− Bool -> tycon "Bool"

323− Time -> tycon "UTCTime"

324− Date -> tycon "UTCTime"

325− Nat -> tycon "Natural"

326− Float -> tycon "Float"

327− Double -> tycon "Double"

328− Byte -> tycon "Word8"

329− UInt32 -> tycon "Word32"

330− UInt64 -> tycon "Word64"

331− Int32 -> tycon "Int32"

332− Int64 -> tycon "Int64"

321+ Text -> TyCon "Text"

322+ Bool -> TyCon "Bool"

323+ Time -> TyCon "UTCTime"

324+ Date -> TyCon "UTCTime"

325+ Nat -> TyCon "Natural"

326+ Float -> TyCon "Float"

327+ Double -> TyCon "Double"

328+ Byte -> TyCon "Word8"

329+ UInt32 -> TyCon "Word32"

330+ UInt64 -> TyCon "Word64"

331+ Int32 -> TyCon "Int32"

332+ Int64 -> TyCon "Int64"

333333

334334internalLit :: Lit -> Type

335335internalLit = \case

336− Text -> tycon "Text"

337− Bool -> tycon "Bool"

338− Time -> tycon "UTCTime"

339− Date -> tycon "UTCTime"

340− Nat -> tycon "Nat"

341− Float -> tycon "Float"

342− Double -> tycon "Double"

343− Byte -> tycon "Word8"

344− UInt32 -> tycon "Word32"

345− UInt64 -> tycon "Word64"

346− Int32 -> tycon "Int32"

347− Int64 -> tycon "Int64"

336+ Text -> TyCon "Text"

337+ Bool -> TyCon "Bool"

338+ Time -> TyCon "UTCTime"

339+ Date -> TyCon "UTCTime"

340+ Nat -> TyCon "Nat"

341+ Float -> TyCon "Float"

342+ Double -> TyCon "Double"

343+ Byte -> TyCon "Word8"

344+ UInt32 -> TyCon "Word32"

345+ UInt64 -> TyCon "Word64"

346+ Int32 -> TyCon "Int32"

347+ Int64 -> TyCon "Int64"

348348

349349mapping :: TType -> Exp -> Exp

350350mapping t e = infixE e "." (go t)

@@ -372,7 +372,7 @@ sing :: Text -> Type

372372sing = TyCon . unqual . Text.unpack . flip mappend "\"" . mappend "\""

373373

374374tycon :: Global -> Type

375−tycon = TyCon . unqual . Text.unpack . global

375+tycon = TyCon . UnQual . dname

376376

377377unqual :: String -> QName

378378unqual = UnQual . name

gen/src/Gen/Text.hs+1−1

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

173173 , ("Raid", "RAID")

174174 , ("Ramdisk", "RAMDisk")

175175 , ("Sgd", "SGD")

176− , ("Sni", "SNI")

176+ , ("Sni([^p]|$)", "SNI$1")

177177 , ("Ssh", "SSH")

178178 , ("Ssl", "SSL")

179179 , ("Svn", "SVN")

gen/src/Gen/Tree.hs+3−2

@@ -87,11 +87,12 @@ populate d Templates {..} l = (encodeString d :/) . dir lib <$> layout

8787 ++ map method (_apiMethods (l ^. lAPI))

8888 ]

8989 where

90+ -- FIXME: now redundant

9091 resource a =

91− mod' (resourceNS a) actionImports actionTemplate (action a)

92+ mod' (_actNamespace a) actionImports actionTemplate (action a)

9293

9394 method a =

94− mod' (methodNS a) actionImports actionTemplate (action a)

95+ mod' (_actNamespace a) actionImports actionTemplate (action a)

9596

9697 action a =

9798 let Object o = object ["action" .= a]

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

@@ -165,12 +165,16 @@ sumNS = (<> "Sum") . typesNS

165165preludeNS :: NS

166166preludeNS = "Network.Google.Prelude"

167167

168+resourceNS, methodNS :: NS

169+resourceNS = "Network.Google.Resource"

170+methodNS = "Network.Google.Method"

171+

168172exposedModules :: Library -> [NS]

169173exposedModules l = sort $

170174 tocNS l

171175 : typesNS l

172− : map resourceNS (_apiResources (_lAPI l))

173− ++ map methodNS (_apiMethods (_lAPI l))

176+ : map _actNamespace (_apiResources (_lAPI l))

177+ ++ map _actNamespace (_apiMethods (_lAPI l))

174178

175179otherModules :: Library -> [NS]

176180otherModules s = sort [prodNS s, sumNS s]

gen/src/Gen/Types/Data.hs+1−11

@@ -119,6 +119,7 @@ dataName = \case

119119

120120data Action = Action

121121 { _actId :: Global

122+ , _actType :: Global

122123 , _actNamespace :: NS

123124 , _actHelp :: Maybe Help

124125 , _actAliasName :: Name

@@ -126,9 +127,6 @@ data Action = Action

126127 , _actData :: Data

127128 }

128129

129−actionTypeName :: Action -> Name

130−actionTypeName = dataName . _actData

131−

132130instance ToJSON Action where

133131 toJSON Action {..} = object

134132 [ "id" .= _actId

@@ -156,11 +154,3 @@ instance ToJSON API where

156154 , "methods" .= sortOn _actId _apiMethods

157155 , "url" .= _apiURL

158156 ]

159−

160−-- apiResourceNames, apiMethodNames :: API -> [Name]

161−-- apiResourceNames = map (dataName . _actData) . _apiResources

162−-- apiMethodNames = map (dataName . _actData) . _apiMethods

163−

164−resourceNS, methodNS :: Action -> NS

165−resourceNS = mappend "Network.Google.Resource" . _actNamespace

166−methodNS = mappend "Network.Google.Method" . _actNamespace

gen/src/Gen/Types/Id.hs+19−8

@@ -13,8 +13,9 @@

1313

1414module Gen.Types.Id

1515 (

16− -- * Property Prefixes

16+ -- * Properties

1717 Prefix (..)

18+ , Suffix (..)

1819

1920 -- * Unique Identifiers

2021 , Global

@@ -32,9 +33,11 @@ module Gen.Types.Id

3233 , aname

3334 , mname

3435 , dname

36+ , dstr

3537 , cname

3638 , bname

3739 , fname

40+ , fstr

3841 , lname

3942 , pname

4043 ) where

@@ -74,11 +77,11 @@ import Language.Haskell.Exts.Syntax (Name)

7477aname :: Text -> Name

7578aname = name . Text.unpack . (<> "API") . upperHead . Text.replace "." ""

7679

77−mname :: Text -> Global -> (Name, Global, Text)

78−mname abrv (Global g) =

79− ( aname (mconcat n) -- Action service type alias.

80− , Global (n <> ["'"]) -- Action data type.

81− , Text.intercalate "." ns -- Action namespace.

80+mname :: Text -> Suffix -> Global -> (Name, Global, Text)

81+mname abrv (Suffix suf) (Global g) =

82+ ( name . Text.unpack $ mconcat n <> suf -- Action service type alias.

83+ , Global (n <> ["'"]) -- Action data type.

84+ , Text.intercalate "." ns -- Action namespace.

8285 )

8386 where

8487 n = drop 1 (map (upperHead . upperAcronym) ns)

@@ -90,8 +93,8 @@ mname abrv (Global g) =

9093 x:xs = g

9194

9295dname, cname :: Global -> Name

93−dname = name . Text.unpack . toPascal . global

94−cname = name . Text.unpack . renameReserved . toCamel . global

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

97+cname = name . Text.unpack . renameReserved . lowerHead . global

9598

9699bname :: Prefix -> Text -> Name

97100bname (Prefix p) = name

@@ -104,9 +107,17 @@ fname = pre (Text.cons '_' . renameField)

104107lname = pre renameField

105108pname = pre (flip Text.snoc '_' . Text.cons 'p' . upperHead . renameField)

106109

110+--dstr :: Global ->

111+dstr = strE . Text.unpack . toPascal . global

112+

113+fstr = strE . Text.unpack . local

114+

107115pre :: (Text -> Text) -> Prefix -> Local -> Name

108116pre f (Prefix p) = name . Text.unpack . f . mappend p . upperHead . local

109117

118+newtype Suffix = Suffix Text

119+ deriving (Show, IsString)

120+

110121newtype Prefix = Prefix Text

111122 deriving (Show, Monoid)

112123

gen/src/Gen/Types/Schema.hs+2−2

@@ -126,11 +126,11 @@ instance FromJSON (Fix Schema) where

126126 parseJSON o = do

127127 i <- parseJSON o

128128 s <- SRef i <$> parseJSON o

129− <|> SAny i <$> parseJSON o

130− <|> SLit i <$> parseJSON o

131129 <|> SEnm i <$> parseJSON o

132130 <|> SArr i <$> parseJSON o

133131 <|> SObj i <$> parseJSON o

132+ <|> SLit i <$> parseJSON o

133+ <|> SAny i <$> parseJSON o

134134 pure (Fix s)

135135

136136instance HasInfo (Schema a) where

gen/template/action.ede+1

@@ -1,6 +1,7 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveDataTypeable #-}

33{-# LANGUAGE DeriveGeneric #-}

4+{-# LANGUAGE OverloadedStrings #-}

45{-# LANGUAGE RecordWildCards #-}

56{-# LANGUAGE TypeFamilies #-}

67{-# LANGUAGE TypeOperators #-}