main.ml

type non_nullable
type nullable
type non_agg
type +'a agg constraint 'a = < .. >

module Scope : sig
  type (+'a, 'nullability, +'agg) any_scope constraint 'a = < .. >
  type +'a scope = ('a, non_nullable, non_agg) any_scope
  type +'a nullable_scope = ('a, nullable, non_agg) any_scope
  type (+'a, +'agg) aggregate_scope = ('a, non_nullable, 'agg agg) any_scope

  type (+'a, +'agg) nullable_aggregate_scope =
    ('a, nullable, 'agg agg) any_scope

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

  val traverse_nullable :
    ('v -> ('w, 'n, 'a) any_scope) ->
    'v nullable_scope ->
    ('w, nullable, 'a) any_scope

  val scope : 'a -> 'a scope
end = struct
  type (+'a, 'nullability, +'agg) any_scope constraint 'a = < .. >
  type +'a scope = ('a, non_nullable, non_agg) any_scope
  type +'a nullable_scope = ('a, nullable, non_agg) any_scope
  type (+'a, +'agg) aggregate_scope = ('a, non_nullable, 'agg agg) any_scope

  type (+'a, +'agg) nullable_aggregate_scope =
    ('a, nullable, 'agg agg) any_scope

  let traverse _ _ = assert false
  let traverse_nullable _ _ = assert false
  let scope _ = assert false
end

module Expr : sig
  include module type of Scope

  type (+'a, 'nullability) any_expr
  (** Expression with nullability info *)

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

  val expr_with :
    ('f -> ('a, 'n) any_expr) ->
    ('f, non_nullable, _) any_scope ->
    ('a, 'n) any_expr
  (** [expr_with f scope] computes a new expression in [scope] *)

  val expr_with_nullable :
    ('f -> ('a, _) any_expr) -> ('f, nullable, _) any_scope -> 'a nullable_expr
  (** [expr_with f scope] computes a new nullable expression in nullable [scope] *)

  val expr_with_aggregate :
    ('f -> ('a, 'n) any_expr) -> (_, 'f) aggregate_scope -> ('a, 'n) any_expr

  val expr_with_nullable_aggregate :
    ('f -> ('a, _) any_expr) ->
    (_, 'f) nullable_aggregate_scope ->
    'a nullable_expr

  val count :
    ('f -> 'a -> (int, non_nullable) any_expr) ->
    ('f, 'n, 'a agg) any_scope ->
    (int, 'n) any_expr
  (** [count f scope] aggregates count defined by [f] in aggregated [scope] *)

  val bool : bool -> bool expr
  (** [bool v] is an expression which computes to [v] *)

  val int : int -> int expr
  (** [int v] is an expression which computes to [v] *)

  val ( + ) : (int, 'a) any_expr -> (int, 'a) any_expr -> (int, 'a) any_expr
  (** [x + y] computes sum of two integers [x] and [y] *)

  val if_null : default:'a expr -> 'a nullable_expr -> 'a expr
  (** [if_null e ~default] either computes to [e] if it's not null, or [default]
      otherwise. *)
end = struct
  include Scope

  type (+'a, 'nullability) any_expr = 'nullability
  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 expr_with _ _ = assert false
  let expr_with_nullable _ _ = assert false
  let expr_with_aggregate _ _ = assert false
  let expr_with_nullable_aggregate _ _ = assert false
  let count _ _ = assert false
end

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

type fields = Fields.t
(** A list of fields. *)

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 >
  end

  module Page_info : sig
    type t =
      < meta_title : string expr
      ; src_root_hash : int expr
      ; src_unparsed : string expr >
  end
end = struct
  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 >
  end

  module Page_info = struct
    type t =
      < meta_title : string expr
      ; src_root_hash : int expr
      ; src_unparsed : string expr >
  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 =
        < link_dst_root_hash : int expr ; link_dst_unparsed : string expr >

      type agg_fields = < backlinks : Database.Backlinks.t scope >
      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.agg_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 =
        < link_dst_root_hash : int expr ; link_dst_unparsed : string expr >

      type agg_fields = < backlinks : Database.Backlinks.t scope >
      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.agg_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 = s #- backlinks #-> link_dst_root_hash in
  let src_root_hash = s #- page_info #?> src_root_hash in
  if_null ~default:(int 0) src_root_hash + link_dst_root_hash

let q =
  Internal_backlinks_query.query
    ~fields:(fun s ->
      [
        s #- backlinks #- backlinks #-> link_dst_root_hash;
        s #- backlinks_stats #-> link_dst_root_hash;
        s #- backlinks_stats |> count (fun _ _ -> int 1);
        hash_sum
          (scope
             (object
                method backlinks = s #- backlinks #- backlinks
                method page_info = s #- page_info #? page_info
             end));
      ])
    ~filter:(fun _ -> bool true)
    ~page_info_prewhere:(fun _ -> bool true)
    ~backlinks_prewhere:(fun _ -> bool true)
    ()