Kernel-ImportExport.st 22 KB

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