2
0

Kernel-ImportExport.st 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985
  1. Smalltalk createPackage: 'Kernel-ImportExport'!
  2. Object subclass: #AbstractExporter
  3. instanceVariableNames: ''
  4. package: 'Kernel-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: 'Kernel-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 exportPackageDefinitionOf: aPackage on: aStream.
  134. aPackage sortedClasses do: [ :each |
  135. self exportDefinitionOf: each on: aStream.
  136. self
  137. exportProtocols: (self ownMethodProtocolsOfClass: each)
  138. on: aStream.
  139. self exportMetaDefinitionOf: each on: aStream.
  140. self
  141. exportProtocols: (self ownMethodProtocolsOfClass: each class)
  142. on: aStream ].
  143. self
  144. exportProtocols: (self extensionProtocolsOfPackage: aPackage)
  145. on: aStream
  146. !
  147. exportPackageDefinitionOf: aPackage on: aStream
  148. aStream
  149. nextPutAll: 'Smalltalk createPackage: ''', aPackage name, '''!!';
  150. lf
  151. !
  152. exportProtocol: aProtocol on: aStream
  153. self exportProtocolPrologueOf: aProtocol on: aStream.
  154. aProtocol methods do: [ :method |
  155. self exportMethod: method on: aStream ].
  156. self exportProtocolEpilogueOf: aProtocol on: aStream
  157. !
  158. exportProtocolEpilogueOf: aProtocol on: aStream
  159. aStream nextPutAll: ' !!'; lf; lf
  160. !
  161. exportProtocolPrologueOf: aProtocol on: aStream
  162. aStream
  163. nextPutAll: '!!', (self classNameFor: aProtocol theClass);
  164. nextPutAll: ' methodsFor: ''', aProtocol name, '''!!'
  165. !
  166. exportProtocols: aCollection on: aStream
  167. aCollection do: [ :each |
  168. self exportProtocol: each on: aStream ]
  169. ! !
  170. AbstractExporter subclass: #Exporter
  171. instanceVariableNames: ''
  172. package: 'Kernel-ImportExport'!
  173. !Exporter commentStamp!
  174. I am responsible for outputting Amber code into a JavaScript string.
  175. The generated output is enough to reconstruct the exported data, including Smalltalk source code and other metadata.
  176. ## Use case
  177. I am typically used to save code outside of the Amber runtime (committing to disk, etc.).!
  178. !Exporter methodsFor: 'accessing'!
  179. ownMethodsOfClass: aClass
  180. "Issue #143: sort methods alphabetically"
  181. ^ ((aClass methodDictionary values) sorted: [ :a :b | a selector <= b selector ])
  182. reject: [ :each | (each protocol match: '^\*') ]
  183. !
  184. ownMethodsOfMetaClass: aClass
  185. "Issue #143: sort methods alphabetically"
  186. ^ self ownMethodsOfClass: aClass class
  187. ! !
  188. !Exporter methodsFor: 'convenience'!
  189. jsClassNameFor: aClass
  190. ^ aClass isMetaclass
  191. ifTrue: [ (self jsClassNameFor: aClass instanceClass), '.klass' ]
  192. ifFalse: [
  193. aClass
  194. ifNil: [ 'null' ]
  195. ifNotNil: [ '$globals.', aClass name ] ]
  196. ! !
  197. !Exporter methodsFor: 'output'!
  198. exportDefinitionOf: aClass on: aStream
  199. aStream
  200. lf;
  201. nextPutAll: '$core.addClass(';
  202. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  203. nextPutAll: (self jsClassNameFor: aClass superclass);
  204. nextPutAll: ', ['.
  205. aClass instanceVariableNames
  206. do: [ :each | aStream nextPutAll: '''', each, '''' ]
  207. separatedBy: [ aStream nextPutAll: ', ' ].
  208. aStream
  209. nextPutAll: '], ''';
  210. nextPutAll: aClass category, '''';
  211. nextPutAll: ');'.
  212. aClass comment notEmpty ifTrue: [
  213. aStream
  214. lf;
  215. nextPutAll: '//>>excludeStart("ide", pragmas.excludeIdeData);';
  216. lf;
  217. nextPutAll: (self jsClassNameFor: aClass);
  218. nextPutAll: '.comment=';
  219. nextPutAll: aClass comment crlfSanitized asJavascript;
  220. nextPutAll: ';';
  221. lf;
  222. nextPutAll: '//>>excludeEnd("ide");' ].
  223. aStream lf
  224. !
  225. exportMetaDefinitionOf: aClass on: aStream
  226. aStream lf.
  227. aClass class instanceVariableNames isEmpty ifFalse: [
  228. aStream
  229. nextPutAll: (self jsClassNameFor: aClass class);
  230. nextPutAll: '.iVarNames = ['.
  231. aClass class instanceVariableNames
  232. do: [ :each | aStream nextPutAll: '''', each, '''' ]
  233. separatedBy: [ aStream nextPutAll: ',' ].
  234. aStream nextPutAll: '];', String lf ]
  235. !
  236. exportMethod: aMethod on: aStream
  237. aStream
  238. nextPutAll: '$core.addMethod(';lf;
  239. nextPutAll: '$core.method({';lf;
  240. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  241. nextPutAll: 'protocol: ''', aMethod protocol, ''',';lf;
  242. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  243. nextPutAll: '//>>excludeStart("ide", pragmas.excludeIdeData);';lf;
  244. nextPutAll: 'args: ', aMethod arguments asJavascript, ','; lf;
  245. nextPutAll: 'source: ', aMethod source asJavascript, ',';lf;
  246. nextPutAll: 'referencedClasses: ', aMethod referencedClasses asJavascript, ',';lf;
  247. nextPutAll: '//>>excludeEnd("ide");';lf;
  248. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript;lf;
  249. nextPutAll: '}),';lf;
  250. nextPutAll: (self jsClassNameFor: 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. exportPackageContextOf: aPackage on: aStream;
  258. exportPackageImportsOf: aPackage on: aStream;
  259. exportPackageTransportOf: aPackage on: aStream.
  260. aPackage sortedClasses do: [ :each |
  261. self exportDefinitionOf: each on: aStream.
  262. each ownMethods do: [ :method |
  263. self exportMethod: method on: aStream ].
  264. self exportMetaDefinitionOf: each on: aStream.
  265. each class ownMethods do: [ :method |
  266. self exportMethod: method on: aStream ] ].
  267. (self extensionMethodsOfPackage: aPackage) do: [ :each |
  268. self exportMethod: each on: aStream ].
  269. self exportPackageEpilogueOf: aPackage on: aStream
  270. !
  271. exportPackageContextOf: aPackage on: aStream
  272. aStream
  273. nextPutAll: '$core.packages[';
  274. nextPutAll: aPackage name asJavascript;
  275. nextPutAll: '].innerEval = ';
  276. nextPutAll: 'function (expr) { return eval(expr); }';
  277. nextPutAll: ';';
  278. lf
  279. !
  280. exportPackageDefinitionOf: aPackage on: aStream
  281. aStream
  282. nextPutAll: '$core.addPackage(';
  283. nextPutAll: '''', aPackage name, ''');';
  284. lf
  285. !
  286. exportPackageEpilogueOf: aPackage on: aStream
  287. self subclassResponsibility
  288. !
  289. exportPackageImportsOf: aPackage on: aStream
  290. aPackage importsAsJson ifNotEmpty: [ :imports |
  291. aStream
  292. nextPutAll: '$core.packages[';
  293. nextPutAll: aPackage name asJavascript;
  294. nextPutAll: '].imports = ';
  295. nextPutAll: imports asJavascript;
  296. nextPutAll: ';';
  297. lf ]
  298. !
  299. exportPackagePrologueOf: aPackage on: aStream
  300. self subclassResponsibility
  301. !
  302. exportPackageTransportOf: aPackage on: aStream
  303. aStream
  304. nextPutAll: '$core.packages[';
  305. nextPutAll: aPackage name asJavascript;
  306. nextPutAll: '].transport = ';
  307. nextPutAll: aPackage transport asJSONString;
  308. nextPutAll: ';';
  309. lf
  310. ! !
  311. Exporter subclass: #AmdExporter
  312. instanceVariableNames: 'namespace'
  313. package: 'Kernel-ImportExport'!
  314. !AmdExporter commentStamp!
  315. I am used to export Packages in an AMD (Asynchronous Module Definition) JavaScript format.!
  316. !AmdExporter methodsFor: 'output'!
  317. exportPackageEpilogueOf: aPackage on: aStream
  318. aStream
  319. nextPutAll: '});';
  320. lf
  321. !
  322. exportPackagePrologueOf: aPackage on: aStream
  323. | namedImports anonImports importVarNames loadDependencies |
  324. namedImports := #().
  325. anonImports := #().
  326. importVarNames := #().
  327. aPackage imports do: [ :each | each isString
  328. ifTrue: [ anonImports add: each ]
  329. ifFalse: [ namedImports add: each value.
  330. importVarNames add: each key ]].
  331. loadDependencies := self amdNamesOfPackages: aPackage loadDependencies.
  332. aStream
  333. nextPutAll: 'define("';
  334. nextPutAll: (self amdNamespaceOfPackage: aPackage);
  335. nextPutAll: '/';
  336. nextPutAll: aPackage name;
  337. nextPutAll: '", ';
  338. nextPutAll: (namedImports, #('amber/boot'), anonImports, loadDependencies) asJavascript;
  339. nextPutAll: ', function(';
  340. nextPutAll: (importVarNames, #('$boot') join: ',');
  341. nextPutAll: '){';
  342. lf;
  343. nextPutAll: 'var $core=$boot.api,nil=$boot.nil,$recv=$boot.asReceiver,$globals=$boot.globals;';
  344. lf
  345. ! !
  346. !AmdExporter methodsFor: 'private'!
  347. amdNamesOfPackages: anArray
  348. ^ (anArray
  349. select: [ :each | (self amdNamespaceOfPackage: each) notNil ])
  350. collect: [ :each | (self amdNamespaceOfPackage: each), '/', each name ]
  351. !
  352. amdNamespaceOfPackage: aPackage
  353. ^ (aPackage transport type = 'amd')
  354. ifTrue: [ aPackage transport namespace ]
  355. ifFalse: [ nil ]
  356. ! !
  357. Object subclass: #ChunkParser
  358. instanceVariableNames: 'stream last'
  359. package: 'Kernel-ImportExport'!
  360. !ChunkParser commentStamp!
  361. I am responsible for parsing aStream contents in the chunk format.
  362. ## API
  363. ChunkParser new
  364. stream: aStream;
  365. nextChunk!
  366. !ChunkParser methodsFor: 'accessing'!
  367. last
  368. ^ last
  369. !
  370. stream: aStream
  371. stream := aStream
  372. ! !
  373. !ChunkParser methodsFor: 'reading'!
  374. nextChunk
  375. "The chunk format (Smalltalk Interchange Format or Fileout format)
  376. is a trivial format but can be a bit tricky to understand:
  377. - Uses the exclamation mark as delimiter of chunks.
  378. - Inside a chunk a normal exclamation mark must be doubled.
  379. - A non empty chunk must be a valid Smalltalk expression.
  380. - A chunk on top level with a preceding empty chunk is an instruction chunk:
  381. - The object created by the expression then takes over reading chunks.
  382. This method returns next chunk as a String (trimmed), empty String (all whitespace) or nil."
  383. | char result chunk |
  384. result := '' writeStream.
  385. [ char := stream next.
  386. char notNil ] whileTrue: [
  387. char = '!!' ifTrue: [
  388. stream peek = '!!'
  389. ifTrue: [ stream next "skipping the escape double" ]
  390. ifFalse: [ ^ last := result contents trimBoth "chunk end marker found" ]].
  391. result nextPut: char ].
  392. ^ last := nil "a chunk needs to end with !!"
  393. ! !
  394. !ChunkParser class methodsFor: 'instance creation'!
  395. on: aStream
  396. ^ self new stream: aStream
  397. ! !
  398. Object subclass: #ExportMethodProtocol
  399. instanceVariableNames: 'name theClass'
  400. package: 'Kernel-ImportExport'!
  401. !ExportMethodProtocol commentStamp!
  402. I am an abstraction for a method protocol in a class / metaclass.
  403. I know of my class, name and methods.
  404. I am used when exporting a package.!
  405. !ExportMethodProtocol methodsFor: 'accessing'!
  406. methods
  407. ^ (self theClass methodsInProtocol: self name)
  408. sorted: [ :a :b | a selector <= b selector ]
  409. !
  410. name
  411. ^ name
  412. !
  413. name: aString
  414. name := aString
  415. !
  416. theClass
  417. ^ theClass
  418. !
  419. theClass: aClass
  420. theClass := aClass
  421. ! !
  422. !ExportMethodProtocol class methodsFor: 'instance creation'!
  423. name: aString theClass: aClass
  424. ^ self new
  425. name: aString;
  426. theClass: aClass;
  427. yourself
  428. ! !
  429. Object subclass: #Importer
  430. instanceVariableNames: 'lastSection lastChunk'
  431. package: 'Kernel-ImportExport'!
  432. !Importer commentStamp!
  433. I can import Amber code from a string in the chunk format.
  434. ## API
  435. Importer new import: aString!
  436. !Importer methodsFor: 'accessing'!
  437. lastChunk
  438. ^ lastChunk
  439. !
  440. lastSection
  441. ^ lastSection
  442. ! !
  443. !Importer methodsFor: 'fileIn'!
  444. import: aStream
  445. | chunk result parser lastEmpty |
  446. parser := ChunkParser on: aStream.
  447. lastEmpty := false.
  448. lastSection := 'n/a, not started'.
  449. lastChunk := nil.
  450. [
  451. [ chunk := parser nextChunk.
  452. chunk isNil ] whileFalse: [
  453. chunk isEmpty
  454. ifTrue: [ lastEmpty := true ]
  455. ifFalse: [
  456. lastSection := chunk.
  457. result := Compiler new evaluateExpression: chunk.
  458. lastEmpty
  459. ifTrue: [
  460. lastEmpty := false.
  461. result scanFrom: parser ]] ].
  462. lastSection := 'n/a, finished'
  463. ] on: Error do: [:e | lastChunk := parser last. e signal ].
  464. ! !
  465. InterfacingObject subclass: #PackageHandler
  466. instanceVariableNames: ''
  467. package: 'Kernel-ImportExport'!
  468. !PackageHandler commentStamp!
  469. I am responsible for handling package loading and committing.
  470. I should not be used directly. Instead, use the corresponding `Package` methods.!
  471. !PackageHandler methodsFor: 'accessing'!
  472. chunkContentsFor: aPackage
  473. ^ String streamContents: [ :str |
  474. self chunkExporter exportPackage: aPackage on: str ]
  475. !
  476. chunkExporterClass
  477. ^ ChunkExporter
  478. !
  479. commitPathJsFor: aPackage
  480. self subclassResponsibility
  481. !
  482. commitPathStFor: aPackage
  483. self subclassResponsibility
  484. !
  485. contentsFor: aPackage
  486. ^ String streamContents: [ :str |
  487. self exporter exportPackage: aPackage on: str ]
  488. !
  489. exporterClass
  490. self subclassResponsibility
  491. ! !
  492. !PackageHandler methodsFor: 'committing'!
  493. commit: aPackage
  494. self
  495. commit: aPackage
  496. onSuccess: []
  497. onError: [ :error |
  498. PackageCommitError new
  499. messageText: 'Commiting failed with reason: "' , (error responseText) , '"';
  500. signal ]
  501. !
  502. commit: aPackage onSuccess: aBlock onError: anotherBlock
  503. self
  504. commitJsFileFor: aPackage
  505. onSuccess: [
  506. self
  507. commitStFileFor: aPackage
  508. onSuccess: [ aPackage beClean. aBlock value ]
  509. onError: anotherBlock ]
  510. onError: anotherBlock
  511. !
  512. commitJsFileFor: aPackage onSuccess: aBlock onError: anotherBlock
  513. self
  514. ajaxPutAt: (self commitPathJsFor: aPackage), '/', aPackage name, '.js'
  515. data: (self contentsFor: aPackage)
  516. onSuccess: aBlock
  517. onError: anotherBlock
  518. !
  519. commitStFileFor: aPackage onSuccess: aBlock onError: anotherBlock
  520. self
  521. ajaxPutAt: (self commitPathStFor: aPackage), '/', aPackage name, '.st'
  522. data: (self chunkContentsFor: aPackage)
  523. onSuccess: aBlock
  524. onError: anotherBlock
  525. ! !
  526. !PackageHandler methodsFor: 'error handling'!
  527. onCommitError: anError
  528. PackageCommitError new
  529. messageText: 'Commiting failed with reason: "' , (anError responseText) , '"';
  530. signal
  531. ! !
  532. !PackageHandler methodsFor: 'factory'!
  533. chunkExporter
  534. ^ self chunkExporterClass new
  535. !
  536. exporter
  537. ^ self exporterClass new
  538. ! !
  539. !PackageHandler methodsFor: 'loading'!
  540. load: aPackage
  541. self subclassResponsibility
  542. ! !
  543. !PackageHandler methodsFor: 'private'!
  544. ajaxPutAt: aURL data: aString onSuccess: aBlock onError: anotherBlock
  545. self
  546. ajax: #{
  547. 'url' -> aURL.
  548. 'type' -> 'PUT'.
  549. 'data' -> aString.
  550. 'contentType' -> 'text/plain;charset=UTF-8'.
  551. 'success' -> aBlock.
  552. 'error' -> anotherBlock
  553. }
  554. ! !
  555. PackageHandler subclass: #AmdPackageHandler
  556. instanceVariableNames: ''
  557. package: 'Kernel-ImportExport'!
  558. !AmdPackageHandler commentStamp!
  559. I am responsible for handling package loading and committing.
  560. I should not be used directly. Instead, use the corresponding `Package` methods.!
  561. !AmdPackageHandler methodsFor: 'accessing'!
  562. commitPathJsFor: aPackage
  563. ^ self toUrl: (self namespaceFor: aPackage)
  564. !
  565. commitPathStFor: aPackage
  566. "If _source is not mapped, .st will be committed to .js path.
  567. It is recommended not to use _source as it can be deprecated."
  568. | path pathWithout |
  569. path := self toUrl: (self namespaceFor: aPackage), '/_source'.
  570. pathWithout := self commitPathJsFor: aPackage.
  571. ^ path = (pathWithout, '/_source') ifTrue: [ pathWithout ] ifFalse: [ path ]
  572. !
  573. exporterClass
  574. ^ AmdExporter
  575. ! !
  576. !AmdPackageHandler methodsFor: 'committing'!
  577. namespaceFor: aPackage
  578. ^ aPackage transport namespace
  579. ! !
  580. !AmdPackageHandler methodsFor: 'loading'!
  581. load: aPackage
  582. Smalltalk amdRequire
  583. ifNil: [ self error: 'AMD loader not present' ]
  584. ifNotNil: [ :require |
  585. require value: (Array with: (self namespaceFor: aPackage), '/', aPackage name ) ]
  586. ! !
  587. !AmdPackageHandler methodsFor: 'private'!
  588. toUrl: aString
  589. ^ Smalltalk amdRequire
  590. ifNil: [ self error: 'AMD loader not present' ]
  591. ifNotNil: [ :require | (require basicAt: 'toUrl') value: aString ]
  592. ! !
  593. !AmdPackageHandler class methodsFor: 'commit paths'!
  594. defaultNamespace
  595. ^ Smalltalk defaultAmdNamespace
  596. !
  597. defaultNamespace: aString
  598. Smalltalk defaultAmdNamespace: aString
  599. ! !
  600. Object subclass: #PackageTransport
  601. instanceVariableNames: 'package'
  602. package: 'Kernel-ImportExport'!
  603. !PackageTransport commentStamp!
  604. I represent the transport mechanism used to commit a package.
  605. My concrete subclasses have a `#handler` to which committing is delegated.!
  606. !PackageTransport methodsFor: 'accessing'!
  607. commitHandlerClass
  608. self subclassResponsibility
  609. !
  610. definition
  611. ^ ''
  612. !
  613. package
  614. ^ package
  615. !
  616. package: aPackage
  617. package := aPackage
  618. !
  619. type
  620. ^ self class type
  621. ! !
  622. !PackageTransport methodsFor: 'committing'!
  623. commit
  624. self commitHandler commit: self package
  625. !
  626. commitOnSuccess: aBlock onError: anotherBlock
  627. self commitHandler
  628. commit: self package
  629. onSuccess: aBlock
  630. onError: anotherBlock
  631. ! !
  632. !PackageTransport methodsFor: 'converting'!
  633. asJSON
  634. ^ #{ 'type' -> self type }
  635. ! !
  636. !PackageTransport methodsFor: 'factory'!
  637. commitHandler
  638. ^ self commitHandlerClass new
  639. ! !
  640. !PackageTransport methodsFor: 'initialization'!
  641. setupFromJson: anObject
  642. "no op. override if needed in subclasses"
  643. ! !
  644. !PackageTransport methodsFor: 'loading'!
  645. load
  646. self commitHandler load: self package
  647. ! !
  648. PackageTransport class instanceVariableNames: 'registry'!
  649. !PackageTransport class methodsFor: 'accessing'!
  650. classRegisteredFor: aString
  651. ^ registry at: aString
  652. !
  653. defaultType
  654. ^ AmdPackageTransport type
  655. !
  656. type
  657. "Override in subclasses"
  658. ^ nil
  659. ! !
  660. !PackageTransport class methodsFor: 'initialization'!
  661. initialize
  662. super initialize.
  663. self == PackageTransport
  664. ifTrue: [ registry := #{} ]
  665. ifFalse: [ self register ]
  666. ! !
  667. !PackageTransport class methodsFor: 'instance creation'!
  668. for: aString
  669. ^ (self classRegisteredFor: aString) new
  670. !
  671. fromJson: anObject
  672. anObject ifNil: [ ^ self for: self defaultType ].
  673. ^ (self for: anObject type)
  674. setupFromJson: anObject;
  675. yourself
  676. ! !
  677. !PackageTransport class methodsFor: 'registration'!
  678. register
  679. PackageTransport register: self
  680. !
  681. register: aClass
  682. aClass type ifNotNil: [
  683. registry at: aClass type put: aClass ]
  684. ! !
  685. PackageTransport subclass: #AmdPackageTransport
  686. instanceVariableNames: 'namespace'
  687. package: 'Kernel-ImportExport'!
  688. !AmdPackageTransport commentStamp!
  689. I am the default transport for committing packages.
  690. See `AmdExporter` and `AmdPackageHandler`.!
  691. !AmdPackageTransport methodsFor: 'accessing'!
  692. commitHandlerClass
  693. ^ AmdPackageHandler
  694. !
  695. definition
  696. ^ String streamContents: [ :stream |
  697. stream
  698. nextPutAll: self class name;
  699. nextPutAll: ' namespace: ';
  700. nextPutAll: '''', self namespace, '''' ]
  701. !
  702. namespace
  703. ^ namespace ifNil: [ self defaultNamespace ]
  704. !
  705. namespace: aString
  706. namespace := aString
  707. ! !
  708. !AmdPackageTransport methodsFor: 'actions'!
  709. setPath: aString
  710. "Set the path the the receiver's `namespace`"
  711. (require basicAt: 'config') value: #{
  712. 'paths' -> #{
  713. self namespace -> aString
  714. }
  715. }.
  716. ! !
  717. !AmdPackageTransport methodsFor: 'converting'!
  718. asJSON
  719. ^ super asJSON
  720. at: 'amdNamespace' put: self namespace;
  721. yourself
  722. ! !
  723. !AmdPackageTransport methodsFor: 'defaults'!
  724. defaultNamespace
  725. ^ Smalltalk defaultAmdNamespace
  726. ! !
  727. !AmdPackageTransport methodsFor: 'initialization'!
  728. setupFromJson: anObject
  729. self namespace: (anObject at: 'amdNamespace')
  730. ! !
  731. !AmdPackageTransport methodsFor: 'printing'!
  732. printOn: aStream
  733. super printOn: aStream.
  734. aStream
  735. nextPutAll: ' (AMD Namespace: ';
  736. nextPutAll: self namespace;
  737. nextPutAll: ')'
  738. ! !
  739. !AmdPackageTransport class methodsFor: 'accessing'!
  740. type
  741. ^ 'amd'
  742. ! !
  743. !AmdPackageTransport class methodsFor: 'instance creation'!
  744. namespace: aString
  745. ^ self new
  746. namespace: aString;
  747. yourself
  748. ! !
  749. !Package methodsFor: '*Kernel-ImportExport'!
  750. commit
  751. ^ self transport commit
  752. !
  753. load
  754. ^ self transport load
  755. !
  756. loadFromNamespace: aString
  757. ^ self transport
  758. namespace: aString;
  759. load
  760. ! !
  761. !Package class methodsFor: '*Kernel-ImportExport'!
  762. load: aPackageName
  763. (self named: aPackageName) load
  764. !
  765. load: aPackageName fromNamespace: aString
  766. (self named: aPackageName) loadFromNamespace: aString
  767. ! !