/**
 * Reporting error summaries to the user.
 */
module stratego/error-support/report
imports
  libstratego-xtc
  error-support

strategies

  /**
   * Reports an error summary to the stderr.
   *
   * The current term should be a FILE, stdin, or a string (preferred)
   *
   * @param Summary -> Summary
   * @type  a -> a
   */
  report-error-summary(|summary) =
    ?input
    ; where(
        !summary => summary(producer, _, errors)
      ; !errors
      ; map({error:
          ?error
        ; <report-specific-error(|producer, error) <+ report-error(|producer, error)> input
        })
      )
    <+ say(!"error: An error occured, but the error summary cannot be presented in a nice way. Please report this as a bug.")
       ; where(<debug(!"       Structured error summary: ")> summary)

  /**
   * @param error Error
   * @type  a -> a
   */
  report-error(|producer, error) =
    report-error(|error)

  report-error(|error) =
    where(!error => error(err, [localized(descr, location)]))
    ; report-location(|err, descr, location)

    <+ say(!"error: An error occured, but the error cannot be presented in a nice way. Please report this as a bug.")
       ; where(<debug(!"       Structured error: ")> error)
       ; fail

  /**
   * @param error Location
   * @type  a -> a
   */
  report-location(|err, descr, location) =
    where(!location => area-in-file(file, area))
    ; report-area(|err, descr, file, area)

  /**
   * @param location Location
   * @type  a -> a
   */
  report-location(|err, descr, location) =
    where(!location => file(file))
    ; report-file(|err, descr, file)

/**
 * Improved error reporting for specific cases
 */
strategies

  /**
   * If the err is a "Parse Table error", then the actual file that is
   * a problem, is the parse table. So, we lookup the parse table from
   * the -p config.
   *
   * @param error Error
   * @type  a -> a
  report-specific-error(|producer, error) =
    where(!error => error("Parse Table error", [localized(descr, _)]))
    ; where(
        log(|Error(),<concat-strings> [<get-config> "-p", ": Parse table error: ", descr])
      )
   */

  /**
   * If the err is an "Ambiguity" then we show the alternatives, 
   * which are encoded in the description (separated 
   * by a semicolon).  
   * 
   * @param error Error
   * @type  a -> a
   */
  report-specific-error(|producer, error) =
    where(
      !error => error("Ambiguity", <id>)
    ; map({ descr, file, area :
        ?localized(descr, area-in-file(file, area))
      ; report-area(|"", "Ambiguity found", file, area)
      ; log(|Error(),"Alternatives are: ")
      ; <string-tokenize>([';'],descr) 
      ; map(log(|Error(),<concat-strings>["   ",<id>]))
      ; log(|Error(),"")
      })
    )

/**
 * Tools that can be used for reporting errors.
 */
strategies

  report-file(|err, descr, file) =
    log(|Error(),<concat-strings>[file, ": '", err, "': ", descr])

  /**
   * Presents the 'area' in the file at stderr.
   */
  report-area(|err, descr, file, area) =
    where(
      !area => area(begin-line, begin-column, _, end-column, _, _)
    );

    let y-pos =
          <dec> begin-line
          ; if <lt> (<id>, 0) then !0 else id end

        x-pos =
          <dec> begin-column => c
          ; if <lt> (c, 0) then !0 else id end

        filename =
          if !file => "-" then
            !"stdin"
          else
            !file
          end

        print-location =
          where(
	    log(|Error(),
            <concat-strings> [
              <filename> (), ": ",  descr, " at line "
            , <int-to-string> begin-line, ", column "
            , <int-to-string> begin-column
            ])
          )

        print-context-in-file =
          get-lines
          ; add-indices
          ; where(y-pos => y)
          ; if !y => 0 then
              \ [line | _] -> [line] \
            else
              at-suffix(?[(y, _) | _]; ?context)
              ; !context
            end

          /**
           * If there are 2 or more elements, drop the rest.
           */
          ; if ?[s1, s2 | _ ] then
              ![s1, s2]
            end
          ; map(log(|Error(),<Snd>))

          /**
           * Indicate the position in the file
           */
          ; <conc-strings> (<copy-char> (<x-pos> (), ' '), "^")
	  ; log(|Error(),<id>)

          /**
           * @type ? -> String
           */
          read-input-file =
               ?FILE(<read-text-file>)
            <+ is-string

     in print-location
      ; if read-input-file => txt then
          <print-context-in-file> txt
        end
    end