Ur/Web: tests/tags.ur annotate

Some more optimization of string expressions showing up in JSON generation (Meta library)

author	Adam Chlipala <adam@chlipala.net>
date	Wed, 03 Dec 2014 21:06:15 -0500
parents	884673e5f7d5
children

rev	line source
adam@2031	1 table images : { Id : int, Content : blob }
adam@2031	2 table tags : { Id : int, Tag : string }
adam@2031	3
adam@2031	4 datatype mode = Present \| Absent
adam@2031	5 type condition = { Tag : string, Mode : mode }
adam@2031	6
adam@2031	7 type tag_query = sql_query [] [] [] [Id = int]
adam@2031	8
adam@2031	9 fun addCondition (c : condition) (q : tag_query) : tag_query =
adam@2031	10 case c.Mode of
adam@2031	11 Present => (SELECT I.Id AS Id
adam@2031	12 FROM ({{q}}) AS I
adam@2031	13 JOIN tags ON tags.Id = I.Id AND tags.Tag = {[c.Tag]})
adam@2032	14 \| Absent => (SELECT I.Id AS Id
adam@2032	15 FROM ({{q}}) AS I
adam@2032	16 LEFT JOIN tags ON tags.Id = I.Id AND tags.Tag = {[c.Tag]}
adam@2032	17 WHERE tags.Tag IS NULL)
adam@2031	18
adam@2031	19 fun withConditions (cs : list condition) : tag_query =
adam@2031	20 List.foldl addCondition (SELECT images.Id AS Id FROM images) cs
adam@2031	21
adam@2031	22 fun main (cs : list condition) : transaction page =
adam@2031	23 x <- queryX (withConditions cs) (fn r => <xml><li>{[r.Id]}</li></xml>);
adam@2031	24 return <xml><body>
adam@2031	25 {x}
adam@2031	26 </body></xml>

Mercurial > urweb