(.module:
  {#.doc "Pure-Lux exception-handling functionality."}
  [library
   [lux #*
    ["." macro]
    ["." meta]
    [abstract
     [monad (#+ do)]]
    [control
     ["." maybe]
     ["<>" parser ("#\." monad)
      ["<.>" code (#+ Parser)]]]
    [data
     ["." product]
     ["." text ("#\." monoid)]
     [collection
      ["." list ("#\." functor fold)]]]
    [macro
     ["." code]
     [syntax (#+ syntax:)
      ["|.|" input]
      ["." type #_
       ["|#_.|" variable]]]]
    [math
     [number
      ["n" nat ("#\." decimal)]]]]]
  [//
   ["//" try (#+ Try)]])

(type: .public (Exception a)
  {#.doc "An exception provides a way to decorate error messages."}
  {#label Text
   #constructor (-> a Text)})

(def: .public (match? exception error)
  {#.doc (example "Is this exception the cause of the error message?")}
  (All [e] (-> (Exception e) Text Bit))
  (text.starts_with? (get@ #label exception) error))

(def: .public (when exception then try)
  {#.doc (example "If a particular exception is detected on a possibly-erroneous value, handle it."
                  "If no exception was detected, or a different one from the one being checked, then pass along the original value.")}
  (All [e a]
    (-> (Exception e) (-> Text a) (Try a)
        (Try a)))
  (case try
    (#//.Success output)
    (#//.Success output)

    (#//.Failure error)
    (let [reference (get@ #label exception)]
      (if (text.starts_with? reference error)
        (#//.Success (|> error
                         (text.clip' (text.size reference))
                         maybe.assume
                         then))
        (#//.Failure error)))))

(def: .public (otherwise else try)
  {#.doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."}
  (All [a]
    (-> (-> Text a) (Try a) a))
  (case try
    (#//.Success output)
    output

    (#//.Failure error)
    (else error)))

(def: .public (error exception message)
  {#.doc "Constructs an error message from an exception."}
  (All [e] (-> (Exception e) e Text))
  ((get@ #..constructor exception) message))

(def: .public (except exception message)
  {#.doc "Decorate an error message with an Exception and lift it into the error-handling context."}
  (All [e a] (-> (Exception e) e (Try a)))
  (#//.Failure (..error exception message)))

(def: .public (assertion exception message test)
  (All [e] (-> (Exception e) e Bit (Try Any)))
  (if test
    (#//.Success [])
    (..except exception message)))

(def: exception
  (Parser [Code (List |type_variable|.Variable) [Text (List |input|.Input)] (Maybe Code)])
  (let [private (: (Parser [(List |type_variable|.Variable) [Text (List |input|.Input)] (Maybe Code)])
                   ($_ <>.and
                       (<>.else (list) (<code>.tuple (<>.some |type_variable|.parser)))
                       (<>.either (<code>.form (<>.and <code>.local_identifier (<>.some |input|.parser)))
                                  (<>.and <code>.local_identifier (<>\in (list))))
                       (<>.maybe <code>.any)
                       ))]
    ($_ <>.either
        (<>.and <code>.any private)
        (<>.and (<>\in (` .private)) private)
        )))

(syntax: .public (exception: [[export_policy t_vars [name inputs] body] ..exception])
  {#.doc (example "Define a new exception type."
                  "It mostly just serves as a way to tag error messages for later catching."
                  ""
                  "Simple case:"
                  (exception: .public some_exception)
                  ""
                  "Complex case:"
                  (exception: .public [arbitrary type variables] (some_exception {optional Text} {arguments Int})
                    optional_body))}
  (macro.with_identifiers [g!descriptor]
    (do meta.monad
      [current_module meta.current_module_name
       .let [descriptor ($_ text\compose "{" current_module "." name "}" text.new_line)
             g!self (code.local_identifier name)]]
      (in (list (` (def: (~ export_policy)
                     (~ g!self)
                     (All [(~+ (list\map |type_variable|.format t_vars))]
                       (..Exception [(~+ (list\map (get@ #|input|.type) inputs))]))
                     (let [(~ g!descriptor) (~ (code.text descriptor))]
                       {#..label (~ g!descriptor)
                        #..constructor (function ((~ g!self) [(~+ (list\map (get@ #|input|.binding) inputs))])
                                         ((~! text\compose) (~ g!descriptor)
                                          (~ (maybe.else (' "") body))))}))))))))

(def: (report' entries)
  (-> (List [Text Text]) Text)
  (let [header_separator ": "
        largest_header_size (list\fold (function (_ [header _] max)
                                         (n.max (text.size header) max))
                                       0
                                       entries)
        on_new_line (|> " "
                        (list.repeated (n.+ (text.size header_separator)
                                            largest_header_size))
                        (text.join_with "")
                        (text\compose text.new_line))
        on_entry (: (-> [Text Text] Text)
                    (function (_ [header message])
                      (let [padding (|> " "
                                        (list.repeated (n.- (text.size header)
                                                            largest_header_size))
                                        (text.join_with ""))]
                        (|> message
                            (text.replaced text.new_line on_new_line)
                            ($_ text\compose padding header header_separator)))))]
    (case entries
      #.End
      ""

      (#.Item head tail)
      (list\fold (function (_ post pre)
                   ($_ text\compose pre text.new_line (on_entry post)))
                 (on_entry head)
                 tail))))

(syntax: .public (report [entries (<>.many (<code>.tuple (<>.and <code>.any <code>.any)))])
  {#.doc (example "An error report."
                  (: Text
                     (report ["Row 0" value/0]
                             ["Row 1" value/1]
                             ,,,
                             ["Row N" value/N])))}
  (in (list (` ((~! report') (list (~+ (|> entries
                                           (list\map (function (_ [header message])
                                                       (` [(~ header) (~ message)])))))))))))

(def: .public (listing format entries)
  {#.doc (example "A numbered report of the entries on a list."
                  "NOTE: 0-based numbering.")}
  (All [a]
    (-> (-> a Text) (List a) Text))
  (|> entries
      (list\fold (function (_ entry [index next])
                   [(inc index)
                    (#.Item [(n\encode index) (format entry)]
                            next)])
                 [0 #.End])
      product.right
      list.reversed
      ..report'))

(def: separator
  (let [gap ($_ "lux text concat" text.new_line text.new_line)
        horizontal_line (|> "-" (list.repeated 64) (text.join_with ""))]
    ($_ "lux text concat"
        gap
        horizontal_line
        gap)))

(def: (decorated prelude error)
  (-> Text Text Text)
  ($_ "lux text concat"
      prelude
      ..separator
      error))

(def: .public (with exception message computation)
  {#.doc (example "If a computation fails, prepends the exception to the error.")}
  (All [e a] (-> (Exception e) e (Try a) (Try a)))
  (case computation
    (#//.Failure error)
    (#//.Failure (case error
                   ""
                   (..error exception message)

                   _
                   (..decorated (..error exception message) error)))

    success
    success))