(.module:
  [lux #*
   [control
    monoid
    ["." functor (#+ Functor)]
    [apply (#+ Apply)]
    ["." monad (#+ Monad do)]]])

(type: #export (Writer l a)
  {#.doc "Represents a value with an associated 'log' value to record arbitrary information."}
  {#log l
   #value a})

(def: #export (write l)
  {#.doc "Set the log to a particular value."}
  (All [l] (-> l (Writer l Any)))
  [l []])

(structure: #export functor
  (All [l]
    (Functor (Writer l)))
  
  (def: (map f fa)
    (let [[log datum] fa]
      [log (f datum)])))

(structure: #export (apply monoid)
  (All [l]
    (-> (Monoid l) (Apply (Writer l))))
  
  (def: &functor ..functor)

  (def: (apply ff fa)
    (let [[log1 f] ff
          [log2 a] fa]
      [(:: monoid compose log1 log2) (f a)])))

(structure: #export (monad monoid)
  (All [l]
    (-> (Monoid l) (Monad (Writer l))))
  
  (def: &functor ..functor)

  (def: (wrap x)
    [(:: monoid identity) x])

  (def: (join mma)
    (let [[log1 [log2 a]] mma]
      [(:: monoid compose log1 log2) a])))

(structure: #export (with monoid monad)
  (All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Writer l a))))))

  (def: &functor (functor.compose (get@ #monad.&functor monad) ..functor))

  (def: wrap
    (let [writer (..monad monoid)]
      (|>> (:: writer wrap) (:: monad wrap))))
  
  (def: (join MlMla)
    (do monad
      [## TODO: Remove once new-luxc is the standard compiler.
       [l1 Mla] (: (($ 1) (Writer ($ 0) (($ 1) (Writer ($ 0) ($ 2)))))
                   MlMla)
       ## [l1 Mla] MlMla
       [l2 a] Mla]
      (wrap [(:: monoid compose l1 l2) a]))))

(def: #export (lift monoid monad)
  (All [l M a]
    (-> (Monoid l) (Monad M)
        (-> (M a) (M (Writer l a)))))
  (:: monad map (|>> [(:: monoid identity)])))