main.ml

type name = string
type non_nullable = [ `value ]
type nullable = [ `null | `value ]

module Scope : sig
  type (+'a, 'nullability) any_scope
    constraint 'a = < .. > constraint 'nullability = [< nullable ]

  type +'a scope = ('a, non_nullable) any_scope
  type +'a nullable_scope = ('a, nullable) any_scope

  type (+'a, +'agg, 'nullability) any_aggregate_scope
    constraint 'a = < .. >
    constraint 'agg = < .. >
    constraint 'nullability = [< nullable ]

  type (+'a, +'agg) aggregate_scope =
    ('a, 'agg, non_nullable) any_aggregate_scope

  type (+'a, +'agg) nullableaggregate_scope =
    ('a, 'agg, nullable) any_aggregate_scope

  val nested : ('v -> ('w, 'n) any_scope) -> 'v scope -> ('w, 'n) any_scope

  val nested_opt :
    ('v -> ('w, 'n) any_scope) -> 'v nullable_scope -> 'w nullable_scope

  val scope : 'a -> 'a scope
end = struct
  type (+'a, 'nullability) any_scope
    constraint 'a = < .. > constraint 'nullability = [< nullable ]

  type +'a scope = ('a, non_nullable) any_scope
  type +'a nullable_scope = ('a, nullable) any_scope

  type (+'a, +'agg, 'nullability) any_aggregate_scope
    constraint 'a = < .. >
    constraint 'agg = < .. >
    constraint 'nullability = [< nullable ]

  type (+'a, +'agg) aggregate_scope =
    ('a, 'agg, non_nullable) any_aggregate_scope

  type (+'a, +'agg) nullableaggregate_scope =
    ('a, 'agg, nullable) any_aggregate_scope

  let nested _ _ = assert false
  let nested_opt _ _ = assert false
  let scope _ = assert false
end

include Scope

module Expr : sig
  type (+'a, 'nullability) any_expr constraint 'nullability = [< nullable ]
  type +'a expr = ('a, non_nullable) any_expr
  type +'a nullable_expr = ('a, nullable) any_expr

  val bool : bool -> bool expr
  val int : int -> int expr
  val ( + ) : (int, 'a) any_expr -> (int, 'a) any_expr -> (int, 'a) any_expr
  val if_null : default:'a expr -> 'a nullable_expr -> 'a expr

  val traverse :
    ('f -> ('a, 'n) any_expr) ->
    ('f, non_nullable) any_scope ->
    ('a, 'n) any_expr

  val traverse_opt :
    ('f -> ('a, 'n) any_expr) ->
    ('f, nullable) any_scope ->
    ('a, nullable) any_expr

  val count :
    ('f -> 'a -> (int, non_nullable) any_expr) ->
    ('f, 'a, 'n) any_aggregate_scope ->
    (int, 'n) any_expr
end = struct
  type (+'a, 'nullability) any_expr = 'nullability
    constraint 'nullability = [< nullable ]

  type +'a expr = ('a, non_nullable) any_expr
  type +'a nullable_expr = ('a, nullable) any_expr

  let ( + ) = assert false
  let if_null ~default:_ _ = assert false
  let bool _ = assert false
  let int _ = assert false
  let traverse _ _ = assert false
  let traverse_opt _ _ = assert false
  let count _ _ = assert false
end

module Fields = struct
  type t = [] : t | ( :: ) : _ Expr.expr * t -> t
end

type fields = Fields.t

type query
(** query *)

open Expr

module Database : sig
  module Backlinks : sig
    type t =
      < link_dst_root_hash : int expr
      ; link_dst_unparsed : string expr
      ; link_src_root_hash : int expr
      ; link_src_unparsed : string expr >

    val link_dst_root_hash :
      < link_dst_root_hash : int expr ; .. > scope -> int expr

    val link_dst_unparsed :
      < link_dst_unparsed : string expr ; .. > scope -> string expr
  end

  module Page_info : sig
    type t =
      < meta_title : string expr
      ; src_root_hash : int expr
      ; src_unparsed : string expr >

    val src_root_hash : < src_root_hash : int expr ; .. > scope -> int expr
    val src_unparsed : < src_unparsed : string expr ; .. > scope -> string expr
  end
end = struct
  let backlinks = assert false
  let page_info = assert false

  module Backlinks = struct
    type t =
      < link_dst_root_hash : int expr
      ; link_dst_unparsed : string expr
      ; link_src_root_hash : int expr
      ; link_src_unparsed : string expr >

    let link_dst_root_hash = assert false
    let link_dst_unparsed = assert false
  end

  module Page_info = struct
    type t =
      < meta_title : string expr
      ; src_root_hash : int expr
      ; src_unparsed : string expr >

    let src_root_hash = assert false
    let src_unparsed = assert false
  end
end

module Internal_backlinks_query : sig
  (*

  SELECT ~@fields
  FROM (
    SELECT ~, link_dst_root_hash, link_dst_unparsed
    FROM links_local AS backlinks FINAl
    PREWHERE @backlinks_prewhere
  ) AS backlinks
  LEFT JOIN (
    SELECT ~, src_root_hash AS link_dst_root_hash, src_unparsed AS link_dst_unparsed
    FROM page_info_local AS page_info FINAL
    PREWHERE @page_info_prewhere
  ) AS page_info
  USING link_dst_root_hash, link_dst_unparsed
  JOIN (
    SELECT ~, link_dst_root_hash, link_dst_unparsed
    FROM backlinks
    PREWHERE @backlinks_prewhere
    GROUP BY link_dst_root_hash, link_src_unparsed
  ) AS backlinks_stats
  USING link_dst_root_hash, link_dst_unparsed
  WHERE @filter

  *)

  module S : sig
    module Backlinks : sig
      type fields = < backlinks : Database.Backlinks.t scope >
      type t = fields scope
    end

    module Page_info : sig
      type fields = < page_info : Database.Page_info.t scope >
      type t = fields scope
    end

    module Backlinks_stats : sig
      type fields = < backlinks : Database.Backlinks.t scope >

      type group_fields =
        < link_dst_root_hash : int expr ; link_dst_unparsed : string expr >

      type t = fields scope
    end

    type fields =
      < backlinks : Backlinks.fields scope
      ; page_info : Page_info.fields nullable_scope
      ; backlinks_stats :
          (Backlinks_stats.fields, Backlinks_stats.group_fields) aggregate_scope >

    type t = fields scope
  end

  val query :
    fields:(S.t -> fields) ->
    filter:(S.t -> bool expr) ->
    page_info_prewhere:(S.Page_info.t -> bool expr) ->
    backlinks_prewhere:(S.Backlinks.t -> bool expr) ->
    unit ->
    query
end = struct
  module S = struct
    module Backlinks = struct
      type fields = < backlinks : Database.Backlinks.t scope >
      type t = fields scope
    end

    module Page_info = struct
      type fields = < page_info : Database.Page_info.t scope >
      type t = fields scope
    end

    module Backlinks_stats = struct
      type fields = < backlinks : Database.Backlinks.t scope >

      type group_fields =
        < link_dst_root_hash : int expr ; link_dst_unparsed : string expr >

      type t = fields scope
    end

    type fields =
      < backlinks : Backlinks.fields scope
      ; page_info : Page_info.fields nullable_scope
      ; backlinks_stats :
          (Backlinks_stats.fields, Backlinks_stats.group_fields) aggregate_scope >

    type t = fields scope
  end

  let with_backlinks = assert false
  let query = assert false
end

open Fields
open Database

let hash_sum s =
  let link_dst_root_hash : int expr =
    (* ppx: [%expr s#.backlinks#.link_dst_root_hash] *)
    traverse (fun s -> traverse (fun s -> s#link_dst_root_hash) s#backlinks) s
  in
  let src_root_hash : int nullable_expr =
    (* ppx: [%expr s#.page_info#..src_root_hash] *)
    traverse (fun s -> traverse_opt (fun s -> s#src_root_hash) s#page_info) s
  in
  if_null ~default:(int 1) src_root_hash + link_dst_root_hash

let q =
  Internal_backlinks_query.query
    ~fields:(fun s ->
      [
        (* ppx: [%expr s#.backlinks#.backlinks#.link_dst_root_hash] *)
        traverse
          (fun s ->
            traverse
              (fun s -> traverse (fun s -> s#link_dst_root_hash) s#backlinks)
              s#backlinks)
          s;
        hash_sum
          (*
            ppx:

            [%scope {
              backlinks = s#.backlinks#.backlinks;
              page_info = s#.page_info#.?page_info;
            }]
          *)
          (scope
             (object
                (* ppx: [%scope s#.backlinks#.backlinks] *)
                method backlinks =
                  nested (fun s -> nested (fun s -> s#backlinks) s#backlinks) s

                (* ppx: [%scope s#.page_info#.?page_info] *)
                method page_info =
                  nested
                    (fun s -> nested_opt (fun s -> s#page_info) s#page_info)
                    s
             end));
        (* ppx: [%expr s#.backlinks_stats#<count(int 1)] *)
        traverse (fun s -> count (fun _ _ -> int 1) s#backlinks_stats) s;
      ])
    ~filter:(fun _ -> bool true)
    ~page_info_prewhere:(fun _ -> bool true)
    ~backlinks_prewhere:(fun _ -> bool true)
    ()