module Internal = struct

  let (|>) f x =  x f
  module String = struct

    include StringLabels

    let get_exn = get
    let get s ~index = try Some (get_exn s index) with _ -> None
    let sub_exn = sub
    let find_index s ~char = try Some (rindex s char) with _ -> None 
  end
  module List = ListLabels

end
open Internal
open Printf

module Metadoc = struct

  include SmartPrint

  let (%) = (^-^)
  let s str = 
    let has_leading_space = String.get str ~index:0 = Some ' ' in
    let has_ending_space = String.(get str ~index:(length str - 1)) = Some ' ' in
    (if has_leading_space then space else empty) 
    % words str 
    % (if has_ending_space then space  else empty)

  let sp = space
  let sf fmt = ksprintf s fmt
  let i i = OCaml.int i
  let f f = OCaml.float f
  let n = newline
  let verbatim s = string s
  let exn e = s (Printexc.to_string e)
  let option ~f = function
  | Some o -> f o
  | None -> empty

  let escape c = ksprintf string "\027[%sm" c 
  let color c t = escape c % t % escape "0"
  let bold_red t =  color "1;31" t
  let bold_yellow t =  color "1;33" t
  let bold_green t =  color "1;32" t
  let greyish t = color "37" t

  let to_string ~line_width ~indent t =
    SmartPrint.to_string line_width indent t

  let to_list ~line_width ~indent t =
    let res = ref [] in
    let add c = res := c :: !res in
    SmartPrint.to_something line_width indent
      (fun c -> `Char c |> add)
      (fun s -> `String s |> add)
      (fun s ofs len -> `Sub_string (s, ofs, len) |> add)
      t;
    List.rev !res

end

(* Experimental Markdown printer. *)
module Markdown = struct
  
  include Metadoc
  let to_markdown_string ?(line_width=72) sm =
    to_string ~line_width ~indent:4 sm 

  let new_par = n % n

  let h underliner t = 
    let title = to_markdown_string t in
    let l = String.length title in
    let underline = String.make l underliner in
    verbatim title % n % verbatim underline % new_par

  let h1 t = h '=' t
  let h2 t = h '-' t
  let par t = t % new_par
  let emph t = s "*" % t % s "*"
  let ul_filter l =
    concat (List.filter l ~f:(fun t -> t <> empty) 
            |> List.map ~f:(fun t -> s "- " % t % n))
    % n
  let ul_inner l =
    indent (separate n (List.map l ~f:(fun t -> s "- " % t)))
  let url u = s "<" % verbatim u % s ">"
  let link t ~url = brakets t % parens (s url)


end


module type LOGGER_CONFIGURATION = sig
  

(** The input type for Make_logger. *)



  type ('a, 'b) result
  

(** The potential result of print_string *)



  val debug_level: unit -> int
  val with_color: unit -> bool
  val line_width: int
  val indent: int
  val print_string: string -> (unit, 'b) result
  val do_nothing: unit -> (unit, 'b) result
  val name: string

end

module type LOGGER = sig
  

(** The output type of Make_logger, most functions come from SmartPrint. *)



  type t = SmartPrint.t
  type ('a, 'b) result
  val empty : t
  val string : string -> t
  val sub_string : string -> int -> int -> t
  val ( !^ ) : string -> t
  val space : t
  val newline : t
  val append : t -> t -> t
  val ( ^-^ ) : t -> t -> t
  val concat_with_space : t -> t -> t
  val ( ^^ ) : t -> t -> t
  val words : string -> t
  val lines : string -> t
  val indent : t -> t
  val nest : t -> t
  val nest_all : t -> t
  val group : t -> t
  val group_all : t -> t
  val parens : t -> t
  val braces : t -> t
  val brakets : t -> t
  val angle_brakets : t -> t
  val single_quotes : t -> t
  val double_quotes : t -> t
  val concat : t list -> t
  val separate : t -> t list -> t
  module OCaml :
  sig
    val unit : unit -> t
    val bool : bool -> t
    val int : int -> t
    val float : float -> t
    val string : string -> t
    val option : ('a -> t) -> 'a option -> t
    val list : ('a -> t) -> 'a list -> t
    val tuple : t list -> t
  end

  val to_something :
    int ->
    int ->
    (char -> unit) ->
    (string -> unit) -> (string -> int -> int -> unit) -> t -> unit
  val to_buffer : int -> int -> Buffer.t -> t -> unit
  val to_out_channel : int -> int -> out_channel -> t -> unit
  val to_stdout : int -> int -> t -> unit

  val ( % ) : t -> t -> t
  

(** Basic concatenation. *)



  val s : string -> t
  

(** Add a string, that may ve wrapped at each whitespace, s " bla " preserves spacing at the beginning or the end. *)



  val sp : t
  

(** A space. *)



  val sf : ('a, unit, string, t) format4 -> 'a
  

(** The equivalent of sprintf; e.g. sf "%f %d" 4.2 42. *)



  val i : int -> t
  val f : float -> t
  val n : t
  

(** Forced new line. *)



  val verbatim : string -> t

  val exn : exn -> t

  val option : f:('a -> t) -> 'a option -> t

  val escape : string -> t
  val color : string -> t -> t
  

(** ANSI colored string. *)



  val bold_red : t -> t
  val bold_yellow : t -> t
  val bold_green : t -> t
  val greyish : t -> t

  val to_string : line_width:int -> indent:int -> SmartPrint.t -> string

  val to_list :
    line_width:int ->
    indent:int ->
    SmartPrint.t ->
    [> `Char of char
    | `String of string
    | `Sub_string of string * int * int ] list

  val print :
    [< `Debug of int | `Error | `Normal | `Warning ] -> t ->
    (unit, 'a) result
  

(** Print a log message. *)



  val ( @ ) :
    t ->
    [< `Debug of int | `Error | `Normal | `Warning ] ->
    (unit, 'a) result
  

(** Operator alias for print. *)



  val normal : [> `Normal ]
  val error : [> `Error ]
  val warning : [> `Warning ]
  val verbose : [> `Debug of int ]
  val very_verbose : [> `Debug of int ]
end

module Make_logger (P : LOGGER_CONFIGURATION) : 
  LOGGER with type ('a, 'b) result = ('a, 'b) P.result = struct

  include Metadoc
  type ('a, 'b) result = ('a, 'b) P.result
  
  let print log_kind t =
    let convert_to_string formatted =
      SmartPrint.to_string P.line_width P.indent formatted in
    let display formatted = convert_to_string formatted |> P.print_string in
    let using_colors = P.with_color () in
    let no_color t = t in
    let normal_color = if using_colors then bold_green else no_color in
    let error_color = if using_colors then bold_red else no_color in
    let warning_color = if using_colors then bold_yellow else no_color in
    let debug_color = if using_colors then greyish else no_color in
    let format_log ?(color_h=no_color) ?(color_t=no_color) head t =
      let colorless = head % t in
      let has_newline =
        String.find_index (convert_to_string colorless) ~char:'\n' <> None in
      display (
        color_h (brakets head)
        % string " " 
        % (if has_newline
          then color_t (n % indent t)
          else color_t t)
        % newline
      ) in
    match log_kind with
    | `Normal -> 
      format_log ~color_h:normal_color (string P.name) t
    | `Error -> 
      format_log ~color_h:error_color (s P.name % s ": ERROR") t
    | `Warning -> 
      format_log ~color_h:warning_color (s P.name % s ": Warning") t
    | `Debug level when P.debug_level () >= level ->
      format_log  ~color_h:debug_color (s P.name %s  ": debug")
        ~color_t:debug_color t
    | `Debug _ -> P.do_nothing ()

  let (@) t kind = print kind t
  let normal = `Normal 
  let error = `Error 
  let warning = `Warning
  let verbose = `Debug 1
  let very_verbose = `Debug 2
end