Platform-ImportExport.st 24 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019
  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: #ExportMethodProtocol
  430. instanceVariableNames: 'name theClass'
  431. package: 'Platform-ImportExport'!
  432. !ExportMethodProtocol commentStamp!
  433. I am an abstraction for a method protocol in a class / metaclass.
  434. I know of my class, name and methods.
  435. I am used when exporting a package.!
  436. !ExportMethodProtocol methodsFor: 'accessing'!
  437. methods
  438. ^ (self theClass methodsInProtocol: self name)
  439. sorted: [ :a :b | a selector <= b selector ]
  440. !
  441. name
  442. ^ name
  443. !
  444. name: aString
  445. name := aString
  446. !
  447. theClass
  448. ^ theClass
  449. !
  450. theClass: aClass
  451. theClass := aClass
  452. ! !
  453. !ExportMethodProtocol class methodsFor: 'instance creation'!
  454. name: aString theClass: aClass
  455. ^ self new
  456. name: aString;
  457. theClass: aClass;
  458. yourself
  459. ! !
  460. Object subclass: #Importer
  461. instanceVariableNames: 'lastSection lastChunk'
  462. package: 'Platform-ImportExport'!
  463. !Importer commentStamp!
  464. I can import Amber code from a string in the chunk format.
  465. ## API
  466. Importer new import: aString!
  467. !Importer methodsFor: 'accessing'!
  468. lastChunk
  469. ^ lastChunk
  470. !
  471. lastSection
  472. ^ lastSection
  473. ! !
  474. !Importer methodsFor: 'fileIn'!
  475. import: aStream
  476. | chunk result parser lastEmpty |
  477. parser := ChunkParser on: aStream.
  478. lastEmpty := false.
  479. lastSection := 'n/a, not started'.
  480. lastChunk := nil.
  481. [
  482. [ chunk := parser nextChunk.
  483. chunk isNil ] whileFalse: [
  484. chunk isEmpty
  485. ifTrue: [ lastEmpty := true ]
  486. ifFalse: [
  487. lastSection := chunk.
  488. result := Compiler new evaluateExpression: chunk.
  489. lastEmpty
  490. ifTrue: [
  491. lastEmpty := false.
  492. result scanFrom: parser ]] ].
  493. lastSection := 'n/a, finished'
  494. ] on: Error do: [:e | lastChunk := parser last. e resignal ].
  495. ! !
  496. InterfacingObject subclass: #PackageHandler
  497. instanceVariableNames: ''
  498. package: 'Platform-ImportExport'!
  499. !PackageHandler commentStamp!
  500. I am responsible for handling package loading and committing.
  501. I should not be used directly. Instead, use the corresponding `Package` methods.!
  502. !PackageHandler methodsFor: 'accessing'!
  503. chunkContentsFor: aPackage
  504. ^ String streamContents: [ :str |
  505. self chunkExporter exportPackage: aPackage on: str ]
  506. !
  507. chunkExporterClass
  508. ^ ChunkExporter
  509. !
  510. commitPathJsFor: aPackage
  511. self subclassResponsibility
  512. !
  513. commitPathStFor: aPackage
  514. self subclassResponsibility
  515. !
  516. contentsFor: aPackage
  517. ^ String streamContents: [ :str |
  518. self exporter exportPackage: aPackage on: str ]
  519. !
  520. exporterClass
  521. self subclassResponsibility
  522. ! !
  523. !PackageHandler methodsFor: 'committing'!
  524. commit: aPackage
  525. self
  526. commit: aPackage
  527. onSuccess: []
  528. onError: [ :error |
  529. PackageCommitError new
  530. messageText: 'Commiting failed with reason: "' , (error responseText) , '"';
  531. signal ]
  532. !
  533. commit: aPackage onSuccess: aBlock onError: anotherBlock
  534. self
  535. commitJsFileFor: aPackage
  536. onSuccess: [
  537. self
  538. commitStFileFor: aPackage
  539. onSuccess: [ aPackage beClean. aBlock value ]
  540. onError: anotherBlock ]
  541. onError: anotherBlock
  542. !
  543. commitJsFileFor: aPackage onSuccess: aBlock onError: anotherBlock
  544. self
  545. ajaxPutAt: (self commitPathJsFor: aPackage), '/', aPackage name, '.js'
  546. data: (self contentsFor: aPackage)
  547. onSuccess: aBlock
  548. onError: anotherBlock
  549. !
  550. commitStFileFor: aPackage onSuccess: aBlock onError: anotherBlock
  551. self
  552. ajaxPutAt: (self commitPathStFor: aPackage), '/', aPackage name, '.st'
  553. data: (self chunkContentsFor: aPackage)
  554. onSuccess: aBlock
  555. onError: anotherBlock
  556. ! !
  557. !PackageHandler methodsFor: 'error handling'!
  558. onCommitError: anError
  559. PackageCommitError new
  560. messageText: 'Commiting failed with reason: "' , (anError responseText) , '"';
  561. signal
  562. ! !
  563. !PackageHandler methodsFor: 'factory'!
  564. chunkExporter
  565. ^ self chunkExporterClass new
  566. !
  567. exporter
  568. ^ self exporterClass new
  569. ! !
  570. !PackageHandler methodsFor: 'loading'!
  571. load: aPackage
  572. self subclassResponsibility
  573. ! !
  574. !PackageHandler methodsFor: 'private'!
  575. ajaxPutAt: aURL data: aString onSuccess: aBlock onError: anotherBlock
  576. self
  577. ajax: #{
  578. 'url' -> aURL.
  579. 'type' -> 'PUT'.
  580. 'data' -> aString.
  581. 'contentType' -> 'text/plain;charset=UTF-8'.
  582. 'success' -> aBlock.
  583. 'error' -> anotherBlock
  584. }
  585. ! !
  586. PackageHandler subclass: #AmdPackageHandler
  587. instanceVariableNames: ''
  588. package: 'Platform-ImportExport'!
  589. !AmdPackageHandler commentStamp!
  590. I am responsible for handling package loading and committing.
  591. I should not be used directly. Instead, use the corresponding `Package` methods.!
  592. !AmdPackageHandler methodsFor: 'accessing'!
  593. commitPathJsFor: aPackage
  594. ^ self toUrl: (self namespaceFor: aPackage)
  595. !
  596. commitPathStFor: aPackage
  597. "If _source is not mapped, .st will be committed to .js path.
  598. It is recommended not to use _source as it can be deprecated."
  599. | path pathWithout |
  600. path := self toUrl: (self namespaceFor: aPackage), '/_source'.
  601. pathWithout := self commitPathJsFor: aPackage.
  602. ^ path = (pathWithout, '/_source') ifTrue: [ pathWithout ] ifFalse: [ path ]
  603. !
  604. exporterClass
  605. ^ AmdExporter
  606. ! !
  607. !AmdPackageHandler methodsFor: 'committing'!
  608. namespaceFor: aPackage
  609. ^ aPackage transport namespace
  610. ! !
  611. !AmdPackageHandler methodsFor: 'loading'!
  612. load: aPackage
  613. Smalltalk amdRequire
  614. ifNil: [ self error: 'AMD loader not present' ]
  615. ifNotNil: [ :require |
  616. require value: (Array with: (self namespaceFor: aPackage), '/', aPackage name ) ]
  617. ! !
  618. !AmdPackageHandler methodsFor: 'private'!
  619. toUrl: aString
  620. ^ Smalltalk amdRequire
  621. ifNil: [ self error: 'AMD loader not present' ]
  622. ifNotNil: [ :require | (require basicAt: 'toUrl') value: aString ]
  623. ! !
  624. !AmdPackageHandler class methodsFor: 'commit paths'!
  625. defaultNamespace
  626. ^ Smalltalk defaultAmdNamespace
  627. !
  628. defaultNamespace: aString
  629. Smalltalk defaultAmdNamespace: aString
  630. ! !
  631. Object subclass: #PackageTransport
  632. instanceVariableNames: 'package'
  633. package: 'Platform-ImportExport'!
  634. !PackageTransport commentStamp!
  635. I represent the transport mechanism used to commit a package.
  636. My concrete subclasses have a `#handler` to which committing is delegated.!
  637. !PackageTransport methodsFor: 'accessing'!
  638. commitHandlerClass
  639. self subclassResponsibility
  640. !
  641. definition
  642. ^ ''
  643. !
  644. package
  645. ^ package
  646. !
  647. package: aPackage
  648. package := aPackage
  649. !
  650. type
  651. ^ self class type
  652. ! !
  653. !PackageTransport methodsFor: 'committing'!
  654. commit
  655. self commitHandler commit: self package
  656. !
  657. commitOnSuccess: aBlock onError: anotherBlock
  658. self commitHandler
  659. commit: self package
  660. onSuccess: aBlock
  661. onError: anotherBlock
  662. ! !
  663. !PackageTransport methodsFor: 'converting'!
  664. asJSON
  665. ^ #{ 'type' -> self type }
  666. ! !
  667. !PackageTransport methodsFor: 'factory'!
  668. commitHandler
  669. ^ self commitHandlerClass new
  670. ! !
  671. !PackageTransport methodsFor: 'initialization'!
  672. setupFromJson: anObject
  673. "no op. override if needed in subclasses"
  674. ! !
  675. !PackageTransport methodsFor: 'loading'!
  676. load
  677. self commitHandler load: self package
  678. ! !
  679. PackageTransport class instanceVariableNames: 'registry'!
  680. !PackageTransport class methodsFor: 'accessing'!
  681. classRegisteredFor: aString
  682. ^ registry at: aString
  683. !
  684. defaultType
  685. ^ AmdPackageTransport type
  686. !
  687. type
  688. "Override in subclasses"
  689. ^ nil
  690. ! !
  691. !PackageTransport class methodsFor: 'initialization'!
  692. initialize
  693. super initialize.
  694. self == PackageTransport
  695. ifTrue: [ registry := #{} ]
  696. ifFalse: [ self register ]
  697. ! !
  698. !PackageTransport class methodsFor: 'instance creation'!
  699. for: aString
  700. ^ (self classRegisteredFor: aString) new
  701. !
  702. fromJson: anObject
  703. anObject ifNil: [ ^ self for: self defaultType ].
  704. ^ (self for: anObject type)
  705. setupFromJson: anObject;
  706. yourself
  707. ! !
  708. !PackageTransport class methodsFor: 'registration'!
  709. register
  710. PackageTransport register: self
  711. !
  712. register: aClass
  713. aClass type ifNotNil: [
  714. registry at: aClass type put: aClass ]
  715. ! !
  716. PackageTransport subclass: #AmdPackageTransport
  717. instanceVariableNames: 'namespace'
  718. package: 'Platform-ImportExport'!
  719. !AmdPackageTransport commentStamp!
  720. I am the default transport for committing packages.
  721. See `AmdExporter` and `AmdPackageHandler`.!
  722. !AmdPackageTransport methodsFor: 'accessing'!
  723. commitHandlerClass
  724. ^ AmdPackageHandler
  725. !
  726. definition
  727. ^ String streamContents: [ :stream |
  728. stream
  729. nextPutAll: self class name;
  730. nextPutAll: ' namespace: ';
  731. nextPutAll: '''', self namespace, '''' ]
  732. !
  733. namespace
  734. ^ namespace ifNil: [ self defaultNamespace ]
  735. !
  736. namespace: aString
  737. namespace := aString
  738. ! !
  739. !AmdPackageTransport methodsFor: 'actions'!
  740. setPath: aString
  741. "Set the path the the receiver's `namespace`"
  742. (require basicAt: 'config') value: #{
  743. 'paths' -> #{
  744. self namespace -> aString
  745. }
  746. }.
  747. ! !
  748. !AmdPackageTransport methodsFor: 'converting'!
  749. asJSON
  750. ^ super asJSON
  751. at: 'amdNamespace' put: self namespace;
  752. yourself
  753. ! !
  754. !AmdPackageTransport methodsFor: 'defaults'!
  755. defaultNamespace
  756. ^ Smalltalk defaultAmdNamespace
  757. ! !
  758. !AmdPackageTransport methodsFor: 'initialization'!
  759. setupFromJson: anObject
  760. self namespace: (anObject at: 'amdNamespace')
  761. ! !
  762. !AmdPackageTransport methodsFor: 'printing'!
  763. printOn: aStream
  764. super printOn: aStream.
  765. aStream
  766. nextPutAll: ' (AMD Namespace: ';
  767. nextPutAll: self namespace;
  768. nextPutAll: ')'
  769. ! !
  770. !AmdPackageTransport class methodsFor: 'accessing'!
  771. type
  772. ^ 'amd'
  773. ! !
  774. !AmdPackageTransport class methodsFor: 'instance creation'!
  775. namespace: aString
  776. ^ self new
  777. namespace: aString;
  778. yourself
  779. ! !
  780. !Package methodsFor: '*Platform-ImportExport'!
  781. commit
  782. ^ self transport commit
  783. !
  784. load
  785. ^ self transport load
  786. !
  787. loadFromNamespace: aString
  788. ^ self transport
  789. namespace: aString;
  790. load
  791. ! !
  792. !Package class methodsFor: '*Platform-ImportExport'!
  793. load: aPackageName
  794. (self named: aPackageName) load
  795. !
  796. load: aPackageName fromNamespace: aString
  797. (self named: aPackageName) loadFromNamespace: aString
  798. ! !