(.module:
  [lux (#- Name)
   [control
    [monad (#+ do)]
    ["ex" exception (#+ exception:)]]
   [data
    ["." error (#+ Error)]
    ["." text ("#/." order)
     format]
    [collection
     ["." list ("#/." functor)]
     ["." dictionary (#+ Dictionary)]]]
   ["." function]]
  ["." //])

(type: #export Name Text)

(type: #export (Extension i)
  [Name (List i)])

(with-expansions [<Bundle> (as-is (Dictionary Name (Handler s i o)))]
  (type: #export (Handler s i o)
    (-> Name
        (//.Phase [<Bundle> s] i o)
        (//.Phase [<Bundle> s] (List i) o)))

  (type: #export (Bundle s i o)
    <Bundle>))

(type: #export (State s i o)
  {#bundle (Bundle s i o)
   #state s})

(type: #export (Operation s i o v)
  (//.Operation (State s i o) v))

(type: #export (Phase s i o)
  (//.Phase (State s i o) i o))

(do-template [<name>]
  [(exception: #export (<name> {name Name})
     (ex.report ["Extension" (%t name)]))]

  [cannot-overwrite]
  [invalid-syntax]
  )

(exception: #export [s i o] (unknown {name Name} {bundle (Bundle s i o)})
  (ex.report ["Extension" (%t name)]
             ["Available" (|> bundle
                              dictionary.keys
                              (list.sort text/<)
                              (list/map (|>> %t (format text.new-line text.tab)))
                              (text.join-with ""))]))

(exception: #export (incorrect-arity {name Name} {arity Nat} {args Nat})
  (ex.report ["Extension" (%t name)]
             ["Expected" (%n arity)]
             ["Actual" (%n args)]))

(exception: #export (incorrect-syntax {name Name})
  (ex.report ["Extension" (%t name)]))

(def: #export (install name handler)
  (All [s i o]
    (-> Text (Handler s i o) (Operation s i o Any)))
  (function (_ [bundle state])
    (case (dictionary.get name bundle)
      #.None
      (#error.Success [[(dictionary.put name handler bundle) state]
                       []])

      _
      (ex.throw cannot-overwrite name))))

(def: #export (apply phase [name parameters])
  (All [s i o]
    (-> (Phase s i o) (Extension i) (Operation s i o o)))
  (function (_ (^@ stateE [bundle state]))
    (case (dictionary.get name bundle)
      (#.Some handler)
      (((handler name phase) parameters)
       stateE)

      #.None
      (ex.throw unknown [name bundle]))))

(def: #export (localized get set transform)
  (All [s s' i o v]
    (-> (-> s s') (-> s' s s) (-> s' s')
        (-> (Operation s i o v) (Operation s i o v))))
  (function (_ operation)
    (function (_ [bundle state])
      (let [old (get state)]
        (case (operation [bundle (set (transform old) state)])
          (#error.Success [[bundle' state'] output])
          (#error.Success [[bundle' (set old state')] output])

          (#error.Failure error)
          (#error.Failure error))))))

(def: #export (temporary transform)
  (All [s i o v]
    (-> (-> s s)
        (-> (Operation s i o v) (Operation s i o v))))
  (function (_ operation)
    (function (_ [bundle state])
      (case (operation [bundle (transform state)])
        (#error.Success [[bundle' state'] output])
        (#error.Success [[bundle' state] output])

        (#error.Failure error)
        (#error.Failure error)))))

(def: #export (with-state state)
  (All [s i o v]
    (-> s (-> (Operation s i o v) (Operation s i o v))))
  (..temporary (function.constant state)))

(def: #export (read get)
  (All [s i o v]
    (-> (-> s v) (Operation s i o v)))
  (function (_ [bundle state])
    (#error.Success [[bundle state] (get state)])))

(def: #export (update transform)
  (All [s i o]
    (-> (-> s s) (Operation s i o Any)))
  (function (_ [bundle state])
    (#error.Success [[bundle (transform state)] []])))

(def: #export (lift action)
  (All [s i o v]
    (-> (//.Operation s v)
        (//.Operation [(Bundle s i o) s] v)))
  (function (_ [bundle state])
    (case (action state)
      (#error.Success [state' output])
      (#error.Success [[bundle state'] output])

      (#error.Failure error)
      (#error.Failure error))))