(.require
 [library
  [lux (.except)
   [abstract
    [functor (.only Functor)]
    [apply (.only Apply)]
    [monad (.only Monad do)]]
   [control
    ["[0]" function]]
   [meta
    ["[0]" code (.only)
     ["<[1]>" \\parser]]
    [macro (.only with_symbols)
     [syntax (.only syntax)]]]]])

(type .public (Cont i o)
  (-> (-> i o) o))

(def .public (continued next cont)
  (All (_ i o) (-> (-> i o) (Cont i o) o))
  (cont next))

(def .public result
  (All (_ a) (-> (Cont a a) a))
  (..continued function.identity))

(def .public (with_current f)
  (All (_ a b z)
    (-> (-> (-> a (Cont b z))
            (Cont a z))
        (Cont a z)))
  (function (_ k)
    (f (function (_ a) (function (_ _) (k a)))
       k)))

(def .public pending
  (syntax (_ [expr <code>.any])
    (with_symbols [g!_ g!k]
      (in (list (` (.function ((, g!_) (, g!k)) ((, g!k) (, expr)))))))))

(def .public (reset scope)
  (All (_ i o) (-> (Cont i i) (Cont i o)))
  (function (_ k)
    (k (result scope))))

(def .public (shift f)
  (All (_ a)
    (-> (-> (-> a (Cont a a))
            (Cont a a))
        (Cont a a)))
  (function (_ oc)
    (f (function (_ a) (function (_ ic) (ic (oc a))))
       function.identity)))

(def .public functor
  (All (_ o) (Functor (All (_ i) (Cont i o))))
  (implementation
   (def (each f fv)
     (function (_ k)
       (fv (function.composite k f))))))

(def .public apply
  (All (_ o) (Apply (All (_ i) (Cont i o))))
  (implementation
   (def functor ..functor)

   (def (on fv ff)
     (function (_ k)
       (|> (k (f v))
           (function (_ v)) fv
           (function (_ f)) ff)))))

(def .public monad
  (All (_ o) (Monad (All (_ i) (Cont i o))))
  (implementation
   (def functor ..functor)

   (def (in value)
     (function (_ k) (k value)))

   (def (conjoint ffa)
     (function (_ k)
       (ffa (continued k))))))

(def .public (portal init)
  (All (_ i o z)
    (-> i
        (Cont [(-> i (Cont o z))
               i]
              z)))
  (with_current
    (function (_ k)
      (do ..monad
        [.let [nexus (function (nexus val)
                       (k [nexus val]))]
         _ (k [nexus init])]
        (in (undefined))))))