(.module:
  [lux #*
   [control
    [functor (#+ Functor)]
    [apply (#+ Apply)]
    [monad (#+ Monad do)]]
   [data
    [collection
     ["." array (#+ Array)]]]
   [type (#+ :share)
    abstract]
   [platform
    [compiler
     ["." host]]]
   [io (#+ IO)]])

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

(abstract: #export (Box t v)
  {#.doc "A mutable box holding a value."}

  (Array v)

  (def: #export (box init)
    (All [a] (-> a (All [!] (Thread ! (Box ! a)))))
    (function (_ !)
      (|> (array.new 1)
          (array.write 0 init)
          :abstraction)))

  (def: #export (read box)
    (All [! a] (-> (Box ! a) (Thread ! a)))
    (function (_ !)
      (`` (for {(~~ (static host.jvm))
                ("jvm aaload" (:representation box) 0)}))))

  (def: #export (write value box)
    (All [a] (-> a (All [!] (-> (Box ! a) (Thread ! Any)))))
    (function (_ !)
      (|> box :representation (array.write 0 value) :abstraction)))
  )

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

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

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

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

  (def: functor Functor<Thread>)

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

(structure: #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)))