Mercurial > urweb

annotate lib/basis.lig @ 223:bbe5899a9585

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Queries back to working as well as before, after start of refactoring to support grouping
author Adam Chlipala <adamc@hcoop.net>
date Thu, 21 Aug 2008 12:49:29 -0400
parents 79819a6346e2
children cb8a68964ebb
rev   line source
adamc@56 1 type int
adamc@56 2 type float
adamc@56 3 type string
adamc@91 4
adamc@119 5 type unit = {}
adamc@119 6
adamc@186 7 datatype bool = False | True
adamc@186 8
adamc@91 9
adamc@203 10 (** SQL *)
adamc@203 11
adamc@203 12 con sql_table :: {Type} -> Type
adamc@203 13
adamc@204 14 (*** Queries *)
adamc@204 15
adamc@204 16 con sql_query :: {{Type}} -> Type
adamc@223 17 con sql_exp :: {{Type}} -> {{Type}} -> Type -> Type
adamc@204 18
adamc@223 19 con sql_subset :: {{Type}} -> {{Type}} -> Type
adamc@223 20 val sql_subset : keep_drop :: {({Type} * {Type})}
adamc@223 21 -> sql_subset
adamc@223 22 (fold (fn nm => fn fields :: ({Type} * {Type}) => fn acc =>
adamc@223 23 [nm] ~ acc => fields.1 ~ fields.2 =>
adamc@223 24 [nm = fields.1 ++ fields.2] ++ acc) [] keep_drop)
adamc@223 25 (fold (fn nm => fn fields :: ({Type} * {Type}) => fn acc =>
adamc@223 26 [nm] ~ acc =>
adamc@223 27 [nm = fields.1] ++ acc) [] keep_drop)
adamc@223 28 val sql_subset_all : tables :: {{Type}}
adamc@223 29 -> sql_subset tables tables
adamc@223 30
adamc@223 31 val sql_query : tables ::: {{Type}}
adamc@223 32 (*-> grouped ::: {{Type}}*)
adamc@223 33 -> selected ::: {{Type}}
adamc@223 34 -> {From : $(fold (fn nm => fn fields :: {Type} => fn acc =>
adamc@223 35 [nm] ~ acc => [nm = sql_table fields] ++ acc) [] tables),
adamc@223 36 Where : sql_exp tables [] bool,
adamc@223 37 (*GroupBy : sql_subset tables grouped,
adamc@223 38 Having : sql_exp grouped tables bool,*)
adamc@223 39 SelectFields : sql_subset tables selected}
adamc@223 40 -> sql_query selected
adamc@204 41
adamc@221 42 val sql_field : otherTabs ::: {{Type}} -> otherFields ::: {Type} -> fieldType ::: Type
adamc@221 43 -> tab :: Name -> field :: Name
adamc@223 44 -> agg ::: {{Type}}
adamc@223 45 -> sql_exp ([tab = [field = fieldType] ++ otherFields] ++ otherTabs) agg fieldType
adamc@209 46
adamc@221 47 class sql_injectable
adamc@221 48 val sql_bool : sql_injectable bool
adamc@221 49 val sql_int : sql_injectable int
adamc@221 50 val sql_float : sql_injectable float
adamc@221 51 val sql_string : sql_injectable string
adamc@223 52 val sql_inject : tables ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> t -> sql_injectable t -> sql_exp tables agg t
adamc@209 53
adamc@220 54 con sql_unary :: Type -> Type -> Type
adamc@220 55 val sql_not : sql_unary bool bool
adamc@223 56 val sql_unary : tables ::: {{Type}} -> agg ::: {{Type}} -> arg ::: Type -> res ::: Type
adamc@223 57 -> sql_unary arg res -> sql_exp tables agg arg -> sql_exp tables agg res
adamc@220 58
adamc@220 59 con sql_binary :: Type -> Type -> Type -> Type
adamc@220 60 val sql_and : sql_binary bool bool bool
adamc@220 61 val sql_or : sql_binary bool bool bool
adamc@223 62 val sql_binary : tables ::: {{Type}} -> agg ::: {{Type}} -> arg1 ::: Type -> arg2 ::: Type -> res ::: Type
adamc@223 63 -> sql_binary arg1 arg2 res -> sql_exp tables agg arg1 -> sql_exp tables agg arg2 -> sql_exp tables agg res
adamc@220 64
adamc@219 65 type sql_comparison
adamc@219 66 val sql_eq : sql_comparison
adamc@219 67 val sql_ne : sql_comparison
adamc@219 68 val sql_lt : sql_comparison
adamc@219 69 val sql_le : sql_comparison
adamc@219 70 val sql_gt : sql_comparison
adamc@219 71 val sql_ge : sql_comparison
adamc@219 72 val sql_comparison : sql_comparison
adamc@223 73 -> tables ::: {{Type}} -> agg ::: {{Type}} -> t ::: Type -> sql_exp tables agg t -> sql_exp tables agg t
adamc@223 74 -> sql_injectable t -> sql_exp tables agg bool
adamc@203 75
adamc@203 76 (** XML *)
adamc@203 77
adamc@139 78 con tag :: {Type} -> {Unit} -> {Unit} -> {Type} -> {Type} -> Type
adamc@91 79
adamc@91 80
adamc@139 81 con xml :: {Unit} -> {Type} -> {Type} -> Type
adamc@141 82 val cdata : ctx ::: {Unit} -> use ::: {Type} -> string -> xml ctx use []
adamc@104 83 val tag : attrsGiven ::: {Type} -> attrsAbsent ::: {Type} -> attrsGiven ~ attrsAbsent
adamc@139 84 -> ctxOuter ::: {Unit} -> ctxInner ::: {Unit}
adamc@139 85 -> useOuter ::: {Type} -> useInner ::: {Type} -> useOuter ~ useInner
adamc@139 86 -> bindOuter ::: {Type} -> bindInner ::: {Type} -> bindOuter ~ bindInner
adamc@104 87 -> $attrsGiven
adamc@139 88 -> tag (attrsGiven ++ attrsAbsent) ctxOuter ctxInner useOuter bindOuter
adamc@139 89 -> xml ctxInner useInner bindInner
adamc@139 90 -> xml ctxOuter (useOuter ++ useInner) (bindOuter ++ bindInner)
adamc@140 91 val join : ctx ::: {Unit}
adamc@139 92 -> use1 ::: {Type} -> bind1 ::: {Type} -> bind2 ::: {Type}
adamc@139 93 -> use1 ~ bind1 -> bind1 ~ bind2
adamc@140 94 -> xml ctx use1 bind1
adamc@140 95 -> xml ctx (use1 ++ bind1) bind2
adamc@140 96 -> xml ctx use1 (bind1 ++ bind2)
adamc@148 97 val useMore : ctx ::: {Unit} -> use1 ::: {Type} -> use2 ::: {Type} -> bind ::: {Type}
adamc@148 98 -> use1 ~ use2
adamc@148 99 -> xml ctx use1 bind
adamc@148 100 -> xml ctx (use1 ++ use2) bind
adamc@91 101
adamc@110 102 con xhtml = xml [Html]
adamc@139 103 con page = xhtml [] []
adamc@110 104
adamc@204 105 (*** HTML details *)
adamc@204 106
adamc@140 107 con html = [Html]
adamc@140 108 con head = [Head]
adamc@140 109 con body = [Body]
adamc@141 110 con lform = [Body, LForm]
adamc@93 111
adamc@140 112 val head : unit -> tag [] html head [] []
adamc@140 113 val title : unit -> tag [] head [] [] []
adamc@110 114
adamc@140 115 val body : unit -> tag [] html body [] []
adamc@140 116 con bodyTag = fn attrs :: {Type} => ctx ::: {Unit} -> [Body] ~ ctx -> unit
adamc@140 117 -> tag attrs ([Body] ++ ctx) ([Body] ++ ctx) [] []
adamc@141 118 con bodyTagStandalone = fn attrs :: {Type} => ctx ::: {Unit} -> [Body] ~ ctx -> unit
adamc@141 119 -> tag attrs ([Body] ++ ctx) [] [] []
adamc@141 120
adamc@141 121 val br : bodyTagStandalone []
adamc@119 122
adamc@140 123 val p : bodyTag []
adamc@140 124 val b : bodyTag []
adamc@140 125 val i : bodyTag []
adamc@140 126 val font : bodyTag [Size = int, Face = string]
adamc@140 127
adamc@140 128 val h1 : bodyTag []
adamc@140 129 val li : bodyTag []
adamc@140 130
adamc@140 131 val a : bodyTag [Link = page]
adamc@140 132
adamc@141 133 val lform : ctx ::: {Unit} -> [Body] ~ ctx -> bind ::: {Type}
adamc@141 134 -> xml lform [] bind
adamc@141 135 -> xml ([Body] ++ ctx) [] []
adamc@153 136 con lformTag = fn ty :: Type => fn inner :: {Unit} => fn attrs :: {Type} =>
adamc@141 137 ctx ::: {Unit} -> [LForm] ~ ctx
adamc@141 138 -> nm :: Name -> unit
adamc@153 139 -> tag attrs ([LForm] ++ ctx) inner [] [nm = ty]
adamc@153 140 val textbox : lformTag string [] []
adamc@155 141 val password : lformTag string [] []
adamc@153 142 val ltextarea : lformTag string [] []
adamc@153 143
adamc@190 144 val checkbox : lformTag bool [] []
adamc@190 145
adamc@153 146 con radio = [Body, Radio]
adamc@153 147 val radio : lformTag string radio []
adamc@153 148 val radioOption : unit -> tag [Value = string] radio [] [] []
adamc@142 149
adamc@154 150 con select = [Select]
adamc@154 151 val lselect : lformTag string select []
adamc@154 152 val loption : unit -> tag [Value = string] select [] [] []
adamc@154 153
adamc@142 154 val submit : ctx ::: {Unit} -> [LForm] ~ ctx
adamc@142 155 -> use ::: {Type} -> unit
adamc@142 156 -> tag [Action = $use -> page] ([LForm] ++ ctx) ([LForm] ++ ctx) use []