2
0

Importer-Exporter.st 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822
  1. Smalltalk current createPackage: 'Importer-Exporter'!
  2. Object subclass: #AbstractExporter
  3. instanceVariableNames: ''
  4. package: 'Importer-Exporter'!
  5. !AbstractExporter commentStamp!
  6. I am an abstract exporter for Amber source code.
  7. ## API
  8. Use `#exportPackage:on:` to export a given package on a Stream.!
  9. !AbstractExporter methodsFor: 'accessing'!
  10. extensionMethodsOfPackage: aPackage
  11. | result |
  12. result := OrderedCollection new.
  13. (self extensionProtocolsOfPackage: aPackage) do: [ :each |
  14. result addAll: each methods ].
  15. ^ result
  16. !
  17. extensionProtocolsOfPackage: aPackage
  18. | extensionName result |
  19. extensionName := '*', aPackage name.
  20. result := OrderedCollection new.
  21. "The classes must be loaded since it is extensions only.
  22. Therefore sorting (dependency resolution) does not matter here.
  23. Not sorting improves the speed by a number of magnitude."
  24. Smalltalk current classes do: [ :each |
  25. {each. each class} do: [ :behavior |
  26. (behavior protocols includes: extensionName) ifTrue: [
  27. result add: (ExportMethodProtocol name: extensionName theClass: behavior) ] ] ].
  28. ^result
  29. ! !
  30. !AbstractExporter methodsFor: 'convenience'!
  31. chunkEscape: aString
  32. "Replace all occurrences of !! with !!!! and trim at both ends."
  33. ^(aString replace: '!!' with: '!!!!') trimBoth
  34. !
  35. classNameFor: aClass
  36. ^aClass isMetaclass
  37. ifTrue: [ aClass instanceClass name, ' class' ]
  38. ifFalse: [
  39. aClass isNil
  40. ifTrue: [ 'nil' ]
  41. ifFalse: [ aClass name ] ]
  42. ! !
  43. !AbstractExporter methodsFor: 'output'!
  44. exportPackage: aPackage on: aStream
  45. self subclassResponsibility
  46. ! !
  47. AbstractExporter subclass: #ChunkExporter
  48. instanceVariableNames: ''
  49. package: 'Importer-Exporter'!
  50. !ChunkExporter commentStamp!
  51. I am an exporter dedicated to outputting Amber source code in the classic Smalltalk chunk format.
  52. I do not output any compiled code.!
  53. !ChunkExporter methodsFor: 'accessing'!
  54. extensionCategoriesOfPackage: aPackage
  55. "Issue #143: sort protocol alphabetically"
  56. | name map result |
  57. name := aPackage name.
  58. result := OrderedCollection new.
  59. (Package sortedClasses: Smalltalk current classes) do: [ :each |
  60. {each. each class} do: [ :aClass |
  61. map := Dictionary new.
  62. aClass protocolsDo: [ :category :methods |
  63. category = ('*', name) ifTrue: [ map at: category put: methods ] ].
  64. result addAll: ((map keys sorted: [:a :b | a <= b ]) collect: [ :category |
  65. MethodCategory name: category theClass: aClass methods: (map at: category) ]) ] ].
  66. ^result
  67. !
  68. methodsOfCategory: aCategory
  69. "Issue #143: sort methods alphabetically"
  70. ^(aCategory methods) sorted: [ :a :b | a selector <= b selector ]
  71. !
  72. ownCategoriesOfClass: aClass
  73. "Answer the protocols of aClass that are not package extensions"
  74. "Issue #143: sort protocol alphabetically"
  75. | map |
  76. map := Dictionary new.
  77. aClass protocolsDo: [ :each :methods |
  78. (each match: '^\*') ifFalse: [ map at: each put: methods ] ].
  79. ^(map keys sorted: [:a :b | a <= b ]) collect: [ :each |
  80. MethodCategory name: each theClass: aClass methods: (map at: each) ]
  81. !
  82. ownCategoriesOfMetaClass: aClass
  83. "Issue #143: sort protocol alphabetically"
  84. ^self ownCategoriesOfClass: aClass class
  85. !
  86. ownMethodProtocolsOfClass: aClass
  87. "Answer a collection of ExportMethodProtocol object of aClass that are not package extensions"
  88. ^ aClass ownProtocols collect: [ :each |
  89. ExportMethodProtocol name: each theClass: aClass ]
  90. ! !
  91. !ChunkExporter methodsFor: 'output'!
  92. exportCategoryEpilogueOf: aCategory on: aStream
  93. aStream nextPutAll: ' !!'; lf; lf
  94. !
  95. exportCategoryPrologueOf: aCategory on: aStream
  96. aStream
  97. nextPutAll: '!!', (self classNameFor: aCategory theClass);
  98. nextPutAll: ' methodsFor: ''', aCategory name, '''!!'
  99. !
  100. exportDefinitionOf: aClass on: aStream
  101. "Chunk format."
  102. aStream
  103. nextPutAll: (self classNameFor: aClass superclass);
  104. nextPutAll: ' subclass: #', (self classNameFor: aClass); lf;
  105. tab; nextPutAll: 'instanceVariableNames: '''.
  106. aClass instanceVariableNames
  107. do: [:each | aStream nextPutAll: each]
  108. separatedBy: [aStream nextPutAll: ' '].
  109. aStream
  110. nextPutAll: ''''; lf;
  111. tab; nextPutAll: 'package: ''', aClass category, '''!!'; lf.
  112. aClass comment notEmpty ifTrue: [
  113. aStream
  114. nextPutAll: '!!', (self classNameFor: aClass), ' commentStamp!!';lf;
  115. nextPutAll: (self chunkEscape: aClass comment), '!!';lf].
  116. aStream lf
  117. !
  118. exportMetaDefinitionOf: aClass on: aStream
  119. aClass class instanceVariableNames isEmpty ifFalse: [
  120. aStream
  121. nextPutAll: (self classNameFor: aClass class);
  122. nextPutAll: ' instanceVariableNames: '''.
  123. aClass class instanceVariableNames
  124. do: [:each | aStream nextPutAll: each]
  125. separatedBy: [aStream nextPutAll: ' '].
  126. aStream
  127. nextPutAll: '''!!'; lf; lf]
  128. !
  129. exportMethod: aMethod on: aStream
  130. aStream
  131. lf; lf; nextPutAll: (self chunkEscape: aMethod source); lf;
  132. nextPutAll: '!!'
  133. !
  134. exportPackage: aPackage on: aStream
  135. self exportPackageDefinitionOf: aPackage on: aStream.
  136. aPackage sortedClasses do: [ :each |
  137. self exportDefinitionOf: each on: aStream.
  138. self
  139. exportProtocols: (self ownMethodProtocolsOfClass: each)
  140. on: aStream.
  141. self exportMetaDefinitionOf: each on: aStream.
  142. self
  143. exportProtocols: (self ownMethodProtocolsOfClass: each class)
  144. on: aStream ].
  145. self
  146. exportProtocols: (self extensionProtocolsOfPackage: aPackage)
  147. on: aStream
  148. !
  149. exportPackageDefinitionOf: aPackage on: aStream
  150. aStream
  151. nextPutAll: 'Smalltalk current createPackage: ''', aPackage name, '''!!';
  152. lf
  153. !
  154. exportProtocol: aProtocol on: aStream
  155. self exportProtocolPrologueOf: aProtocol on: aStream.
  156. aProtocol methods do: [ :method |
  157. self exportMethod: method on: aStream ].
  158. self exportProtocolEpilogueOf: aProtocol on: aStream
  159. !
  160. exportProtocolEpilogueOf: aProtocol on: aStream
  161. aStream nextPutAll: ' !!'; lf; lf
  162. !
  163. exportProtocolPrologueOf: aProtocol on: aStream
  164. aStream
  165. nextPutAll: '!!', (self classNameFor: aProtocol theClass);
  166. nextPutAll: ' methodsFor: ''', aProtocol name, '''!!'
  167. !
  168. exportProtocols: aCollection on: aStream
  169. aCollection do: [ :each |
  170. self exportProtocol: each on: aStream ]
  171. ! !
  172. AbstractExporter subclass: #Exporter
  173. instanceVariableNames: ''
  174. package: 'Importer-Exporter'!
  175. !Exporter commentStamp!
  176. I am responsible for outputting Amber code into a JavaScript string.
  177. The generated output is enough to reconstruct the exported data, including Smalltalk source code and other metadata.
  178. ## Use case
  179. I am typically used to save code outside of the Amber runtime (committing to disk, etc.).!
  180. !Exporter methodsFor: 'accessing'!
  181. ownMethodsOfClass: aClass
  182. "Issue #143: sort methods alphabetically"
  183. ^((aClass methodDictionary values) sorted: [:a :b | a selector <= b selector])
  184. reject: [:each | (each category match: '^\*')]
  185. !
  186. ownMethodsOfMetaClass: aClass
  187. "Issue #143: sort methods alphabetically"
  188. ^self ownMethodsOfClass: aClass class
  189. ! !
  190. !Exporter methodsFor: 'convenience'!
  191. classNameFor: aClass
  192. ^aClass isMetaclass
  193. ifTrue: [ aClass instanceClass name, '.klass' ]
  194. ifFalse: [
  195. aClass isNil
  196. ifTrue: [ 'nil' ]
  197. ifFalse: [ aClass name ] ]
  198. ! !
  199. !Exporter methodsFor: 'output'!
  200. exportDefinitionOf: aClass on: aStream
  201. aStream
  202. lf;
  203. nextPutAll: 'smalltalk.addClass(';
  204. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  205. nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
  206. nextPutAll: ', ['.
  207. aClass instanceVariableNames
  208. do: [:each | aStream nextPutAll: '''', each, '''']
  209. separatedBy: [aStream nextPutAll: ', '].
  210. aStream
  211. nextPutAll: '], ''';
  212. nextPutAll: aClass category, '''';
  213. nextPutAll: ');'.
  214. aClass comment notEmpty ifTrue: [
  215. aStream
  216. lf;
  217. nextPutAll: 'smalltalk.';
  218. nextPutAll: (self classNameFor: aClass);
  219. nextPutAll: '.comment=';
  220. nextPutAll: aClass comment asJavascript;
  221. nextPutAll: ';'].
  222. aStream lf
  223. !
  224. exportMetaDefinitionOf: aClass on: aStream
  225. aStream lf.
  226. aClass class instanceVariableNames isEmpty ifFalse: [
  227. aStream
  228. nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
  229. nextPutAll: '.iVarNames = ['.
  230. aClass class instanceVariableNames
  231. do: [:each | aStream nextPutAll: '''', each, '''']
  232. separatedBy: [aStream nextPutAll: ','].
  233. aStream nextPutAll: '];', String lf]
  234. !
  235. exportMethod: aMethod on: aStream
  236. aStream
  237. nextPutAll: 'smalltalk.addMethod(';lf;
  238. "nextPutAll: aMethod selector asSelector asJavascript, ',';lf;"
  239. nextPutAll: 'smalltalk.method({';lf;
  240. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  241. nextPutAll: 'category: ''', aMethod category, ''',';lf;
  242. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  243. nextPutAll: 'args: ', aMethod arguments asJavascript, ','; lf;
  244. nextPutAll: 'source: ', aMethod source asJavascript, ',';lf;
  245. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',';lf;
  246. nextPutAll: 'referencedClasses: ', aMethod referencedClasses asJavascript.
  247. aStream
  248. lf;
  249. nextPutAll: '}),';lf;
  250. nextPutAll: 'smalltalk.', (self classNameFor: aMethod methodClass);
  251. nextPutAll: ');';lf;lf
  252. !
  253. exportPackage: aPackage on: aStream
  254. self
  255. exportPackagePrologueOf: aPackage on: aStream;
  256. exportPackageDefinitionOf: aPackage on: aStream;
  257. exportPackageTransportOf: aPackage on: aStream.
  258. aPackage sortedClasses do: [ :each |
  259. self exportDefinitionOf: each on: aStream.
  260. each ownMethods do: [ :method |
  261. self exportMethod: method on: aStream ].
  262. self exportMetaDefinitionOf: each on: aStream.
  263. each class ownMethods do: [ :method |
  264. self exportMethod: method on: aStream ] ].
  265. (self extensionMethodsOfPackage: aPackage) do: [ :each |
  266. self exportMethod: each on: aStream ].
  267. self exportPackageEpilogueOf: aPackage on: aStream
  268. !
  269. exportPackageDefinitionOf: aPackage on: aStream
  270. aStream
  271. nextPutAll: 'smalltalk.addPackage(';
  272. nextPutAll: '''', aPackage name, ''');';
  273. lf
  274. !
  275. exportPackageEpilogueOf: aPackage on: aStream
  276. aStream
  277. nextPutAll: '})(global_smalltalk,global_nil,global__st);';
  278. lf
  279. !
  280. exportPackagePrologueOf: aPackage on: aStream
  281. aStream
  282. nextPutAll: '(function(smalltalk,nil,_st){';
  283. lf
  284. !
  285. exportPackageTransportOf: aPackage on: aStream
  286. aStream
  287. nextPutAll: 'smalltalk.packages[';
  288. nextPutAll: aPackage name asJavascript;
  289. nextPutAll: '].transport = ';
  290. nextPutAll: aPackage transport asJSONString;
  291. nextPutAll: ';';
  292. lf
  293. ! !
  294. Exporter subclass: #AmdExporter
  295. instanceVariableNames: 'namespace'
  296. package: 'Importer-Exporter'!
  297. !AmdExporter commentStamp!
  298. I am used to export Packages in an AMD (Asynchronous Module Definition) JavaScript format.!
  299. !AmdExporter methodsFor: 'output'!
  300. exportPackageEpilogueOf: aPackage on: aStream
  301. aStream
  302. nextPutAll: '});';
  303. lf
  304. !
  305. exportPackagePrologueOf: aPackage on: aStream
  306. aStream
  307. nextPutAll: 'define("';
  308. nextPutAll: (self amdNamespaceOfPackage: aPackage);
  309. nextPutAll: '/';
  310. nextPutAll: aPackage name;
  311. nextPutAll: '", ';
  312. nextPutAll: (#('amber_vm/smalltalk' 'amber_vm/nil' 'amber_vm/_st'), (self amdNamesOfPackages: aPackage loadDependencies)) asJavascript;
  313. nextPutAll: ', function(smalltalk,nil,_st){';
  314. lf
  315. ! !
  316. !AmdExporter methodsFor: 'private'!
  317. amdNamesOfPackages: anArray
  318. ^ (anArray
  319. select: [ :each | (self amdNamespaceOfPackage: each) notNil ])
  320. collect: [ :each | (self amdNamespaceOfPackage: each), '/', each name ]
  321. !
  322. amdNamespaceOfPackage: aPackage
  323. ^ (aPackage transport type = 'amd')
  324. ifTrue: [ aPackage transport namespace ]
  325. ifFalse: [ nil ]
  326. ! !
  327. Object subclass: #ChunkParser
  328. instanceVariableNames: 'stream'
  329. package: 'Importer-Exporter'!
  330. !ChunkParser commentStamp!
  331. I am responsible for parsing aStream contents in the chunk format.
  332. ## API
  333. ChunkParser new
  334. stream: aStream;
  335. nextChunk!
  336. !ChunkParser methodsFor: 'accessing'!
  337. stream: aStream
  338. stream := aStream
  339. ! !
  340. !ChunkParser methodsFor: 'reading'!
  341. nextChunk
  342. "The chunk format (Smalltalk Interchange Format or Fileout format)
  343. is a trivial format but can be a bit tricky to understand:
  344. - Uses the exclamation mark as delimiter of chunks.
  345. - Inside a chunk a normal exclamation mark must be doubled.
  346. - A non empty chunk must be a valid Smalltalk expression.
  347. - A chunk on top level with a preceding empty chunk is an instruction chunk:
  348. - The object created by the expression then takes over reading chunks.
  349. This method returns next chunk as a String (trimmed), empty String (all whitespace) or nil."
  350. | char result chunk |
  351. result := '' writeStream.
  352. [char := stream next.
  353. char notNil] whileTrue: [
  354. char = '!!' ifTrue: [
  355. stream peek = '!!'
  356. ifTrue: [stream next "skipping the escape double"]
  357. ifFalse: [^result contents trimBoth "chunk end marker found"]].
  358. result nextPut: char].
  359. ^nil "a chunk needs to end with !!"
  360. ! !
  361. !ChunkParser class methodsFor: 'instance creation'!
  362. on: aStream
  363. ^self new stream: aStream
  364. ! !
  365. Object subclass: #ExportMethodProtocol
  366. instanceVariableNames: 'name theClass'
  367. package: 'Importer-Exporter'!
  368. !ExportMethodProtocol commentStamp!
  369. I am an abstraction for a method protocol in a class / metaclass.
  370. I know of my class, name and methods.
  371. I am used when exporting a package.!
  372. !ExportMethodProtocol methodsFor: 'accessing'!
  373. methods
  374. ^ self theClass methodsInProtocol: self name
  375. !
  376. name
  377. ^name
  378. !
  379. name: aString
  380. name := aString
  381. !
  382. sortedMethods
  383. ^ self methods sorted: [ :a :b | a selector <= b selector ]
  384. !
  385. theClass
  386. ^theClass
  387. !
  388. theClass: aClass
  389. theClass := aClass
  390. ! !
  391. !ExportMethodProtocol class methodsFor: 'instance creation'!
  392. name: aString theClass: aClass
  393. ^self new
  394. name: aString;
  395. theClass: aClass;
  396. yourself
  397. ! !
  398. Object subclass: #Importer
  399. instanceVariableNames: ''
  400. package: 'Importer-Exporter'!
  401. !Importer commentStamp!
  402. I can import Amber code from a string in the chunk format.
  403. ## API
  404. Importer new import: aString!
  405. !Importer methodsFor: 'fileIn'!
  406. import: aStream
  407. | chunk result parser lastEmpty |
  408. parser := ChunkParser on: aStream.
  409. lastEmpty := false.
  410. [chunk := parser nextChunk.
  411. chunk isNil] whileFalse: [
  412. chunk isEmpty
  413. ifTrue: [lastEmpty := true]
  414. ifFalse: [
  415. result := Compiler new evaluateExpression: chunk.
  416. lastEmpty
  417. ifTrue: [
  418. lastEmpty := false.
  419. result scanFrom: parser]]]
  420. ! !
  421. InterfacingObject subclass: #PackageHandler
  422. instanceVariableNames: ''
  423. package: 'Importer-Exporter'!
  424. !PackageHandler commentStamp!
  425. I am responsible for handling package loading and committing.
  426. I should not be used directly. Instead, use the corresponding `Package` methods.!
  427. !PackageHandler methodsFor: 'accessing'!
  428. chunkContentsFor: aPackage
  429. ^ String streamContents: [ :str |
  430. self chunkExporter exportPackage: aPackage on: str ]
  431. !
  432. chunkExporterClass
  433. ^ ChunkExporter
  434. !
  435. commitPathJsFor: aPackage
  436. self subclassResponsibility
  437. !
  438. commitPathStFor: aPackage
  439. self subclassResponsibility
  440. !
  441. contentsFor: aPackage
  442. ^ String streamContents: [ :str |
  443. self exporter exportPackage: aPackage on: str ]
  444. !
  445. exporterClass
  446. ^ Exporter
  447. ! !
  448. !PackageHandler methodsFor: 'committing'!
  449. commit: aPackage
  450. {
  451. [ self commitStFileFor: aPackage ].
  452. [ self commitJsFileFor: aPackage ]
  453. }
  454. do: [ :each | each value ]
  455. displayingProgress: 'Committing package ', aPackage name
  456. !
  457. commitJsFileFor: aPackage
  458. self
  459. ajaxPutAt: (self commitPathJsFor: aPackage), '/', aPackage name, '.js'
  460. data: (self contentsFor: aPackage)
  461. !
  462. commitStFileFor: aPackage
  463. self
  464. ajaxPutAt: (self commitPathStFor: aPackage), '/', aPackage name, '.st'
  465. data: (self chunkContentsFor: aPackage)
  466. ! !
  467. !PackageHandler methodsFor: 'factory'!
  468. chunkExporter
  469. ^ self chunkExporterClass new
  470. !
  471. exporter
  472. ^ self exporterClass new
  473. ! !
  474. !PackageHandler methodsFor: 'private'!
  475. ajaxPutAt: aURL data: aString
  476. self
  477. ajax: #{
  478. 'url' -> aURL.
  479. 'type' -> 'PUT'.
  480. 'data' -> aString.
  481. 'contentType' -> 'text/plain;charset=UTF-8'.
  482. 'error' -> [ :xhr | self error: 'Commiting ' , aURL , ' failed with reason: "' , (xhr responseText) , '"'] }
  483. ! !
  484. PackageHandler subclass: #AmdPackageHandler
  485. instanceVariableNames: ''
  486. package: 'Importer-Exporter'!
  487. !AmdPackageHandler commentStamp!
  488. I am responsible for handling package loading and committing.
  489. I should not be used directly. Instead, use the corresponding `Package` methods.!
  490. !AmdPackageHandler methodsFor: 'accessing'!
  491. commitPathJsFor: aPackage
  492. ^self toUrl: (self namespaceFor: aPackage)
  493. !
  494. commitPathStFor: aPackage
  495. "if _source is not mapped, .st commit will likely fail"
  496. ^self toUrl: (self namespaceFor: aPackage), '/_source'.
  497. !
  498. exporterClass
  499. ^ AmdExporter
  500. ! !
  501. !AmdPackageHandler methodsFor: 'committing'!
  502. namespaceFor: aPackage
  503. ^ aPackage transport namespace
  504. ! !
  505. !AmdPackageHandler methodsFor: 'private'!
  506. toUrl: aString
  507. ^ Smalltalk current amdRequire
  508. ifNil: [ self error: 'AMD loader not present' ]
  509. ifNotNil: [ :require | (require basicAt: 'toUrl') value: aString ]
  510. ! !
  511. !AmdPackageHandler class methodsFor: 'commit paths'!
  512. defaultNamespace
  513. ^ Smalltalk current defaultAmdNamespace
  514. !
  515. defaultNamespace: aString
  516. Smalltalk current defaultAmdNamespace: aString
  517. ! !
  518. Object subclass: #PackageTransport
  519. instanceVariableNames: 'package'
  520. package: 'Importer-Exporter'!
  521. !PackageTransport commentStamp!
  522. I represent the transport mechanism used to commit a package.
  523. My concrete subclasses have a `#handler` to which committing is delegated.!
  524. !PackageTransport methodsFor: 'accessing'!
  525. commitHandlerClass
  526. self subclassResponsibility
  527. !
  528. package
  529. ^ package
  530. !
  531. package: aPackage
  532. package := aPackage
  533. !
  534. type
  535. ^ self class type
  536. ! !
  537. !PackageTransport methodsFor: 'committing'!
  538. commit
  539. self commitHandler commit: self package
  540. ! !
  541. !PackageTransport methodsFor: 'converting'!
  542. asJSON
  543. ^ #{ 'type' -> self type }
  544. ! !
  545. !PackageTransport methodsFor: 'factory'!
  546. commitHandler
  547. ^ self commitHandlerClass new
  548. ! !
  549. !PackageTransport methodsFor: 'initialization'!
  550. setupFromJson: anObject
  551. "no op. override if needed in subclasses"
  552. ! !
  553. PackageTransport class instanceVariableNames: 'registry'!
  554. !PackageTransport class methodsFor: 'accessing'!
  555. classRegisteredFor: aString
  556. ^ registry at: aString
  557. !
  558. type
  559. "Override in subclasses"
  560. ^ nil
  561. !
  562. defaultType
  563. ^ AmdPackageTransport type
  564. ! !
  565. !PackageTransport class methodsFor: 'initialization'!
  566. initialize
  567. super initialize.
  568. registry := #{}.
  569. self register
  570. ! !
  571. !PackageTransport class methodsFor: 'instance creation'!
  572. for: aString
  573. ^ (self classRegisteredFor: aString) new
  574. !
  575. fromJson: anObject
  576. anObject ifNil: [ ^ self for: self defaultType ].
  577. ^ (self for: anObject type)
  578. setupFromJson: anObject;
  579. yourself
  580. ! !
  581. !PackageTransport class methodsFor: 'registration'!
  582. register
  583. PackageTransport register: self
  584. !
  585. register: aClass
  586. aClass type ifNotNil: [
  587. registry at: aClass type put: aClass ]
  588. ! !
  589. PackageTransport subclass: #AmdPackageTransport
  590. instanceVariableNames: 'namespace'
  591. package: 'Importer-Exporter'!
  592. !AmdPackageTransport commentStamp!
  593. I am the default transport for committing packages.
  594. See `AmdExporter` and `AmdPackageHandler`.!
  595. !AmdPackageTransport methodsFor: 'accessing'!
  596. commitHandlerClass
  597. ^ AmdPackageHandler
  598. !
  599. namespace
  600. ^ namespace ifNil: [ self defaultNamespace ]
  601. !
  602. namespace: aString
  603. namespace := aString
  604. ! !
  605. !AmdPackageTransport methodsFor: 'converting'!
  606. asJSON
  607. ^ super asJSON
  608. at: 'amdNamespace' put: self namespace;
  609. yourself
  610. ! !
  611. !AmdPackageTransport methodsFor: 'defaults'!
  612. defaultNamespace
  613. ^ Smalltalk current defaultAmdNamespace
  614. ! !
  615. !AmdPackageTransport methodsFor: 'initialization'!
  616. setupFromJson: anObject
  617. self namespace: (anObject at: 'amdNamespace')
  618. ! !
  619. !AmdPackageTransport class methodsFor: 'accessing'!
  620. type
  621. ^ 'amd'
  622. ! !
  623. !AmdPackageTransport class methodsFor: 'instance creation'!
  624. namespace: aString
  625. ^ self new
  626. namespace: aString;
  627. yourself
  628. ! !
  629. !Package methodsFor: '*Importer-Exporter'!
  630. commit
  631. ^ self transport commit
  632. ! !