(.module:
  lux
  (lux (control [functor #+ Functor]
                [apply #+ Apply]
                [monad #+ Monad do])
       [io #+ IO]))

(type: #export (Thread ! a)
  (-> ! a))

(type: #export (Box t v)
  {#.doc "A mutable box holding a value."}
  (#.Primitive "#Box" (~ (list t v))))

(def: #export (box init)
  (All [a] (-> a (All [!] (Thread ! (Box ! a)))))
  (function (_ !)
    ("lux box new" init)))

(def: #export (read box)
  (All [! a] (-> (Box ! a) (Thread ! a)))
  (function (_ !)
    ("lux box read" box)))

(def: #export (write value box)
  (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any)))))
  (function (_ !)
    ("lux box write" value box)))

(def: #export (run thread)
  (All [a]
    (-> (All [!] (Thread ! a))
        a))
  (thread []))

(struct: #export Functor<Thread>
  (All [!] (Functor (Thread !)))

  (def: (map f)
    (function (_ fa)
      (function (_ !)
        (f (fa !))))))

(struct: #export Apply<Thread>
  (All [!] (Apply (Thread !)))

  (def: functor Functor<Thread>)

  (def: (apply ff fa)
    (function (_ !)
      ((ff !) (fa !)))))

(struct: #export Monad<Thread>
  (All [!] (Monad (Thread !)))

  (def: functor Functor<Thread>)

  (def: (wrap value)
    (function (_ !)
      value))

  (def: (join ffa)
    (function (_ !)
      ((ffa !) !))))

(def: #export (update f box)
  (All [a] (-> (-> a a) (All [!] (-> (Box ! a) (Thread ! a)))))
  (do Monad<Thread>
    [old (read box)
     _ (write (f old) box)]
    (wrap old)))

(def: #export (io thread)
  (All [a]
    (-> (All [!] (Thread ! a))
        (IO a)))
  (function (_ void)
    (thread void)))