Trapped-Frontend.st 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543
  1. Smalltalk current createPackage: 'Trapped-Frontend'!
  2. Object subclass: #TrappedDataCarrier
  3. instanceVariableNames: 'target model chain source'
  4. package: 'Trapped-Frontend'!
  5. !TrappedDataCarrier methodsFor: 'accessing'!
  6. chain: aProcessingChain
  7. chain := aProcessingChain
  8. !
  9. source
  10. ^source
  11. !
  12. source: anObject
  13. source := anObject
  14. !
  15. target
  16. ^target
  17. !
  18. target: anObject
  19. target := anObject
  20. !
  21. value
  22. ^model
  23. !
  24. value: anObject
  25. model := anObject
  26. !
  27. value: anObject whenDifferentFrom: anotherObject
  28. anObject = anotherObject ifFalse: [ self value: anObject ]
  29. ! !
  30. !TrappedDataCarrier methodsFor: 'converting'!
  31. falseAsNilValue
  32. | value |
  33. value := self value.
  34. value = false ifTrue: [ ^nil ] ifFalse: [ ^value ]
  35. ! !
  36. !TrappedDataCarrier methodsFor: 'initialization'!
  37. initialize
  38. super initialize.
  39. model := true
  40. ! !
  41. !TrappedDataCarrier class methodsFor: 'not yet classified'!
  42. on: aProcessingChain target: anObject
  43. ^self new
  44. chain: aProcessingChain;
  45. target: anObject;
  46. yourself
  47. ! !
  48. TrappedDataCarrier subclass: #TrappedDataCarrierToModel
  49. instanceVariableNames: 'index'
  50. package: 'Trapped-Frontend'!
  51. !TrappedDataCarrierToModel methodsFor: 'not yet classified'!
  52. proceed
  53. index := index ifNil: [ chain lastProcessorNo ] ifNotNil: [ index - 1 ].
  54. (chain processorNo: index) toModel: self
  55. ! !
  56. TrappedDataCarrier subclass: #TrappedDataCarrierToView
  57. instanceVariableNames: 'index'
  58. package: 'Trapped-Frontend'!
  59. !TrappedDataCarrierToView methodsFor: 'not yet classified'!
  60. proceed
  61. index := index ifNil: [ chain firstProcessorNo ] ifNotNil: [ index + 1 ].
  62. (chain processorNo: index) toView: self
  63. ! !
  64. Object subclass: #TrappedProcessingChain
  65. instanceVariableNames: 'processors'
  66. package: 'Trapped-Frontend'!
  67. !TrappedProcessingChain methodsFor: 'accessing'!
  68. firstProcessorNo
  69. ^1
  70. !
  71. lastProcessorNo
  72. ^processors size
  73. !
  74. processorNo: aNumber
  75. ^processors at: aNumber
  76. !
  77. processors: anArray
  78. processors := anArray
  79. ! !
  80. !TrappedProcessingChain methodsFor: 'action'!
  81. forSnapshot: aSnapshot andBrush: aTagBrush
  82. | toViewCarrier toModelCarrier |
  83. toViewCarrier := TrappedDataCarrierToView on: self target: aTagBrush.
  84. toModelCarrier := TrappedDataCarrierToModel on: self target: aSnapshot.
  85. processors do: [ :each | each installToView: toViewCarrier toModel: toModelCarrier ].
  86. toViewCarrier source: aSnapshot.
  87. toModelCarrier source: aTagBrush.
  88. toViewCarrier value = true ifTrue: [ toViewCarrier copy proceed ]
  89. ! !
  90. !TrappedProcessingChain class methodsFor: 'instance creation'!
  91. new: anArray
  92. (anArray anySatisfy: [ :each | each isExpectingModelData ])
  93. ifFalse: [ anArray add: self dataTerminator ]
  94. ifTrue: [ anArray addFirst: self blackboardReaderWriter ].
  95. ^self new
  96. processors: anArray;
  97. yourself
  98. !
  99. newFromProcessorSpecs: anArray
  100. ^self new: ((anArray ifEmpty: [ #(contents) ]) collect: [ :each | each asTrapProcSendTo: TrappedProcessor ])
  101. ! !
  102. !TrappedProcessingChain class methodsFor: 'private'!
  103. blackboardReaderWriter
  104. ^TrappedProcessorBlackboard new
  105. !
  106. dataTerminator
  107. ^TrappedProcessorTerminator new
  108. ! !
  109. Object subclass: #TrappedProcessor
  110. instanceVariableNames: ''
  111. package: 'Trapped-Frontend'!
  112. !TrappedProcessor commentStamp!
  113. I am a processing step in TrappedProcessingChain.
  114. I am stateless flyweight (aka servant)
  115. and will get all necessary data as arguments in API calls.
  116. My public API is:
  117. - installToView:toModel:
  118. This gets two TrappedDataCarriers set up without actual data
  119. and at the beginning of their chains. It should do one-time
  120. installation task needed (install event handlers etc.).
  121. To start a chain, do: dataCarrier copy value: data; proceed.
  122. - toView:
  123. This performs transformation of TrappedDataCarrier on its way from model to view.
  124. Should call aDataCarrier proceed to proceed to subsequent step.
  125. - toModel:
  126. This performs transformation of TrappedDataCarrier on its way from view to model.
  127. Should call aDataCarrier proceed to proceed to subsequent step.!
  128. !TrappedProcessor methodsFor: 'data transformation'!
  129. toModel: aDataCarrier
  130. "by default, proceed"
  131. aDataCarrier proceed
  132. !
  133. toView: aDataCarrier
  134. "by default, proceed"
  135. aDataCarrier proceed
  136. ! !
  137. !TrappedProcessor methodsFor: 'installation'!
  138. installToView: aDataCarrier toModel: anotherDataCarrier
  139. "by default, do nothing"
  140. ! !
  141. !TrappedProcessor methodsFor: 'testing'!
  142. isExpectingModelData
  143. ^false
  144. ! !
  145. !TrappedProcessor class methodsFor: 'factory'!
  146. contents
  147. ^TrappedProcessorContents new
  148. ! !
  149. TrappedProcessor subclass: #TrappedDataExpectingProcessor
  150. instanceVariableNames: ''
  151. package: 'Trapped-Frontend'!
  152. !TrappedDataExpectingProcessor commentStamp!
  153. I answer true to isExpectingModelData and serve as a base class
  154. for processor that present / change model data.
  155. When at least one of my instances is present in the chain,
  156. automatic databinding processor is added at the beginning
  157. (the data-binding scenario); otherwise, the chain
  158. is run immediately with true as data (run-once scenario).!
  159. !TrappedDataExpectingProcessor methodsFor: 'testing'!
  160. isExpectingModelData
  161. ^true
  162. ! !
  163. TrappedDataExpectingProcessor subclass: #TrappedProcessorContents
  164. instanceVariableNames: ''
  165. package: 'Trapped-Frontend'!
  166. !TrappedProcessorContents commentStamp!
  167. I put data into target via contents: in toView:!
  168. !TrappedProcessorContents methodsFor: 'data transformation'!
  169. toView: aDataCarrier
  170. aDataCarrier toTargetContents
  171. ! !
  172. TrappedProcessor subclass: #TrappedProcessorBlackboard
  173. instanceVariableNames: ''
  174. package: 'Trapped-Frontend'!
  175. !TrappedProcessorBlackboard commentStamp!
  176. I am used internally to fetch data from blackboard
  177. or write it back.
  178. I am added to the beginning of the chain
  179. when the chain contains at least one element
  180. that isExpectingModelData (see TrappedDataExpectingProcessor).!
  181. !TrappedProcessorBlackboard methodsFor: 'data transformation'!
  182. toModel: aDataCarrier
  183. aDataCarrier modifyTarget
  184. ! !
  185. !TrappedProcessorBlackboard methodsFor: 'installation'!
  186. installToView: aDataCarrier toModel: anotherDataCarrier
  187. | snap |
  188. snap := anotherDataCarrier target.
  189. snap watch: [ :data |
  190. (aDataCarrier target asJQuery closest: 'html') toArray isEmpty ifTrue: [ KeyedPubSubUnsubscribe signal ].
  191. snap do: [ aDataCarrier copy value: data; proceed ] ].
  192. aDataCarrier value: false
  193. ! !
  194. TrappedProcessor subclass: #TrappedProcessorTerminator
  195. instanceVariableNames: ''
  196. package: 'Trapped-Frontend'!
  197. !TrappedProcessorTerminator commentStamp!
  198. I do not proceed in toView:.
  199. I am added automatically to end of chain when it does not contain
  200. any element that isExpectingModelData (see TrappedDataExpectingProcessor).!
  201. !TrappedProcessorTerminator methodsFor: 'data transformation'!
  202. toView: aDataCarrier
  203. "stop"
  204. ! !
  205. Object subclass: #TrappedSingleton
  206. instanceVariableNames: ''
  207. package: 'Trapped-Frontend'!
  208. !TrappedSingleton methodsFor: 'action'!
  209. start: args
  210. ^ self subclassResponsibility
  211. ! !
  212. TrappedSingleton class instanceVariableNames: 'current'!
  213. !TrappedSingleton class methodsFor: 'accessing'!
  214. current
  215. ^ current ifNil: [ current := self new ]
  216. ! !
  217. !TrappedSingleton class methodsFor: 'action'!
  218. start: args
  219. self current start: args
  220. ! !
  221. TrappedSingleton subclass: #Trapped
  222. instanceVariableNames: 'registry'
  223. package: 'Trapped-Frontend'!
  224. !Trapped methodsFor: 'accessing'!
  225. byName: aString
  226. ^ registry at: aString
  227. !
  228. register: aListKeyedEntity
  229. self register: aListKeyedEntity name: aListKeyedEntity class name
  230. !
  231. register: aListKeyedEntity name: aString
  232. registry at: aString put: aListKeyedEntity
  233. ! !
  234. !Trapped methodsFor: 'action'!
  235. start: args
  236. args do: [ :each | self register: each ].
  237. self injectToElement: document
  238. ! !
  239. !Trapped methodsFor: 'initialization'!
  240. initialize
  241. super initialize.
  242. registry := #{}.
  243. ! !
  244. !Trapped methodsFor: 'private'!
  245. cloneAndInject: anObject
  246. ^anObject asJQuery clone
  247. each: [ :i :each | self injectToElement: each ];
  248. get: 0
  249. !
  250. descend: anArray snapshotDo: aBlock
  251. | tpsc |
  252. tpsc := TrappedPathStack current.
  253. tpsc append: anArray do: [
  254. | path model |
  255. path := tpsc elements copy.
  256. model := self byName: path first.
  257. aBlock value: (TrappedSnapshot new path: path model: model)
  258. ]
  259. !
  260. injectToChildren: anElement
  261. | child |
  262. child := anElement firstChild.
  263. [ child isNil ] whileFalse: [ self injectToElement: child. child := child nextSibling ]
  264. !
  265. injectToElement: anElement
  266. | jq |
  267. jq := anElement asJQuery.
  268. (jq attr: 'data-trap') ifNotNil: [ :attr |
  269. jq removeAttr: 'data-trap'.
  270. (Trapped parse: attr) do: [ :rule |
  271. (HTMLCanvas onJQuery: jq) root trap: rule first processors: (rule at: 2 ifAbsent: [#()]) ] ].
  272. self injectToChildren: anElement
  273. ! !
  274. !Trapped class methodsFor: 'accessing'!
  275. parse: aString
  276. ^ (aString tokenize: '.') collect: [ :rule |
  277. (rule tokenize: ':') collect: [ :message |
  278. | result stack anArray |
  279. anArray := message tokenize: ' '.
  280. result := #().
  281. stack := { result }.
  282. anArray do: [ :each |
  283. | asNum inner close |
  284. close := 0.
  285. inner := each.
  286. [ inner notEmpty and: [ inner first = '(' ]] whileTrue: [ inner := inner allButFirst. stack add: (stack last add: #()) ].
  287. [ inner notEmpty and: [ inner last = ')' ]] whileTrue: [ inner := inner allButLast. close := close + 1 ].
  288. (inner notEmpty and: [ inner first = '#' ]) ifTrue: [ inner := { inner allButFirst } ].
  289. asNum := inner isString ifTrue: [ (inner ifEmpty: [ 'NaN' ]) asNumber ] ifFalse: [ inner ].
  290. asNum = asNum ifTrue: [ stack last add: asNum ] ifFalse: [
  291. inner ifNotEmpty: [ stack last add: inner ] ].
  292. close timesRepeat: [ stack removeLast ] ].
  293. result ] ]
  294. ! !
  295. !Trapped class methodsFor: 'private'!
  296. loop: model before: endjq do: aBlock
  297. model withIndexDo: [ :item :i |
  298. | env envjq |
  299. envjq := document createDocumentFragment asJQuery.
  300. {i} trapDescend: [ (HTMLCanvas onJQuery: envjq) root with: aBlock ].
  301. envjq insertBefore: endjq ]
  302. !
  303. loop: model between: start and: end do: aBlock
  304. (start asJQuery nextUntil: end element) remove.
  305. start with: [ :html | model ifNotNil: [
  306. self loop: model before: end asJQuery do: aBlock
  307. ]]
  308. ! !
  309. TrappedSingleton subclass: #TrappedPathStack
  310. instanceVariableNames: 'elements'
  311. package: 'Trapped-Frontend'!
  312. !TrappedPathStack methodsFor: 'accessing'!
  313. elements
  314. ^elements
  315. ! !
  316. !TrappedPathStack methodsFor: 'descending'!
  317. append: anArray do: aBlock
  318. self with: elements, anArray do: aBlock
  319. !
  320. with: anArray do: aBlock
  321. | old |
  322. old := elements.
  323. [ elements := anArray.
  324. aBlock value ] ensure: [ elements := old ]
  325. ! !
  326. !TrappedPathStack methodsFor: 'initialization'!
  327. initialize
  328. super initialize.
  329. elements := #().
  330. ! !
  331. Object subclass: #TrappedSnapshot
  332. instanceVariableNames: 'path model'
  333. package: 'Trapped-Frontend'!
  334. !TrappedSnapshot methodsFor: 'accessing'!
  335. model
  336. ^model
  337. !
  338. path
  339. ^path
  340. !
  341. path: anArray model: aTrappedMW
  342. path := anArray.
  343. model := aTrappedMW
  344. ! !
  345. !TrappedSnapshot methodsFor: 'action'!
  346. do: aBlock
  347. TrappedPathStack current with: path do: [ aBlock value: model ]
  348. !
  349. modify: aBlock
  350. self model modify: self path allButFirst do: aBlock
  351. !
  352. read: aBlock
  353. self model read: self path allButFirst do: aBlock
  354. !
  355. watch: aBlock
  356. self model watch: self path allButFirst do: aBlock
  357. ! !
  358. !Object methodsFor: '*Trapped-Frontend'!
  359. asTrapProcSendTo: anObject
  360. self error: 'Trapped cannot use processor descriptor of ', self class name, ' type.'
  361. ! !
  362. !String methodsFor: '*Trapped-Frontend'!
  363. asTrapProcSendTo: anObject
  364. ^anObject perform: self
  365. ! !
  366. !Array methodsFor: '*Trapped-Frontend'!
  367. asTrapProcSendTo: anObject
  368. | selector args |
  369. selector := ''.
  370. args := #().
  371. self withIndexDo: [ :element :index | index odd
  372. ifTrue: [ selector := selector, element ]
  373. ifFalse: [ selector := selector, ':'. args add: element ] ].
  374. ^anObject perform: selector withArguments: args
  375. !
  376. trapDescend: aBlock
  377. Trapped current descend: self snapshotDo: aBlock
  378. ! !
  379. !HTMLCanvas methodsFor: '*Trapped-Frontend'!
  380. trapIter: path do: aBlock
  381. self with: [ :html | (html tag: 'script') at: 'type' put: 'application/x-beacon'; trapIter: path after: aBlock ]
  382. ! !
  383. !TagBrush methodsFor: '*Trapped-Frontend'!
  384. trap: path
  385. self trap: path processors: #()
  386. !
  387. trap: path processors: anArray
  388. path trapDescend: [ :snap |
  389. (TrappedProcessingChain newFromProcessorSpecs: anArray)
  390. forSnapshot: snap andBrush: self ]
  391. !
  392. trap: path read: aBlock
  393. path trapDescend: [ :snap |
  394. snap watch: [ :data |
  395. (self asJQuery closest: 'html') toArray isEmpty ifTrue: [ KeyedPubSubUnsubscribe signal ].
  396. snap do: [ self with: [ :html | aBlock value: data value: html ] ]
  397. ]
  398. ]
  399. !
  400. trapGuard: anArray contents: aBlock
  401. #() trapDescend: [ :snap |
  402. | shown |
  403. shown := nil.
  404. self trap: anArray read: [ :gdata |
  405. | sanitized |
  406. sanitized := gdata ifNil: [ false ].
  407. shown = sanitized ifFalse: [
  408. shown := sanitized.
  409. shown
  410. ifTrue: [ snap do: [ self contents: aBlock ]. self asJQuery show ]
  411. ifFalse: [ self asJQuery hide; empty ] ] ] ]
  412. !
  413. trapIter: path after: aBlock
  414. | end |
  415. end := TagBrush fromJQuery: ('<script type="application/x-beacon" />' asJQuery insertAfter: self asJQuery) canvas: canvas.
  416. self trap: path read: [ :model |
  417. Trapped loop: model between: self and: end do: aBlock.
  418. ]
  419. ! !