Trapped-Frontend.st 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541
  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 injectToJQuery: 'html' asJQuery
  238. ! !
  239. !Trapped methodsFor: 'initialization'!
  240. initialize
  241. super initialize.
  242. registry := #{}.
  243. ! !
  244. !Trapped methodsFor: 'private'!
  245. cloneAndInject: anObject inPlaceOf: aTagBrush
  246. aTagBrush asJQuery append: anObject clone.
  247. self injectToJQuery: aTagBrush asJQuery.
  248. aTagBrush asJQuery contents unwrap
  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. injectToJQuery: aJQuery
  261. aJQuery each: [ :index :elem |
  262. | jq |
  263. jq := elem asJQuery.
  264. (jq is: '[data-trap]')
  265. ifTrue: [
  266. | parsed |
  267. parsed := Trapped parse: (jq attr: 'data-trap').
  268. jq removeAttr: 'data-trap'.
  269. parsed do: [ :rule |
  270. (HTMLCanvas onJQuery: jq) root trap: rule first processors: (rule at: 2 ifAbsent: [#()]) ] ].
  271. self injectToJQuery: jq children ]
  272. ! !
  273. !Trapped class methodsFor: 'accessing'!
  274. parse: aString
  275. ^ (aString tokenize: '.') collect: [ :rule |
  276. (rule tokenize: ':') collect: [ :message |
  277. | result stack anArray |
  278. anArray := message tokenize: ' '.
  279. result := #().
  280. stack := { result }.
  281. anArray do: [ :each |
  282. | asNum inner close |
  283. close := 0.
  284. inner := each.
  285. [ inner notEmpty and: [ inner first = '(' ]] whileTrue: [ inner := inner allButFirst. stack add: (stack last add: #()) ].
  286. [ inner notEmpty and: [ inner last = ')' ]] whileTrue: [ inner := inner allButLast. close := close + 1 ].
  287. (inner notEmpty and: [ inner first = '#' ]) ifTrue: [ inner := { inner allButFirst } ].
  288. asNum := inner isString ifTrue: [ (inner ifEmpty: [ 'NaN' ]) asNumber ] ifFalse: [ inner ].
  289. asNum = asNum ifTrue: [ stack last add: asNum ] ifFalse: [
  290. inner ifNotEmpty: [ stack last add: inner ] ].
  291. close timesRepeat: [ stack removeLast ] ].
  292. result ] ]
  293. ! !
  294. !Trapped class methodsFor: 'private'!
  295. loop: model before: endjq do: aBlock
  296. model withIndexDo: [ :item :i |
  297. | env envjq |
  298. envjq := '<div/>' asJQuery insertBefore: endjq.
  299. {i} trapDescend: [ (HTMLCanvas onJQuery: envjq) root with: aBlock ].
  300. envjq contents unwrap ]
  301. !
  302. loop: model between: start and: end do: aBlock
  303. (start asJQuery nextUntil: end element) remove.
  304. start with: [ :html | model ifNotNil: [
  305. self loop: model before: end asJQuery do: aBlock
  306. ]]
  307. ! !
  308. TrappedSingleton subclass: #TrappedPathStack
  309. instanceVariableNames: 'elements'
  310. package: 'Trapped-Frontend'!
  311. !TrappedPathStack methodsFor: 'accessing'!
  312. elements
  313. ^elements
  314. ! !
  315. !TrappedPathStack methodsFor: 'descending'!
  316. append: anArray do: aBlock
  317. self with: elements, anArray do: aBlock
  318. !
  319. with: anArray do: aBlock
  320. | old |
  321. old := elements.
  322. [ elements := anArray.
  323. aBlock value ] ensure: [ elements := old ]
  324. ! !
  325. !TrappedPathStack methodsFor: 'initialization'!
  326. initialize
  327. super initialize.
  328. elements := #().
  329. ! !
  330. Object subclass: #TrappedSnapshot
  331. instanceVariableNames: 'path model'
  332. package: 'Trapped-Frontend'!
  333. !TrappedSnapshot methodsFor: 'accessing'!
  334. model
  335. ^model
  336. !
  337. path
  338. ^path
  339. !
  340. path: anArray model: aTrappedMW
  341. path := anArray.
  342. model := aTrappedMW
  343. ! !
  344. !TrappedSnapshot methodsFor: 'action'!
  345. do: aBlock
  346. TrappedPathStack current with: path do: [ aBlock value: model ]
  347. !
  348. modify: aBlock
  349. self model modify: self path allButFirst do: aBlock
  350. !
  351. read: aBlock
  352. self model read: self path allButFirst do: aBlock
  353. !
  354. watch: aBlock
  355. self model watch: self path allButFirst do: aBlock
  356. ! !
  357. !Object methodsFor: '*Trapped-Frontend'!
  358. asTrapProcSendTo: anObject
  359. self error: 'Trapped cannot use processor descriptor of ', self class name, ' type.'
  360. ! !
  361. !String methodsFor: '*Trapped-Frontend'!
  362. asTrapProcSendTo: anObject
  363. ^anObject perform: self
  364. ! !
  365. !Array methodsFor: '*Trapped-Frontend'!
  366. asTrapProcSendTo: anObject
  367. | selector args |
  368. selector := ''.
  369. args := #().
  370. self withIndexDo: [ :element :index | index odd
  371. ifTrue: [ selector := selector, element ]
  372. ifFalse: [ selector := selector, ':'. args add: element ] ].
  373. ^anObject perform: selector withArguments: args
  374. !
  375. trapDescend: aBlock
  376. Trapped current descend: self snapshotDo: aBlock
  377. ! !
  378. !HTMLCanvas methodsFor: '*Trapped-Frontend'!
  379. trapIter: path do: aBlock
  380. self with: [ :html | (html tag: 'script') at: 'type' put: 'application/x-beacon'; trapIter: path after: aBlock ]
  381. ! !
  382. !TagBrush methodsFor: '*Trapped-Frontend'!
  383. trap: path
  384. self trap: path processors: #()
  385. !
  386. trap: path processors: anArray
  387. path trapDescend: [ :snap |
  388. (TrappedProcessingChain newFromProcessorSpecs: anArray)
  389. forSnapshot: snap andBrush: self ]
  390. !
  391. trap: path read: aBlock
  392. path trapDescend: [ :snap |
  393. snap watch: [ :data |
  394. (self asJQuery closest: 'html') toArray isEmpty ifTrue: [ KeyedPubSubUnsubscribe signal ].
  395. snap do: [ self with: [ :html | aBlock value: data value: html ] ]
  396. ]
  397. ]
  398. !
  399. trapGuard: anArray contents: aBlock
  400. #() trapDescend: [ :snap |
  401. | shown |
  402. shown := nil.
  403. self trap: anArray read: [ :gdata |
  404. | sanitized |
  405. sanitized := gdata ifNil: [ false ].
  406. shown = sanitized ifFalse: [
  407. shown := sanitized.
  408. shown
  409. ifTrue: [ snap do: [ self contents: aBlock ]. self asJQuery show ]
  410. ifFalse: [ self asJQuery hide; empty ] ] ] ]
  411. !
  412. trapIter: path after: aBlock
  413. | end |
  414. end := TagBrush fromJQuery: ('<script type="application/x-beacon" />' asJQuery insertAfter: self asJQuery) canvas: canvas.
  415. self trap: path read: [ :model |
  416. Trapped loop: model between: self and: end do: aBlock.
  417. ]
  418. ! !