jade-sql 0.1.0

data/lib/jade-sql/sql/mutation.jd

@@ -0,0 +1,268 @@
+module Sql.Mutation exposing (
+  Mutation,
+  delete,
+  delete_all,
+  insert,
+  insert_all,
+  returning,
+  to_sql,
+  update,
+  update_all,
+)
+
+import Sql exposing (
+  Assignment,
+  Expr(..),
+  Renderable,
+  Selector(..),
+  Table,
+  TableRef(..),
+  pk_values,
+  set_,
+  to_assigns,
+)
+import Sql.Query exposing (Q)
+import Decode exposing (Value)
+
+
+type MutationKind
+  = InsertK
+  | UpdateK
+  | DeleteK
+
+
+struct Mutation(ret, c) = {
+  kind: MutationKind,
+  table: TableRef,
+  cols: c,
+  rows: List(List(Assignment)),
+  wheres: List(Expr(Bool)),
+  returning_selector: Selector(ret)
+}
+
+
+def insert(value: a, t: Table(c, m)) -> Mutation(Int, c)
+  Mutation(
+    InsertK,
+    TableRef(t.name, t.alias_),
+    t.alias_ |> t.cols,
+    [to_assigns(value)],
+    [],
+    Selector([], []),
+  )
+end
+
+
+def insert_all(values: List(a), t: Table(c, m)) -> Mutation(Int, c)
+  Mutation(
+    InsertK,
+    TableRef(t.name, t.alias_),
+    t.alias_ |> t.cols,
+    List.map(values, (v) -> { to_assigns(v) }),
+    [],
+    Selector([], []),
+  )
+end
+
+
+def update(value: a, t: Table(c, m)) -> Mutation(Int, c)
+  pk_pred = pk_predicate(t.pk_columns, pk_values(value))
+
+  Mutation(
+    UpdateK,
+    TableRef(t.name, t.alias_),
+    t.alias_ |> t.cols,
+    [to_assigns(value)],
+    [pk_pred],
+    Selector([], []),
+  )
+end
+
+
+def delete(value: a, t: Table(c, m)) -> Mutation(Int, c)
+  pk_pred = pk_predicate(t.pk_columns, pk_values(value))
+
+  Mutation(
+    DeleteK,
+    TableRef(t.name, t.alias_),
+    t.alias_ |> t.cols,
+    [],
+    [pk_pred],
+    Selector([], []),
+  )
+end
+
+
+def update_all(
+  t: Table(c, m),
+  pred_fn: c -> Expr(Bool),
+  build: c -> List(Assignment),
+) -> Mutation(Int, c)
+  cols_ = t.alias_ |> t.cols
+  pred = cols_ |> pred_fn
+
+  Mutation(
+    UpdateK,
+    TableRef(t.name, t.alias_),
+    cols_,
+    [cols_ |> build],
+    [pred],
+    Selector([], []),
+  )
+end
+
+
+def delete_all(t: Table(c, m), pred_fn: c -> Expr(Bool)) -> Mutation(Int, c)
+  cols_ = t.alias_ |> t.cols
+  pred = cols_ |> pred_fn
+
+  Mutation(
+    DeleteK,
+    TableRef(t.name, t.alias_),
+    cols_,
+    [],
+    [pred],
+    Selector([], []),
+  )
+end
+
+
+def returning(m: Mutation(a, c), build: c -> Q(Selector(b))) -> Mutation(b, c)
+  Mutation(m.kind, m.table, m.cols, m.rows, m.wheres, build(m.cols).result)
+end
+
+
+def pk_predicate(cols: List(String), values: List(Value)) -> Expr(Bool)
+  sql = cols
+    |> List.map((col) -> { col ++ " = ?" })
+    |> String.join(" AND ")
+
+  Expr(sql, values)
+end
+
+
+def render_row(row: List(Assignment)) -> String
+  cols_part = row
+    |> List.map((a) -> { a.value_sql })
+    |> String.join(", ")
+
+  "(" ++ cols_part ++ ")"
+end
+
+
+def returning_clause(s: Selector(ret)) -> String
+  List.empty?(s.columns_sql) ? "" : " RETURNING " ++ String.join(s.columns_sql, ", ")
+end
+
+
+def insert_cols_str(rows: List(List(Assignment))) -> String
+  case rows
+  in [] then ""
+  in [first | _]
+    "(" ++ String.join(List.map(first, (a) -> { a.col }), ", ") ++ ")"
+  end
+end
+
+
+def insert_params(rows: List(List(Assignment))) -> List(Value)
+  List.fold(
+    rows,
+    [],
+    (acc, row) -> { acc ++ List.fold(row, [], (acc2, a) -> { acc2 ++ a.params }) },
+  )
+end
+
+
+def set_sqls_for(rows: List(List(Assignment))) -> List(String)
+  case rows
+  in [first | _] then List.map(first, (a) -> { a.col ++ " = " ++ a.value_sql })
+  in [] then []
+  end
+end
+
+
+def set_params_for(rows: List(List(Assignment))) -> List(Value)
+  case rows
+  in [first | _] then List.fold(first, [], (acc, a) -> { acc ++ a.params })
+  in [] then []
+  end
+end
+
+
+def where_sql(wheres: List(Expr(Bool))) -> String
+  List.empty?(wheres)
+    ? ""
+    : " WHERE " ++ String.join(List.map(wheres, (w) -> { w.sql }), " AND ")
+end
+
+
+def where_params(wheres: List(Expr(Bool))) -> List(Value)
+  List.fold(wheres, [], (acc, w) -> { acc ++ w.params })
+end
+
+
+def strip_table_alias(sql: String, alias_: String) -> String
+  String.replace(sql, alias_ ++ ".", "")
+end
+
+
+def render_insert(m: Mutation(ret, c)) -> (String, List(Value))
+  cols_str = insert_cols_str(m.rows)
+  values_str = m.rows
+    |> List.map(render_row)
+    |> String.join(", ")
+  returning_ = strip_table_alias(returning_clause(m.returning_selector), m.table.alias_)
+  sql = "INSERT INTO "
+    ++ m.table.name
+    ++ " "
+    ++ cols_str
+    ++ " VALUES "
+    ++ values_str
+    ++ returning_
+
+  Tuple.Tuple2(sql, insert_params(m.rows) ++ m.returning_selector.params)
+end
+
+
+def render_update(m: Mutation(ret, c)) -> (String, List(Value))
+  set_clause = "SET " ++ String.join(set_sqls_for(m.rows), ", ")
+  where = strip_table_alias(where_sql(m.wheres), m.table.alias_)
+  returning_ = strip_table_alias(returning_clause(m.returning_selector), m.table.alias_)
+  sql = "UPDATE "
+    ++ m.table.name
+    ++ " "
+    ++ set_clause
+    ++ where
+    ++ returning_
+
+  Tuple.Tuple2(
+    sql,
+    set_params_for(m.rows) ++ where_params(m.wheres) ++ m.returning_selector.params,
+  )
+end
+
+
+def render_delete(m: Mutation(ret, c)) -> (String, List(Value))
+  where = strip_table_alias(where_sql(m.wheres), m.table.alias_)
+  returning_ = strip_table_alias(returning_clause(m.returning_selector), m.table.alias_)
+  sql = "DELETE FROM "
+    ++ m.table.name
+    ++ where
+    ++ returning_
+
+  Tuple.Tuple2(sql, where_params(m.wheres) ++ m.returning_selector.params)
+end
+
+
+def to_sql(m: Mutation(ret, c)) -> (String, List(Value))
+  case m.kind
+  in InsertK then render_insert(m)
+  in UpdateK then render_update(m)
+  in DeleteK then render_delete(m)
+  end
+end
+
+
+implements Renderable(Mutation(ret, c)) with
+  render: to_sql
+end

data/lib/jade-sql/sql/query.jd

@@ -0,0 +1,313 @@
+module Sql.Query exposing (
+  Q,
+  field,
+  from,
+  group,
+  join,
+  left_join,
+  limit,
+  offset,
+  order,
+  order_desc,
+  select,
+  to_sql,
+  where,
+)
+
+import Sql exposing (Expr, Renderable, Selector(..), Table, TableRef(..))
+import Decode exposing (Value)
+
+
+type JoinKind
+  = InnerJ
+  | LeftJ
+
+
+struct Join = {
+  kind: JoinKind,
+  name: String,
+  alias_: String,
+  on: Expr(Bool)
+}
+
+
+type OrderDir
+  = Asc
+  | Desc
+
+
+struct OrderTerm = {
+  dir: OrderDir,
+  sql: String,
+  params: List(Value)
+}
+
+
+struct GroupTerm = {
+  sql: String,
+  params: List(Value)
+}
+
+
+struct Q(a) = {
+  tables: List(TableRef),
+  joins: List(Join),
+  wheres: List(Expr(Bool)),
+  groups: List(GroupTerm),
+  orders: List(OrderTerm),
+  limit_: Maybe(Int),
+  offset_: Maybe(Int),
+  result: a
+}
+
+
+implements Chainable(Q(a)) with
+  and_then: q_and_then
+end
+
+
+def q_and_then(q: Q(a), fn: a -> Q(b)) -> Q(b)
+  next_ = q.result |> fn
+
+  Q(
+    q.tables ++ next_.tables,
+    q.joins ++ next_.joins,
+    q.wheres ++ next_.wheres,
+    q.groups ++ next_.groups,
+    q.orders ++ next_.orders,
+    merge_paging(q.limit_, next_.limit_),
+    merge_paging(q.offset_, next_.offset_),
+    next_.result,
+  )
+end
+
+
+def merge_paging(prev: Maybe(Int), next_: Maybe(Int)) -> Maybe(Int)
+  case next_
+  in Just(_) then next_
+  in Nothing then prev
+  end
+end
+
+
+def from(t: Table(c, m)) -> Q(c)
+  cols_ = t.alias_ |> t.cols
+
+  Q([TableRef(t.name, t.alias_)], [], [], [], [], Nothing, Nothing, cols_)
+end
+
+
+def join(t: Table(c, m), on_: c -> Expr(Bool)) -> Q(c)
+  cols_ = t.alias_ |> t.cols
+  pred = cols_ |> on_
+
+  Q(
+    [],
+    [Join(InnerJ, t.name, t.alias_, pred)],
+    [],
+    [],
+    [],
+    Nothing,
+    Nothing,
+    cols_,
+  )
+end
+
+
+def left_join(t: Table(c, m), on_: c -> Expr(Bool)) -> Q(m)
+  cols_strict = t.alias_ |> t.cols
+  cols_maybe = t.alias_ |> t.maybe_cols
+  pred = cols_strict |> on_
+
+  Q(
+    [],
+    [Join(LeftJ, t.name, t.alias_, pred)],
+    [],
+    [],
+    [],
+    Nothing,
+    Nothing,
+    cols_maybe,
+  )
+end
+
+
+def where(q: Q(a), predicate: Expr(Bool)) -> Q(a)
+  Q(
+    q.tables,
+    q.joins,
+    q.wheres ++ [predicate],
+    q.groups,
+    q.orders,
+    q.limit_,
+    q.offset_,
+    q.result,
+  )
+end
+
+
+def group(q: Q(a), e: Expr(b)) -> Q(a)
+  Q(
+    q.tables,
+    q.joins,
+    q.wheres,
+    q.groups ++ [GroupTerm(e.sql, e.params)],
+    q.orders,
+    q.limit_,
+    q.offset_,
+    q.result,
+  )
+end
+
+
+def order(q: Q(a), e: Expr(b)) -> Q(a)
+  Q(
+    q.tables,
+    q.joins,
+    q.wheres,
+    q.groups,
+    q.orders ++ [OrderTerm(Asc, e.sql, e.params)],
+    q.limit_,
+    q.offset_,
+    q.result,
+  )
+end
+
+
+def order_desc(q: Q(a), e: Expr(b)) -> Q(a)
+  Q(
+    q.tables,
+    q.joins,
+    q.wheres,
+    q.groups,
+    q.orders ++ [OrderTerm(Desc, e.sql, e.params)],
+    q.limit_,
+    q.offset_,
+    q.result,
+  )
+end
+
+
+def limit(q: Q(a), n: Int) -> Q(a)
+  Q(
+    q.tables,
+    q.joins,
+    q.wheres,
+    q.groups,
+    q.orders,
+    Just(n),
+    q.offset_,
+    q.result,
+  )
+end
+
+
+def offset(q: Q(a), n: Int) -> Q(a)
+  Q(
+    q.tables,
+    q.joins,
+    q.wheres,
+    q.groups,
+    q.orders,
+    q.limit_,
+    Just(n),
+    q.result,
+  )
+end
+
+
+def select(make: a -> b) -> Q(Selector(a -> b))
+  Q([], [], [], [], [], Nothing, Nothing, Selector([], []))
+end
+
+
+def field(qs: Q(Selector(a -> b)), e: Expr(a)) -> Q(Selector(b))
+  Q(
+    qs.tables,
+    qs.joins,
+    qs.wheres,
+    qs.groups,
+    qs.orders,
+    qs.limit_,
+    qs.offset_,
+    Selector(qs.result.columns_sql ++ [e.sql], qs.result.params ++ e.params),
+  )
+end
+
+
+def join_keyword(k: JoinKind) -> String
+  case k
+  in InnerJ then "INNER JOIN"
+  in LeftJ then "LEFT JOIN"
+  end
+end
+
+
+def render_join(j: Join) -> String
+  join_keyword(j.kind) ++ " " ++ j.name ++ " " ++ j.alias_ ++ " ON " ++ j.on.sql
+end
+
+
+def render_order_term(t: OrderTerm) -> String
+  case t.dir
+  in Asc then t.sql
+  in Desc then t.sql ++ " DESC"
+  end
+end
+
+
+def render_from(tables: List(TableRef)) -> String
+  case tables
+  in [] then ""
+  in [first | _] then " FROM " ++ first.name ++ " " ++ first.alias_
+  end
+end
+
+
+def render_int_clause(keyword: String, m: Maybe(Int)) -> String
+  case m
+  in Just(n) then keyword ++ String.from_int(n)
+  in Nothing then ""
+  end
+end
+
+
+implements Renderable(Q(Selector(a))) with
+  render: to_sql
+end
+
+
+def to_sql(q: Q(Selector(a))) -> (String, List(Value))
+  select_clause = "SELECT " ++ String.join(q.result.columns_sql, ", ")
+  from_clause = render_from(q.tables)
+  joins_clause = q.joins
+    |> List.map((j) -> { " " ++ render_join(j) })
+    |> String.concat
+  where_clause = List.empty?(q.wheres)
+    ? ""
+    : " WHERE " ++ String.join(List.map(q.wheres, (w) -> { w.sql }), " AND ")
+  group_clause = List.empty?(q.groups)
+    ? ""
+    : " GROUP BY " ++ String.join(List.map(q.groups, (g) -> { g.sql }), ", ")
+  order_clause = List.empty?(q.orders)
+    ? ""
+    : " ORDER BY " ++ String.join(List.map(q.orders, render_order_term), ", ")
+  limit_clause = render_int_clause(" LIMIT ", q.limit_)
+  offset_clause = render_int_clause(" OFFSET ", q.offset_)
+  join_ps = List.fold(q.joins, [], (acc, j) -> { acc ++ j.on.params })
+  where_ps = List.fold(q.wheres, [], (acc, w) -> { acc ++ w.params })
+  group_ps = List.fold(q.groups, [], (acc, g) -> { acc ++ g.params })
+  order_ps = List.fold(q.orders, [], (acc, o) -> { acc ++ o.params })
+
+  Tuple.Tuple2(
+    select_clause
+      ++ from_clause
+      ++ joins_clause
+      ++ where_clause
+      ++ group_clause
+      ++ order_clause
+      ++ limit_clause
+      ++ offset_clause,
+    q.result.params ++ join_ps ++ where_ps ++ group_ps ++ order_ps,
+  )
+end

data/lib/jade-sql/sql/uuid.jd

@@ -0,0 +1,126 @@
+module Sql.Uuid exposing (
+  Uuid,
+  from_b64,
+  parse,
+  to_b64,
+  to_string,
+  v4,
+  v7,
+)
+
+import Decode exposing (Decodable, Decoder, Value)
+import Encode exposing (Encodable)
+import Bytes exposing (Bytes)
+
+
+type Uuid = Uuid(String)
+
+
+uses JadeSql::Uuid::Runtime with
+  generate_v4 : Task({ value: String }, Never),
+  generate_v7 : Task({ value: String }, Never)
+end
+
+
+def v4 -> Task(Uuid, Never)
+  raw <- generate_v4()
+
+  Task.succeed(Uuid(raw.value))
+end
+
+
+def v7 -> Task(Uuid, Never)
+  raw <- generate_v7()
+
+  Task.succeed(Uuid(raw.value))
+end
+
+
+def to_string(u: Uuid) -> String
+  Uuid(s) = u
+
+  s
+end
+
+
+def parse(s: String) -> Maybe(Uuid)
+  valid_form(s) ? Just(Uuid(String.to_lower(s))) : Nothing
+end
+
+
+def valid_form(s: String) -> Bool
+  case String.split(s, "-")
+  in [a, b, c, d, e] then valid_widths(a, b, c, d, e)
+  else False
+  end
+end
+
+
+def valid_widths(a: String, b: String, c: String, d: String, e: String) -> Bool
+  String.length(a) == 8 && String.length(b) == 4 && String.length(c) == 4 && String.length(d) == 4 && String.length(e) == 12
+end
+
+
+def uuid_eq(a: Uuid, b: Uuid) -> Bool
+  Uuid(sa) = a
+  Uuid(sb) = b
+
+  sa == sb
+end
+
+
+implements Eq(Uuid) with
+  (==): uuid_eq
+end
+
+
+def parse_decoder(s: String) -> Decoder(Uuid)
+  case parse(s)
+  in Just(u) then Decode.succeed(u)
+  in Nothing then Decode.fail("invalid uuid: " ++ s)
+  end
+end
+
+
+implements Decodable(Uuid) with
+  decoder: -> { Decode.string |> Decode.and_then(parse_decoder) }
+end
+
+
+implements Encodable(Uuid) with
+  encoder: (u) -> { Encode.string(to_string(u)) }
+end
+
+
+def to_b64(u: Uuid) -> String
+  Uuid(s) = u
+
+  s
+    |> String.replace("-", "")
+    |> Bytes.from_hex
+    |> Maybe.map(Bytes.to_base64_url)
+    |> Maybe.with_default("")
+end
+
+
+def from_b64(s: String) -> Maybe(Uuid)
+  Bytes.from_base64_url(s) |> Maybe.and_then(uuid_from_bytes)
+end
+
+
+def uuid_from_bytes(b: Bytes) -> Maybe(Uuid)
+  Bytes.width(b) == 16 ? parse(canonical_form(Bytes.to_hex(b))) : Nothing
+end
+
+
+def canonical_form(hex32: String) -> String
+  String.slice(hex32, 0, 8)
+    ++ "-"
+    ++ String.slice(hex32, 8, 12)
+    ++ "-"
+    ++ String.slice(hex32, 12, 16)
+    ++ "-"
+    ++ String.slice(hex32, 16, 20)
+    ++ "-"
+    ++ String.slice(hex32, 20, 32)
+end