(.module:
  [lux #*
   [control
    ["." state]
    ["ex" exception (#+ Exception exception:)]
    [monad (#+ do)]]
   [data
    ["." product]
    ["." error (#+ Error) ("error/." Functor<Error>)]
    ["." text
     format]]
   [time
    ["." instant]
    ["." duration]]
   ["." io]
   [macro
    ["s" syntax (#+ syntax:)]]])

(type: #export (Operation s o)
  (state.State' Error s o))

(def: #export Monad<Operation>
  (state.Monad<State'> error.Monad<Error>))

(type: #export (Phase s i o)
  (-> i (Operation s o)))

(def: #export (run' state operation)
  (All [s o]
    (-> s (Operation s o) (Error [s o])))
  (operation state))

(def: #export (run state operation)
  (All [s o]
    (-> s (Operation s o) (Error o)))
  (|> state
      operation
      (:: error.Monad<Error> map product.right)))

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

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

(def: #export (sub [get set] operation)
  (All [s s' o]
    (-> [(-> s s') (-> s' s s)]
        (Operation s' o)
        (Operation s o)))
  (function (_ state)
    (do error.Monad<Error>
      [[state' output] (operation (get state))]
      (wrap [(set state' state) output]))))

(def: #export fail
  (-> Text Operation)
  (|>> error.fail (state.lift error.Monad<Error>)))

(def: #export (throw exception parameters)
  (All [e] (-> (Exception e) e Operation))
  (state.lift error.Monad<Error>
              (ex.throw exception parameters)))

(def: #export (lift error)
  (All [s a] (-> (Error a) (Operation s a)))
  (function (_ state)
    (error/map (|>> [state]) error)))

(syntax: #export (assert exception message test)
  (wrap (list (` (if (~ test)
                   (:: ..Monad<Operation> (~' wrap) [])
                   (..throw (~ exception) (~ message)))))))

(def: #export (with-stack exception message action)
  (All [e s o] (-> (Exception e) e (Operation s o) (Operation s o)))
  (<<| (ex.with-stack exception message)
       action))

(def: #export identity
  (All [s a] (Phase s a a))
  (function (_ input state)
    (#error.Success [state input])))

(def: #export (compose pre post)
  (All [s0 s1 i t o]
    (-> (Phase s0 i t)
        (Phase s1 t o)
        (Phase [s0 s1] i o)))
  (function (_ input [pre/state post/state])
    (do error.Monad<Error>
      [[pre/state' temp] (pre input pre/state)
       [post/state' output] (post temp post/state)]
      (wrap [[pre/state' post/state'] output]))))

(def: #export (timed definition description operation)
  (All [s a]
    (-> Name Text (Operation s a) (Operation s a)))
  (do Monad<Operation>
    [_ (wrap [])
     #let [pre (io.run instant.now)]
     output operation
     #let [_ (log! (|> instant.now
                       io.run
                       instant.relative
                       (duration.difference (instant.relative pre))
                       %duration
                       (format (%name definition) " [" description "]: ")))]]
    (wrap output)))