##   Copyright (c) Eduardo Julian. All rights reserved.
##   The use and distribution terms for this software are covered by the
##   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
##   which can be found in the file epl-v10.html at the root of this distribution.
##   By using this software in any fashion, you are agreeing to be bound by
##   the terms of this license.
##   You must not remove this notice, or any other, from this software.

(;import lux
         (.. (functor #as F)
             (monoid #as M))
         lux/meta/macro)

## [Utils]
(def (foldL f init xs)
  (All [a b]
    (-> (-> a b a) a (List b) a)) 
  (case xs
    #;Nil
    init

    (#;Cons [x xs'])
    (foldL f (f init x) xs')))

(def (reverse xs)
  (All [a]
    (-> (List a) (List a)))
  (foldL (lambda [tail head] (#;Cons [head tail]))
         #;Nil
         xs))

(def (as-pairs xs)
  (All [a] (-> (List a) (List (, a a))))
  (case xs
    (#;Cons [x1 (#;Cons [x2 xs'])])
    (#;Cons [[x1 x2] (as-pairs xs')])

    _
    #;Nil))

## [Signatures]
(defsig #export (Monad m)
  (: (F;Functor m)
     _functor)
  (: (All [a]
       (-> a (m a)))
     wrap)
  (: (All [a]
       (-> (m (m a)) (m a)))
     join))

## [Syntax]
(defmacro #export (do tokens state)
  (case tokens
    ## (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
    (#;Cons [monad (#;Cons [(#;Meta [_ (#;TupleS bindings)]) (#;Cons [body #;Nil])])])
    (let [body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
                          (lambda [body' binding]
                            (let [[var value] binding]
                              (case var
                                (#;Meta [_ (#;TagS ["" "let"])])
                                (` (;let (~ value) (~ body')))

                                _
                                (` (;case ;;_functor
                                          {#F;map F;map}
                                          (;|> (~ value) (F;map (;lambda [(~ var)] (~ body'))) (;;join))))
                                ## (` (;|> (~ value) (F;map (;lambda [(~ var)] (~ body'))) (;:: ;;_functor) (;;join)))
                                ))))
                       body
                       (reverse (as-pairs bindings)))]
      (#;Right [state (#;Cons [(` (;case (~ monad)
                                         {#;;_functor ;;_functor #;;wrap ;;wrap #;;join ;;join}
                                         (~ body')))
                               #;Nil])]))

    _
    (#;Left "Wrong syntax for do")))

## [Functions]
(def #export (bind m f ma)
  (All [m a b]
    (-> (Monad m) (-> a (m b)) (m a) (m b)))
  (using m
    (;;join (:: ;;_functor (F;map f ma)))))

(def #export (map% m f xs)
  (All [m a b]
    (-> (Monad m) (-> a (m b)) (List a) (m (List b))))
  (case xs
    #;Nil
    (:: m (;;wrap #;Nil))
    
    (#;Cons [x xs'])
    (do m
      [y (f x)
       ys (map% m f xs')]
      (;;wrap (#;Cons [y ys])))
    ))