##  Copyright (c) Eduardo Julian. All rights reserved.
##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
##  If a copy of the MPL was not distributed with this file,
##  You can obtain one at http://mozilla.org/MPL/2.0/.

(;import lux
         (../functor #as F)
         (lux/data/list #refer #all #open ("" List/Fold)))

## [Signatures]
(defsig #export (CoMonad w)
  (: (F;Functor w)
     _functor)
  (: (All [a]
       (-> (w a) a))
     unwrap)
  (: (All [a]
       (-> (w a) (w (w a))))
     split))

## [Functions]
(def #export (extend w f ma)
  (All [w a b]
    (-> (CoMonad w) (-> (w a) b) (w a) (w b)))
  (using w
    (map f (split ma))))

## [Syntax]
(defmacro #export (be tokens state)
  (case tokens
    (#;Cons comonad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil)))
    (let [g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])])
          g!split (: AST [["" -1 -1] (#;SymbolS ["" " split "])])
          body' (foldL (: (-> AST (, AST AST) AST)
                          (lambda [body' binding]
                            (let [[var value] binding]
                              (case var
                                [_ (#;TagS ["" "let"])]
                                (` (let (~ value) (~ body')))

                                _
                                (` (|> (~ value) (~ g!split) ((~ g!map) (lambda [(~ var)] (~ body')))))
                                ))))
                       body
                       (reverse (as-pairs bindings)))]
      (#;Right [state (#;Cons (` (case (~ comonad)
                                   {#_functor {#F;map (~ g!map)} #unwrap (~ (' unwrap)) #split (~ g!split)}
                                   (~ body')))
                              #;Nil)]))

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