<commit_before>(*
 * Copyright (c) 2014 <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open DocOckPaths
open DocOckTypes

type 'a partial_expansion =
  | Signature of 'a Signature.t
  | Functor of 'a FunctorArgument.t option *
               'a Identifier.signature * int *
               'a ModuleType.expr

let subst_signature sub = function
  | None -> None
  | Some sg -> Some (DocOckSubst.signature sub sg)

let subst_arg sub arg =
  match arg with
  | None -> None
  | Some {FunctorArgument. id; expr; expansion} ->
      let id' = DocOckSubst.identifier_module sub id in
      let expr' = DocOckSubst.module_type_expr sub expr in
      let expansion' =
        DocOckMaps.option_map (DocOckSubst.module_expansion sub) expansion
      in
        Some {FunctorArgument. id = id'; expr = expr'; expansion = expansion'}

let subst_expansion sub = function
  | None -> None
  | Some (Signature sg) ->
      let sg' = DocOckSubst.signature sub sg in
        Some (Signature sg')
  | Some (Functor(arg, id, offset, expr)) ->
      let arg' = subst_arg sub arg in
      let id', offset' =
        DocOckSubst.offset_identifier_signature sub (id, offset)
      in
      let expr' = DocOckSubst.module_type_expr sub expr in
        Some (Functor(arg', id', offset', expr'))

let map_module name ex f =
  let rec loop name items f acc =
    let open Signature in
    let open Module in
      match items with
      | [] -> raise Not_found
      | Module md :: rest when Identifier.name md.id = name ->
        let md' = f md in
        List.rev_append acc ((Module md') :: rest)
      | item :: rest -> loop name rest f (item :: acc)
  in
    match ex with
    | None -> raise Not_found
    | Some (Signature items) -> Some (Signature (loop name items f []))
    | Some (Functor _) -> raise Not_found

let map_type name ex f =
  let rec loop name items f acc =
    let open Signature in
    let open TypeDecl in
      match items with
      | [] -> raise Not_found
      | Type decl :: rest when Identifier.name decl.id = name ->
        let decl' = f decl in
        List.rev_append acc ((Type decl') :: rest)
      | item :: rest -> loop name rest f (item :: acc)
  in
    match ex with
    | None -> raise Not_found
    | Some (Signature items) -> Some (Signature (loop name items f []))
    | Some (Functor _) -> raise Not_found

let add_module_with subst md =
  let open Module in
  let open ModuleType in
  let type_ =
    match md.type_ with
    | Alias _ as decl ->
        ModuleType(With(TypeOf decl, [subst]))
    | ModuleType(With(expr, substs)) ->
        ModuleType(With(expr, substs @ [subst]))
    | ModuleType expr ->
        ModuleType(With(expr, [subst]))
  in
    { md with type_ }

let refine_type ex (frag : 'a Fragment.type_) equation =
  let open Fragment in
  match frag with
  | Dot _ -> None
  | Resolved frag ->
    let open Resolved in
    let name, rest = split frag in
      match rest with
      | None -> begin
          try
            map_type name ex
              (fun decl -> TypeDecl.{ decl with equation })
          with Not_found -> None (* TODO should be an error *)
        end
      | Some frag -> begin
          let subst = ModuleType.TypeEq(Resolved frag, equation) in
          try
            map_module name ex (add_module_with subst)
          with Not_found -> None (* TODO should be an error *)
        end

let refine_module ex (frag : 'a Fragment.module_) equation =
  let open Fragment in
  match frag with
  | Dot _ -> None
  | Resolved frag ->
    let open Resolved in
    let name, rest = split frag in
      match rest with
      | None -> begin
          try
            map_module name ex
              (fun md -> Module.{ md with type_ = equation})
              (* TODO Fix this to not produce an alias (needs strengthening)
                      or fix OCaml to do the correct thing. *)
          with Not_found -> None (* TODO should be an error *)
        end
      | Some frag -> begin
          let subst = ModuleType.ModuleEq(Resolved frag, equation) in
          try
            map_module name ex (add_module_with subst)
          with Not_found -> None (* TODO should be an error *)
        end

type 'a intermediate_module_expansion =
  'a Identifier.module_ * 'a Documentation.t * 'a partial_expansion option

type 'a intermediate_module_type_expansion =
  'a Identifier.module_type * 'a Documentation.t * 'a partial_expansion option

type 'a expander =
  { equal: 'a -> 'a -> bool;
    hash: 'a -> int;
    expand_root: root:'a -> 'a -> 'a intermediate_module_expansion;
    expand_forward_ref : root:'a -> string -> 'a intermediate_module_expansion;
    expand_module_identifier: root:'a -> 'a Identifier.module_ ->
                              'a intermediate_module_expansion;
    expand_module_type_identifier: root:'a -> 'a Identifier.module_type ->
                                   'a intermediate_module_type_expansion;
    expand_signature_identifier: root:'a -> 'a Identifier.signature ->
                                 'a partial_expansion option;
    expand_module_resolved_path: root:'a -> 'a Path.Resolved.module_ ->
                                 'a intermediate_module_expansion;
    expand_module_path: root:'a -> 'a Path.module_ ->
                                 'a intermediate_module_expansion;
    expand_module_type_resolved_path: root:'a ->
                                      'a Path.Resolved.module_type ->
                                      'a intermediate_module_type_expansion; }

let rec expand_module_decl ({equal} as t) root dest offset decl =
  let open Module in
    match decl with
    | Alias (Path.Resolved p) -> begin (* TODO Should have strengthening *)
        match t.expand_module_resolved_path ~root p with
        | src, _, ex ->
          let src = Identifier.signature_of_module src in
          let sub = DocOckSubst.rename_signature ~equal src dest offset in
          subst_expansion sub ex
        | exception Not_found -> None (* TODO: Should be an error *)
      end
    | Alias p -> begin
        match t.expand_module_path ~root p with
        | src, _, ex ->
          let src = Identifier.signature_of_module src in
          let sub = DocOckSubst.rename_signature ~equal src dest offset in
          subst_expansion sub ex
        | exception Not_found -> None (* TODO: Should be an error *)
      end
    | ModuleType expr -> expand_module_type_expr t root dest offset expr
<commit_msg>keep doc while expanding<commit_after>(*
 * Copyright (c) 2014 <NAME> <<EMAIL>>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open DocOckPaths
open DocOckTypes

type 'a partial_expansion =
  | Signature of 'a Signature.t
  | Functor of 'a FunctorArgument.t option *
               'a Identifier.signature * int *
               'a ModuleType.expr

let subst_signature sub = function
  | None -> None
  | Some sg -> Some (DocOckSubst.signature sub sg)

let subst_arg sub arg =
  match arg with
  | None -> None
  | Some {FunctorArgument. id; expr; expansion} ->
      let id' = DocOckSubst.identifier_module sub id in
      let expr' = DocOckSubst.module_type_expr sub expr in
      let expansion' =
        DocOckMaps.option_map (DocOckSubst.module_expansion sub) expansion
      in
        Some {FunctorArgument. id = id'; expr = expr'; expansion = expansion'}

let subst_expansion sub = function
  | None -> None
  | Some (Signature sg) ->
      let sg' = DocOckSubst.signature sub sg in
        Some (Signature sg')
  | Some (Functor(arg, id, offset, expr)) ->
      let arg' = subst_arg sub arg in
      let id', offset' =
        DocOckSubst.offset_identifier_signature sub (id, offset)
      in
      let expr' = DocOckSubst.module_type_expr sub expr in
        Some (Functor(arg', id', offset', expr'))

let map_module name ex f =
  let rec loop name items f acc =
    let open Signature in
    let open Module in
      match items with
      | [] -> raise Not_found
      | Module md :: rest when Identifier.name md.id = name ->
        let md' = f md in
        List.rev_append acc ((Module md') :: rest)
      | item :: rest -> loop name rest f (item :: acc)
  in
    match ex with
    | None -> raise Not_found
    | Some (Signature items) -> Some (Signature (loop name items f []))
    | Some (Functor _) -> raise Not_found

let map_type name ex f =
  let rec loop name items f acc =
    let open Signature in
    let open TypeDecl in
      match items with
      | [] -> raise Not_found
      | Type decl :: rest when Identifier.name decl.id = name ->
        let decl' = f decl in
        List.rev_append acc ((Type decl') :: rest)
      | item :: rest -> loop name rest f (item :: acc)
  in
    match ex with
    | None -> raise Not_found
    | Some (Signature items) -> Some (Signature (loop name items f []))
    | Some (Functor _) -> raise Not_found

let add_module_with subst md =
  let open Module in
  let open ModuleType in
  let type_ =
    match md.type_ with
    | Alias _ as decl ->
        ModuleType(With(TypeOf decl, [subst]))
    | ModuleType(With(expr, substs)) ->
        ModuleType(With(expr, substs @ [subst]))
    | ModuleType expr ->
        ModuleType(With(expr, [subst]))
  in
    { md with type_ }

let refine_type ex (frag : 'a Fragment.type_) equation =
  let open Fragment in
  match frag with
  | Dot _ -> None
  | Resolved frag ->
    let open Resolved in
    let name, rest = split frag in
      match rest with
      | None -> begin
          try
            map_type name ex
              (fun decl -> TypeDecl.{ decl with equation })
          with Not_found -> None (* TODO should be an error *)
        end
      | Some frag -> begin
          let subst = ModuleType.TypeEq(Resolved frag, equation) in
          try
            map_module name ex (add_module_with subst)
          with Not_found -> None (* TODO should be an error *)
        end

let refine_module ex (frag : 'a Fragment.module_) equation =
  let open Fragment in
  match frag with
  | Dot _ -> None
  | Resolved frag ->
    let open Resolved in
    let name, rest = split frag in
      match rest with
      | None -> begin
          try
            map_module name ex
              (fun md -> Module.{ md with type_ = equation})
              (* TODO Fix this to not produce an alias (needs strengthening)
                      or fix OCaml to do the correct thing. *)
          with Not_found -> None (* TODO should be an error *)
        end
      | Some frag -> begin
          let subst = ModuleType.ModuleEq(Resolved frag, equation) in
          try
            map_module name ex (add_module_with subst)
          with Not_found -> None (* TODO should be an error *)
        end

type 'a intermediate_module_expansion =
  'a Identifier.module_ * 'a Documentation.t * 'a partial_expansion option

type 'a intermediate_module_type_expansion =
  'a Identifier.module_type * 'a Documentation.t * 'a partial_expansion option

type 'a expander =
  { equal: 'a -> 'a -> bool;
    hash: 'a -> int;
    expand_root: root:'a -> 'a -> 'a intermediate_module_expansion;
    expand_forward_ref : root:'a -> string -> 'a intermediate_module_expansion;
    expand_module_identifier: root:'a -> 'a Identifier.module_ ->
                              'a intermediate_module_expansion;
    expand_module_type_identifier: root:'a -> 'a Identifier.module_type ->
                                   'a intermediate_module_type_expansion;
    expand_signature_identifier: root:'a -> 'a Identifier.signature ->
                                 'a partial_expansion option;
    expand_module_resolved_path: root:'a -> 'a Path.Resolved.module_ ->
                                 'a intermediate_module_expansion;
    expand_module_path: root:'a -> 'a Path.module_ ->
                                 'a intermediate_module_expansion;
    expand_module_type_resolved_path: root:'a ->
                                      'a Path.Resolved.module_type ->
                                      'a intermediate_module_type_expansion; }

let add_doc_to_expansion_opt doc :
  'a partial_expansion option -> 'a partial_expansion option = function
  | Some (Signature sg) ->
      let doc = Signature.Comment (Documentation.Documentation doc) in
      Some (Signature (doc :: sg))
  | otherwise -> otherwise (* FIXME: handle functors? *)

let rec expand_module_decl ({equal} as t) root dest offset decl =
  let open Module in
    match decl with
    | Alias (Path.Resolved p) -> begin (* TODO Should have strengthening *)
        match t.expand_module_resolved_path ~root p with
        | src, doc, ex ->
          let src = Identifier.signature_of_module src in
          let sub = DocOckSubst.rename_signature ~equal src dest offset in
          let ex  = add_doc_to_expansion_opt doc ex in
          subst_expansion sub ex
        | exception Not_found -> None (* TODO: Should be an error *)
      end
    | Alias p -> begin
        match t.expand_module_path ~root p with
        | src, doc, ex ->
          let src = Identifier.signature_of_module src in
          let sub = DocOckSubst.rename_signature ~equal src dest offset in
          let ex = add_doc_to_expansion_opt doc ex in
          subst_expansion sub ex
        | exception Not_found -> None (* TODO: Should be an error *)
      end
    | ModuleType expr -> expand_module_type_expr t root dest offset expr

{'fraction_non_alphanumeric': 0.08163126361655773, 'fraction_numerical': 0.0005446623093681918, 'mean_word_length': 2.303868645973909, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 136, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 18, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5174757', 'n_tokens_mistral': 4192, 'n_tokens_neox': 4115, 'n_words': 1571}