Platform-ImportExport.st 26 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118
  1. Smalltalk createPackage: 'Platform-ImportExport'!
  2. Object subclass: #AbstractExporter
  3. instanceVariableNames: ''
  4. package: 'Platform-ImportExport'!
  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 topological sorting (dependency resolution) does not matter here.
  23. Not sorting topologically improves the speed by a number of magnitude.
  24. Not to shuffle diffs, classes are sorted by their name."
  25. (Smalltalk classes asArray sorted: [ :a :b | a name < b name ]) do: [ :each |
  26. {each. each class} do: [ :behavior |
  27. (behavior protocols includes: extensionName) ifTrue: [
  28. result add: (ExportMethodProtocol name: extensionName theClass: behavior) ] ] ].
  29. ^ result
  30. ! !
  31. !AbstractExporter methodsFor: 'convenience'!
  32. classNameFor: aClass
  33. ^ aClass isMetaclass
  34. ifTrue: [ aClass instanceClass name, ' class' ]
  35. ifFalse: [
  36. aClass isNil
  37. ifTrue: [ 'nil' ]
  38. ifFalse: [ aClass name ] ]
  39. ! !
  40. !AbstractExporter methodsFor: 'output'!
  41. exportPackage: aPackage on: aStream
  42. self subclassResponsibility
  43. ! !
  44. AbstractExporter subclass: #ChunkExporter
  45. instanceVariableNames: ''
  46. package: 'Platform-ImportExport'!
  47. !ChunkExporter commentStamp!
  48. I am an exporter dedicated to outputting Amber source code in the classic Smalltalk chunk format.
  49. I do not output any compiled code.!
  50. !ChunkExporter methodsFor: 'accessing'!
  51. extensionCategoriesOfPackage: aPackage
  52. "Issue #143: sort protocol alphabetically"
  53. | name map result |
  54. name := aPackage name.
  55. result := OrderedCollection new.
  56. (Package sortedClasses: Smalltalk classes) do: [ :each |
  57. {each. each class} do: [ :aClass |
  58. map := Dictionary new.
  59. aClass protocolsDo: [ :category :methods |
  60. category = ('*', name) ifTrue: [ map at: category put: methods ] ].
  61. result addAll: ((map keys sorted: [ :a :b | a <= b ]) collect: [ :category |
  62. MethodCategory name: category theClass: aClass methods: (map at: category) ]) ] ].
  63. ^ result
  64. !
  65. ownCategoriesOfClass: aClass
  66. "Answer the protocols of aClass that are not package extensions"
  67. "Issue #143: sort protocol alphabetically"
  68. | map |
  69. map := Dictionary new.
  70. aClass protocolsDo: [ :each :methods |
  71. (each match: '^\*') ifFalse: [ map at: each put: methods ] ].
  72. ^ (map keys sorted: [ :a :b | a <= b ]) collect: [ :each |
  73. MethodCategory name: each theClass: aClass methods: (map at: each) ]
  74. !
  75. ownCategoriesOfMetaClass: aClass
  76. "Issue #143: sort protocol alphabetically"
  77. ^ self ownCategoriesOfClass: aClass class
  78. !
  79. ownMethodProtocolsOfClass: aClass
  80. "Answer a collection of ExportMethodProtocol object of aClass that are not package extensions"
  81. ^ aClass ownProtocols collect: [ :each |
  82. ExportMethodProtocol name: each theClass: aClass ]
  83. ! !
  84. !ChunkExporter methodsFor: 'convenience'!
  85. chunkEscape: aString
  86. "Replace all occurrences of !! with !!!! and trim at both ends."
  87. ^ (aString replace: '!!' with: '!!!!') trimBoth
  88. ! !
  89. !ChunkExporter methodsFor: 'output'!
  90. exportCategoryEpilogueOf: aCategory on: aStream
  91. aStream nextPutAll: ' !!'; lf; lf
  92. !
  93. exportCategoryPrologueOf: aCategory on: aStream
  94. aStream
  95. nextPutAll: '!!', (self classNameFor: aCategory theClass);
  96. nextPutAll: ' methodsFor: ''', aCategory name, '''!!'
  97. !
  98. exportDefinitionOf: aClass on: aStream
  99. "Chunk format."
  100. aStream
  101. nextPutAll: (self classNameFor: aClass superclass);
  102. nextPutAll: ' subclass: #', (self classNameFor: aClass); lf;
  103. tab; nextPutAll: 'instanceVariableNames: '''.
  104. aClass instanceVariableNames
  105. do: [ :each | aStream nextPutAll: each ]
  106. separatedBy: [ aStream nextPutAll: ' ' ].
  107. aStream
  108. nextPutAll: ''''; lf;
  109. tab; nextPutAll: 'package: ''', aClass category, '''!!'; lf.
  110. aClass comment notEmpty ifTrue: [
  111. aStream
  112. nextPutAll: '!!', (self classNameFor: aClass), ' commentStamp!!';lf;
  113. nextPutAll: (self chunkEscape: aClass comment), '!!';lf ].
  114. aStream lf
  115. !
  116. exportMetaDefinitionOf: aClass on: aStream
  117. aClass class instanceVariableNames isEmpty ifFalse: [
  118. aStream
  119. nextPutAll: (self classNameFor: aClass class);
  120. nextPutAll: ' instanceVariableNames: '''.
  121. aClass class instanceVariableNames
  122. do: [ :each | aStream nextPutAll: each ]
  123. separatedBy: [ aStream nextPutAll: ' ' ].
  124. aStream
  125. nextPutAll: '''!!'; lf; lf ]
  126. !
  127. exportMethod: aMethod on: aStream
  128. aStream
  129. lf; lf; nextPutAll: (self chunkEscape: aMethod source); lf;
  130. nextPutAll: '!!'
  131. !
  132. exportPackage: aPackage on: aStream
  133. self
  134. exportPackageDefinitionOf: aPackage on: aStream;
  135. exportPackageImportsOf: 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 createPackage: ''', aPackage name, '''!!';
  152. lf
  153. !
  154. exportPackageImportsOf: aPackage on: aStream
  155. aPackage imports ifNotEmpty: [ :imports |
  156. aStream
  157. nextPutAll: '(Smalltalk packageAt: ''';
  158. nextPutAll: aPackage name;
  159. nextPutAll: ''') imports: ';
  160. nextPutAll: (self chunkEscape: aPackage importsDefinition);
  161. nextPutAll: '!!';
  162. lf ]
  163. !
  164. exportProtocol: aProtocol on: aStream
  165. self exportProtocolPrologueOf: aProtocol on: aStream.
  166. aProtocol methods do: [ :method |
  167. self exportMethod: method on: aStream ].
  168. self exportProtocolEpilogueOf: aProtocol on: aStream
  169. !
  170. exportProtocolEpilogueOf: aProtocol on: aStream
  171. aStream nextPutAll: ' !!'; lf; lf
  172. !
  173. exportProtocolPrologueOf: aProtocol on: aStream
  174. aStream
  175. nextPutAll: '!!', (self classNameFor: aProtocol theClass);
  176. nextPutAll: ' methodsFor: ''', aProtocol name, '''!!'
  177. !
  178. exportProtocols: aCollection on: aStream
  179. aCollection do: [ :each |
  180. self exportProtocol: each on: aStream ]
  181. ! !
  182. AbstractExporter subclass: #Exporter
  183. instanceVariableNames: ''
  184. package: 'Platform-ImportExport'!
  185. !Exporter commentStamp!
  186. I am responsible for outputting Amber code into a JavaScript string.
  187. The generated output is enough to reconstruct the exported data, including Smalltalk source code and other metadata.
  188. ## Use case
  189. I am typically used to save code outside of the Amber runtime (committing to disk, etc.).!
  190. !Exporter methodsFor: 'accessing'!
  191. ownMethodsOfClass: aClass
  192. "Issue #143: sort methods alphabetically"
  193. ^ ((aClass methodDictionary values) sorted: [ :a :b | a selector <= b selector ])
  194. reject: [ :each | (each protocol match: '^\*') ]
  195. !
  196. ownMethodsOfMetaClass: aClass
  197. "Issue #143: sort methods alphabetically"
  198. ^ self ownMethodsOfClass: aClass class
  199. ! !
  200. !Exporter methodsFor: 'convenience'!
  201. jsClassNameFor: aClass
  202. ^ aClass isMetaclass
  203. ifTrue: [ (self jsClassNameFor: aClass instanceClass), '.klass' ]
  204. ifFalse: [
  205. aClass
  206. ifNil: [ 'null' ]
  207. ifNotNil: [ '$globals.', aClass name ] ]
  208. ! !
  209. !Exporter methodsFor: 'output'!
  210. exportDefinitionOf: aClass on: aStream
  211. aStream
  212. lf;
  213. nextPutAll: '$core.addClass(';
  214. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  215. nextPutAll: (self jsClassNameFor: aClass superclass);
  216. nextPutAll: ', ['.
  217. aClass instanceVariableNames
  218. do: [ :each | aStream nextPutAll: '''', each, '''' ]
  219. separatedBy: [ aStream nextPutAll: ', ' ].
  220. aStream
  221. nextPutAll: '], ''';
  222. nextPutAll: aClass category, '''';
  223. nextPutAll: ');'.
  224. aClass comment notEmpty ifTrue: [
  225. aStream
  226. lf;
  227. nextPutAll: '//>>excludeStart("ide", pragmas.excludeIdeData);';
  228. lf;
  229. nextPutAll: (self jsClassNameFor: aClass);
  230. nextPutAll: '.comment=';
  231. nextPutAll: aClass comment crlfSanitized asJavascript;
  232. nextPutAll: ';';
  233. lf;
  234. nextPutAll: '//>>excludeEnd("ide");' ].
  235. aStream lf
  236. !
  237. exportMetaDefinitionOf: aClass on: aStream
  238. aStream lf.
  239. aClass class instanceVariableNames isEmpty ifFalse: [
  240. aStream
  241. nextPutAll: (self jsClassNameFor: aClass class);
  242. nextPutAll: '.iVarNames = ['.
  243. aClass class instanceVariableNames
  244. do: [ :each | aStream nextPutAll: '''', each, '''' ]
  245. separatedBy: [ aStream nextPutAll: ',' ].
  246. aStream nextPutAll: '];', String lf ]
  247. !
  248. exportMethod: aMethod on: aStream
  249. aStream
  250. nextPutAll: '$core.addMethod(';lf;
  251. nextPutAll: '$core.method({';lf;
  252. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  253. nextPutAll: 'protocol: ''', aMethod protocol, ''',';lf;
  254. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  255. nextPutAll: '//>>excludeStart("ide", pragmas.excludeIdeData);';lf;
  256. nextPutAll: 'args: ', aMethod arguments asJavascript, ','; lf;
  257. nextPutAll: 'source: ', aMethod source asJavascript, ',';lf;
  258. nextPutAll: 'referencedClasses: ', aMethod referencedClasses asJavascript, ',';lf;
  259. nextPutAll: '//>>excludeEnd("ide");';lf;
  260. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript;lf;
  261. nextPutAll: '}),';lf;
  262. nextPutAll: (self jsClassNameFor: aMethod methodClass);
  263. nextPutAll: ');';lf;lf
  264. !
  265. exportPackage: aPackage on: aStream
  266. self
  267. exportPackagePrologueOf: aPackage on: aStream;
  268. exportPackageDefinitionOf: aPackage on: aStream;
  269. exportPackageContextOf: aPackage on: aStream;
  270. exportPackageImportsOf: aPackage on: aStream;
  271. exportPackageTransportOf: aPackage on: aStream.
  272. aPackage sortedClasses do: [ :each |
  273. self exportDefinitionOf: each on: aStream.
  274. each ownMethods do: [ :method |
  275. self exportMethod: method on: aStream ].
  276. self exportMetaDefinitionOf: each on: aStream.
  277. each class ownMethods do: [ :method |
  278. self exportMethod: method on: aStream ] ].
  279. (self extensionMethodsOfPackage: aPackage) do: [ :each |
  280. self exportMethod: each on: aStream ].
  281. self exportPackageEpilogueOf: aPackage on: aStream
  282. !
  283. exportPackageContextOf: aPackage on: aStream
  284. aStream
  285. nextPutAll: '$core.packages[';
  286. nextPutAll: aPackage name asJavascript;
  287. nextPutAll: '].innerEval = ';
  288. nextPutAll: 'function (expr) { return eval(expr); }';
  289. nextPutAll: ';';
  290. lf
  291. !
  292. exportPackageDefinitionOf: aPackage on: aStream
  293. aStream
  294. nextPutAll: '$core.addPackage(';
  295. nextPutAll: '''', aPackage name, ''');';
  296. lf
  297. !
  298. exportPackageEpilogueOf: aPackage on: aStream
  299. self subclassResponsibility
  300. !
  301. exportPackageImportsOf: aPackage on: aStream
  302. aPackage importsAsJson ifNotEmpty: [ :imports |
  303. aStream
  304. nextPutAll: '$core.packages[';
  305. nextPutAll: aPackage name asJavascript;
  306. nextPutAll: '].imports = ';
  307. nextPutAll: imports asJavascript;
  308. nextPutAll: ';';
  309. lf ]
  310. !
  311. exportPackagePrologueOf: aPackage on: aStream
  312. self subclassResponsibility
  313. !
  314. exportPackageTransportOf: aPackage on: aStream
  315. aStream
  316. nextPutAll: '$core.packages[';
  317. nextPutAll: aPackage name asJavascript;
  318. nextPutAll: '].transport = ';
  319. nextPutAll: aPackage transport asJSONString;
  320. nextPutAll: ';';
  321. lf
  322. ! !
  323. Exporter subclass: #AmdExporter
  324. instanceVariableNames: 'namespace'
  325. package: 'Platform-ImportExport'!
  326. !AmdExporter commentStamp!
  327. I am used to export Packages in an AMD (Asynchronous Module Definition) JavaScript format.!
  328. !AmdExporter methodsFor: 'output'!
  329. exportPackageEpilogueOf: aPackage on: aStream
  330. aStream
  331. nextPutAll: '});';
  332. lf
  333. !
  334. exportPackagePrologueOf: aPackage on: aStream
  335. | importsForOutput loadDependencies pragmaStart pragmaEnd |
  336. pragmaStart := ''.
  337. pragmaEnd := ''.
  338. importsForOutput := self importsForOutput: aPackage.
  339. loadDependencies := self amdNamesOfPackages: aPackage loadDependencies.
  340. importsForOutput value ifNotEmpty: [
  341. pragmaStart := String lf, '//>>excludeStart("imports", pragmas.excludeImports);', String lf.
  342. pragmaEnd := String lf, '//>>excludeEnd("imports");', String lf ].
  343. aStream
  344. nextPutAll: 'define("';
  345. nextPutAll: (self amdNamespaceOfPackage: aPackage);
  346. nextPutAll: '/';
  347. nextPutAll: aPackage name;
  348. nextPutAll: '", ';
  349. nextPutAll: (((
  350. (#('amber/boot' ':1:'), importsForOutput value, #(':2:'), loadDependencies) asJavascript)
  351. replace: ',\s*["'']:1:["'']' with: pragmaStart) replace: ',\s*["'']:2:["'']' with: pragmaEnd);
  352. nextPutAll: ', function(';
  353. nextPutAll: (((
  354. (#('$boot' ':1:'), importsForOutput key, #(':2:')) join: ',')
  355. replace: ',\s*:1:' with: pragmaStart) replace: ',\s*:2:' with: pragmaEnd);
  356. nextPutAll: '){';
  357. lf;
  358. nextPutAll: 'var $core=$boot.api,nil=$boot.nil,$recv=$boot.asReceiver,$globals=$boot.globals;';
  359. lf
  360. ! !
  361. !AmdExporter methodsFor: 'private'!
  362. amdNamesOfPackages: anArray
  363. ^ (anArray
  364. select: [ :each | (self amdNamespaceOfPackage: each) notNil ])
  365. collect: [ :each | (self amdNamespaceOfPackage: each), '/', each name ]
  366. !
  367. amdNamespaceOfPackage: aPackage
  368. ^ (aPackage transport type = 'amd')
  369. ifTrue: [ aPackage transport namespace ]
  370. ifFalse: [ nil ]
  371. !
  372. importsForOutput: aPackage
  373. "Returns an association where key is list of import variables
  374. and value is list of external dependencies, with ones imported as variables
  375. put at the beginning with same order as is in key.
  376. For example imports:{'jQuery'->'jquery'. 'bootstrap'} would yield
  377. #('jQuery') -> #('jquery' 'bootstrap')"
  378. | namedImports anonImports importVarNames |
  379. namedImports := #().
  380. anonImports := #().
  381. importVarNames := #().
  382. aPackage imports do: [ :each | each isString
  383. ifTrue: [ anonImports add: each ]
  384. ifFalse: [ namedImports add: each value.
  385. importVarNames add: each key ]].
  386. ^ importVarNames -> (namedImports, anonImports)
  387. ! !
  388. Object subclass: #ChunkParser
  389. instanceVariableNames: 'stream last'
  390. package: 'Platform-ImportExport'!
  391. !ChunkParser commentStamp!
  392. I am responsible for parsing aStream contents in the chunk format.
  393. ## API
  394. ChunkParser new
  395. stream: aStream;
  396. nextChunk!
  397. !ChunkParser methodsFor: 'accessing'!
  398. last
  399. ^ last
  400. !
  401. stream: aStream
  402. stream := aStream
  403. ! !
  404. !ChunkParser methodsFor: 'reading'!
  405. nextChunk
  406. "The chunk format (Smalltalk Interchange Format or Fileout format)
  407. is a trivial format but can be a bit tricky to understand:
  408. - Uses the exclamation mark as delimiter of chunks.
  409. - Inside a chunk a normal exclamation mark must be doubled.
  410. - A non empty chunk must be a valid Smalltalk expression.
  411. - A chunk on top level with a preceding empty chunk is an instruction chunk:
  412. - The object created by the expression then takes over reading chunks.
  413. This method returns next chunk as a String (trimmed), empty String (all whitespace) or nil."
  414. | char result chunk |
  415. result := '' writeStream.
  416. [ char := stream next.
  417. char notNil ] whileTrue: [
  418. char = '!!' ifTrue: [
  419. stream peek = '!!'
  420. ifTrue: [ stream next "skipping the escape double" ]
  421. ifFalse: [ ^ last := result contents trimBoth "chunk end marker found" ]].
  422. result nextPut: char ].
  423. ^ last := nil "a chunk needs to end with !!"
  424. ! !
  425. !ChunkParser class methodsFor: 'instance creation'!
  426. on: aStream
  427. ^ self new stream: aStream
  428. ! !
  429. Object subclass: #ClassCommentReader
  430. instanceVariableNames: 'class'
  431. package: 'Platform-ImportExport'!
  432. !ClassCommentReader commentStamp!
  433. I provide a mechanism for retrieving class comments stored on a file.
  434. See also `ClassCategoryReader`.!
  435. !ClassCommentReader methodsFor: 'accessing'!
  436. class: aClass
  437. class := aClass
  438. ! !
  439. !ClassCommentReader methodsFor: 'fileIn'!
  440. scanFrom: aChunkParser
  441. | chunk |
  442. chunk := aChunkParser nextChunk.
  443. chunk isEmpty ifFalse: [
  444. self setComment: chunk ].
  445. ! !
  446. !ClassCommentReader methodsFor: 'initialization'!
  447. initialize
  448. super initialize.
  449. ! !
  450. !ClassCommentReader methodsFor: 'private'!
  451. setComment: aString
  452. class comment: aString
  453. ! !
  454. Object subclass: #ClassProtocolReader
  455. instanceVariableNames: 'class category'
  456. package: 'Platform-ImportExport'!
  457. !ClassProtocolReader commentStamp!
  458. I provide a mechanism for retrieving class descriptions stored on a file in the Smalltalk chunk format.!
  459. !ClassProtocolReader methodsFor: 'accessing'!
  460. class: aClass category: aString
  461. class := aClass.
  462. category := aString
  463. ! !
  464. !ClassProtocolReader methodsFor: 'fileIn'!
  465. scanFrom: aChunkParser
  466. | chunk |
  467. [ chunk := aChunkParser nextChunk.
  468. chunk isEmpty ] whileFalse: [
  469. self compileMethod: chunk ].
  470. ClassBuilder new setupClass: class
  471. ! !
  472. !ClassProtocolReader methodsFor: 'initialization'!
  473. initialize
  474. super initialize.
  475. ! !
  476. !ClassProtocolReader methodsFor: 'private'!
  477. compileMethod: aString
  478. Compiler new install: aString forClass: class protocol: category
  479. ! !
  480. Object subclass: #ExportMethodProtocol
  481. instanceVariableNames: 'name theClass'
  482. package: 'Platform-ImportExport'!
  483. !ExportMethodProtocol commentStamp!
  484. I am an abstraction for a method protocol in a class / metaclass.
  485. I know of my class, name and methods.
  486. I am used when exporting a package.!
  487. !ExportMethodProtocol methodsFor: 'accessing'!
  488. methods
  489. ^ (self theClass methodsInProtocol: self name)
  490. sorted: [ :a :b | a selector <= b selector ]
  491. !
  492. name
  493. ^ name
  494. !
  495. name: aString
  496. name := aString
  497. !
  498. theClass
  499. ^ theClass
  500. !
  501. theClass: aClass
  502. theClass := aClass
  503. ! !
  504. !ExportMethodProtocol class methodsFor: 'instance creation'!
  505. name: aString theClass: aClass
  506. ^ self new
  507. name: aString;
  508. theClass: aClass;
  509. yourself
  510. ! !
  511. Object subclass: #Importer
  512. instanceVariableNames: 'lastSection lastChunk'
  513. package: 'Platform-ImportExport'!
  514. !Importer commentStamp!
  515. I can import Amber code from a string in the chunk format.
  516. ## API
  517. Importer new import: aString!
  518. !Importer methodsFor: 'accessing'!
  519. lastChunk
  520. ^ lastChunk
  521. !
  522. lastSection
  523. ^ lastSection
  524. ! !
  525. !Importer methodsFor: 'fileIn'!
  526. import: aStream
  527. | chunk result parser lastEmpty |
  528. parser := ChunkParser on: aStream.
  529. lastEmpty := false.
  530. lastSection := 'n/a, not started'.
  531. lastChunk := nil.
  532. [
  533. [ chunk := parser nextChunk.
  534. chunk isNil ] whileFalse: [
  535. chunk isEmpty
  536. ifTrue: [ lastEmpty := true ]
  537. ifFalse: [
  538. lastSection := chunk.
  539. result := Compiler new evaluateExpression: chunk.
  540. lastEmpty
  541. ifTrue: [
  542. lastEmpty := false.
  543. result scanFrom: parser ]] ].
  544. lastSection := 'n/a, finished'
  545. ] on: Error do: [:e | lastChunk := parser last. e resignal ].
  546. ! !
  547. Error subclass: #PackageCommitError
  548. instanceVariableNames: ''
  549. package: 'Platform-ImportExport'!
  550. !PackageCommitError commentStamp!
  551. I get signaled when an attempt to commit a package has failed.!
  552. InterfacingObject subclass: #PackageHandler
  553. instanceVariableNames: ''
  554. package: 'Platform-ImportExport'!
  555. !PackageHandler commentStamp!
  556. I am responsible for handling package loading and committing.
  557. I should not be used directly. Instead, use the corresponding `Package` methods.!
  558. !PackageHandler methodsFor: 'accessing'!
  559. chunkContentsFor: aPackage
  560. ^ String streamContents: [ :str |
  561. self chunkExporter exportPackage: aPackage on: str ]
  562. !
  563. chunkExporterClass
  564. ^ ChunkExporter
  565. !
  566. commitPathJsFor: aPackage
  567. self subclassResponsibility
  568. !
  569. commitPathStFor: aPackage
  570. self subclassResponsibility
  571. !
  572. contentsFor: aPackage
  573. ^ String streamContents: [ :str |
  574. self exporter exportPackage: aPackage on: str ]
  575. !
  576. exporterClass
  577. self subclassResponsibility
  578. ! !
  579. !PackageHandler methodsFor: 'committing'!
  580. commit: aPackage
  581. self
  582. commit: aPackage
  583. onSuccess: []
  584. onError: [ :error |
  585. PackageCommitError new
  586. messageText: 'Commiting failed with reason: "' , (error responseText) , '"';
  587. signal ]
  588. !
  589. commit: aPackage onSuccess: aBlock onError: anotherBlock
  590. self
  591. commitJsFileFor: aPackage
  592. onSuccess: [
  593. self
  594. commitStFileFor: aPackage
  595. onSuccess: [ aPackage beClean. aBlock value ]
  596. onError: anotherBlock ]
  597. onError: anotherBlock
  598. !
  599. commitJsFileFor: aPackage onSuccess: aBlock onError: anotherBlock
  600. self
  601. ajaxPutAt: (self commitPathJsFor: aPackage), '/', aPackage name, '.js'
  602. data: (self contentsFor: aPackage)
  603. onSuccess: aBlock
  604. onError: anotherBlock
  605. !
  606. commitStFileFor: aPackage onSuccess: aBlock onError: anotherBlock
  607. self
  608. ajaxPutAt: (self commitPathStFor: aPackage), '/', aPackage name, '.st'
  609. data: (self chunkContentsFor: aPackage)
  610. onSuccess: aBlock
  611. onError: anotherBlock
  612. ! !
  613. !PackageHandler methodsFor: 'error handling'!
  614. onCommitError: anError
  615. PackageCommitError new
  616. messageText: 'Commiting failed with reason: "' , (anError responseText) , '"';
  617. signal
  618. ! !
  619. !PackageHandler methodsFor: 'factory'!
  620. chunkExporter
  621. ^ self chunkExporterClass new
  622. !
  623. exporter
  624. ^ self exporterClass new
  625. ! !
  626. !PackageHandler methodsFor: 'loading'!
  627. load: aPackage
  628. self subclassResponsibility
  629. ! !
  630. !PackageHandler methodsFor: 'private'!
  631. ajaxPutAt: aURL data: aString onSuccess: aBlock onError: anotherBlock
  632. self
  633. ajax: #{
  634. 'url' -> aURL.
  635. 'type' -> 'PUT'.
  636. 'data' -> aString.
  637. 'contentType' -> 'text/plain;charset=UTF-8'.
  638. 'success' -> aBlock.
  639. 'error' -> anotherBlock
  640. }
  641. ! !
  642. PackageHandler subclass: #AmdPackageHandler
  643. instanceVariableNames: ''
  644. package: 'Platform-ImportExport'!
  645. !AmdPackageHandler commentStamp!
  646. I am responsible for handling package loading and committing.
  647. I should not be used directly. Instead, use the corresponding `Package` methods.!
  648. !AmdPackageHandler methodsFor: 'accessing'!
  649. commitPathJsFor: aPackage
  650. ^ self toUrl: (self namespaceFor: aPackage)
  651. !
  652. commitPathStFor: aPackage
  653. "If _source is not mapped, .st will be committed to .js path.
  654. It is recommended not to use _source as it can be deprecated."
  655. | path pathWithout |
  656. path := self toUrl: (self namespaceFor: aPackage), '/_source'.
  657. pathWithout := self commitPathJsFor: aPackage.
  658. ^ path = (pathWithout, '/_source') ifTrue: [ pathWithout ] ifFalse: [ path ]
  659. !
  660. exporterClass
  661. ^ AmdExporter
  662. ! !
  663. !AmdPackageHandler methodsFor: 'committing'!
  664. namespaceFor: aPackage
  665. ^ aPackage transport namespace
  666. ! !
  667. !AmdPackageHandler methodsFor: 'loading'!
  668. load: aPackage
  669. Smalltalk amdRequire
  670. ifNil: [ self error: 'AMD loader not present' ]
  671. ifNotNil: [ :require |
  672. require value: (Array with: (self namespaceFor: aPackage), '/', aPackage name ) ]
  673. ! !
  674. !AmdPackageHandler methodsFor: 'private'!
  675. toUrl: aString
  676. ^ Smalltalk amdRequire
  677. ifNil: [ self error: 'AMD loader not present' ]
  678. ifNotNil: [ :require | (require basicAt: 'toUrl') value: aString ]
  679. ! !
  680. !AmdPackageHandler class methodsFor: 'commit paths'!
  681. defaultNamespace
  682. ^ Smalltalk defaultAmdNamespace
  683. !
  684. defaultNamespace: aString
  685. Smalltalk defaultAmdNamespace: aString
  686. ! !
  687. Object subclass: #PackageTransport
  688. instanceVariableNames: 'package'
  689. package: 'Platform-ImportExport'!
  690. !PackageTransport commentStamp!
  691. I represent the transport mechanism used to commit a package.
  692. My concrete subclasses have a `#handler` to which committing is delegated.!
  693. !PackageTransport methodsFor: 'accessing'!
  694. commitHandlerClass
  695. self subclassResponsibility
  696. !
  697. definition
  698. ^ ''
  699. !
  700. package
  701. ^ package
  702. !
  703. package: aPackage
  704. package := aPackage
  705. !
  706. type
  707. ^ self class type
  708. ! !
  709. !PackageTransport methodsFor: 'committing'!
  710. commit
  711. self commitHandler commit: self package
  712. !
  713. commitOnSuccess: aBlock onError: anotherBlock
  714. self commitHandler
  715. commit: self package
  716. onSuccess: aBlock
  717. onError: anotherBlock
  718. ! !
  719. !PackageTransport methodsFor: 'converting'!
  720. asJSON
  721. ^ #{ 'type' -> self type }
  722. ! !
  723. !PackageTransport methodsFor: 'factory'!
  724. commitHandler
  725. ^ self commitHandlerClass new
  726. ! !
  727. !PackageTransport methodsFor: 'initialization'!
  728. setupFromJson: anObject
  729. "no op. override if needed in subclasses"
  730. ! !
  731. !PackageTransport methodsFor: 'loading'!
  732. load
  733. self commitHandler load: self package
  734. ! !
  735. PackageTransport class instanceVariableNames: 'registry'!
  736. !PackageTransport class methodsFor: 'accessing'!
  737. classRegisteredFor: aString
  738. ^ registry at: aString
  739. !
  740. defaultType
  741. ^ AmdPackageTransport type
  742. !
  743. type
  744. "Override in subclasses"
  745. ^ nil
  746. ! !
  747. !PackageTransport class methodsFor: 'initialization'!
  748. initialize
  749. super initialize.
  750. self == PackageTransport
  751. ifTrue: [ registry := #{} ]
  752. ifFalse: [ self register ]
  753. ! !
  754. !PackageTransport class methodsFor: 'instance creation'!
  755. for: aString
  756. ^ (self classRegisteredFor: aString) new
  757. !
  758. fromJson: anObject
  759. anObject ifNil: [ ^ self for: self defaultType ].
  760. ^ (self for: anObject type)
  761. setupFromJson: anObject;
  762. yourself
  763. ! !
  764. !PackageTransport class methodsFor: 'registration'!
  765. register
  766. PackageTransport register: self
  767. !
  768. register: aClass
  769. aClass type ifNotNil: [
  770. registry at: aClass type put: aClass ]
  771. ! !
  772. PackageTransport subclass: #AmdPackageTransport
  773. instanceVariableNames: 'namespace'
  774. package: 'Platform-ImportExport'!
  775. !AmdPackageTransport commentStamp!
  776. I am the default transport for committing packages.
  777. See `AmdExporter` and `AmdPackageHandler`.!
  778. !AmdPackageTransport methodsFor: 'accessing'!
  779. commitHandlerClass
  780. ^ AmdPackageHandler
  781. !
  782. definition
  783. ^ String streamContents: [ :stream |
  784. stream
  785. nextPutAll: self class name;
  786. nextPutAll: ' namespace: ';
  787. nextPutAll: '''', self namespace, '''' ]
  788. !
  789. namespace
  790. ^ namespace ifNil: [ self defaultNamespace ]
  791. !
  792. namespace: aString
  793. namespace := aString
  794. ! !
  795. !AmdPackageTransport methodsFor: 'actions'!
  796. setPath: aString
  797. "Set the path the the receiver's `namespace`"
  798. (require basicAt: 'config') value: #{
  799. 'paths' -> #{
  800. self namespace -> aString
  801. }
  802. }.
  803. ! !
  804. !AmdPackageTransport methodsFor: 'converting'!
  805. asJSON
  806. ^ super asJSON
  807. at: 'amdNamespace' put: self namespace;
  808. yourself
  809. ! !
  810. !AmdPackageTransport methodsFor: 'defaults'!
  811. defaultNamespace
  812. ^ Smalltalk defaultAmdNamespace
  813. ! !
  814. !AmdPackageTransport methodsFor: 'initialization'!
  815. setupFromJson: anObject
  816. self namespace: (anObject at: 'amdNamespace')
  817. ! !
  818. !AmdPackageTransport methodsFor: 'printing'!
  819. printOn: aStream
  820. super printOn: aStream.
  821. aStream
  822. nextPutAll: ' (AMD Namespace: ';
  823. nextPutAll: self namespace;
  824. nextPutAll: ')'
  825. ! !
  826. !AmdPackageTransport class methodsFor: 'accessing'!
  827. type
  828. ^ 'amd'
  829. ! !
  830. !AmdPackageTransport class methodsFor: 'instance creation'!
  831. namespace: aString
  832. ^ self new
  833. namespace: aString;
  834. yourself
  835. ! !
  836. !Behavior methodsFor: '*Platform-ImportExport'!
  837. commentStamp
  838. ^ ClassCommentReader new
  839. class: self;
  840. yourself
  841. !
  842. commentStamp: aStamp prior: prior
  843. ^ self commentStamp
  844. !
  845. methodsFor: aString
  846. ^ ClassProtocolReader new
  847. class: self category: aString;
  848. yourself
  849. !
  850. methodsFor: aString stamp: aStamp
  851. "Added for file-in compatibility, ignores stamp."
  852. ^ self methodsFor: aString
  853. ! !
  854. !Package methodsFor: '*Platform-ImportExport'!
  855. commit
  856. ^ self transport commit
  857. !
  858. load
  859. ^ self transport load
  860. !
  861. loadFromNamespace: aString
  862. ^ self transport
  863. namespace: aString;
  864. load
  865. ! !
  866. !Package class methodsFor: '*Platform-ImportExport'!
  867. load: aPackageName
  868. (self named: aPackageName) load
  869. !
  870. load: aPackageName fromNamespace: aString
  871. (self named: aPackageName) loadFromNamespace: aString
  872. ! !