(.using
 [library
  [lux "*"
   ["[0]" macro]
   ["[0]" meta]
   [abstract
    [monad {"+" do}]]
   [control
    ["[0]" maybe]
    ["<>" parser ("[1]#[0]" monad)
     ["<[0]>" code {"+" Parser}]]]
   [data
    ["[0]" product]
    ["[0]" text ("[1]#[0]" monoid)]
    [collection
     ["[0]" list ("[1]#[0]" functor mix)]]]
   [macro
    ["[0]" code]
    [syntax {"+" syntax:}
     ["|[0]|" input]
     ["[0]" type "_"
      ["|[1]_[0]|" variable]]]]
   [math
    [number
     ["n" nat ("[1]#[0]" decimal)]]]]]
 [//
  ["//" try {"+" Try}]])

(type: .public (Exception a)
  (Record
   [#label Text
    #constructor (-> a Text)]))

(def: .public (match? exception error)
  (All (_ e) (-> (Exception e) Text Bit))
  (text.starts_with? (the #label exception) error))

(def: .public (when exception then try)
  (All (_ e a)
    (-> (Exception e) (-> Text a) (Try a)
        (Try a)))
  (case try
    {//.#Success output}
    {//.#Success output}

    {//.#Failure error}
    (let [reference (the #label exception)]
      (if (text.starts_with? reference error)
        {//.#Success (|> error
                         (text.clip_since (text.size reference))
                         maybe.trusted
                         then)}
        {//.#Failure error}))))

(def: .public (otherwise else try)
  (All (_ a)
    (-> (-> Text a) (Try a) a))
  (case try
    {//.#Success output}
    output

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

(def: .public (error exception message)
  (All (_ e) (-> (Exception e) e Text))
  ((the ..#constructor exception) message))

(def: .public (except exception message)
  (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 (is (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 |input|.parser))
                                   (<>.and <code>.local (<>#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])
  (macro.with_symbols [g!_ g!descriptor]
    (do meta.monad
      [current_module meta.current_module_name
       .let [descriptor ($_ text#composite "{" current_module "." name "}" text.new_line)
             g!self (code.local name)]]
      (in (list (` (def: (~ export_policy)
                     (~ g!self)
                     (All ((~ g!_) (~+ (list#each |type_variable|.format t_vars)))
                       (..Exception [(~+ (list#each (the |input|.#type) inputs))]))
                     (let [(~ g!descriptor) (~ (code.text descriptor))]
                       [..#label (~ g!descriptor)
                        ..#constructor (function ((~ g!self) [(~+ (list#each (the |input|.#binding) inputs))])
                                         ((~! text#composite) (~ g!descriptor)
                                          (~ (maybe.else (' "") body))))]))))))))

(def: (report' entries)
  (-> (List [Text Text]) Text)
  (let [header_separator ": "
        largest_header_size (list#mix (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.together
                        (text#composite text.new_line))
        on_entry (is (-> [Text Text] Text)
                     (function (_ [header message])
                       (let [padding (|> " "
                                         (list.repeated (n.- (text.size header)
                                                             largest_header_size))
                                         text.together)]
                         (|> message
                             (text.replaced text.new_line on_new_line)
                             ($_ text#composite padding header header_separator)))))]
    (case entries
      {.#End}
      ""

      {.#Item head tail}
      (list#mix (function (_ post pre)
                  ($_ text#composite pre text.new_line (on_entry post)))
                (on_entry head)
                tail))))

(syntax: .public (report [entries (<>.many (<>.and <code>.any <code>.any))])
  (in (list (` ((~! ..report') (list (~+ (|> entries
                                             (list#each (function (_ [header message])
                                                          (` [(~ header) (~ message)])))))))))))

(def: .public (listing format entries)
  (All (_ a)
    (-> (-> a Text) (List a) Text))
  (|> entries
      (list#mix (function (_ entry [index next])
                  [(++ index)
                   {.#Item [(n#encoded 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.together)]
    ($_ "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)
  (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))