##  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/.

(;module: {#;doc "Composable extensions to the piping macro |> that enhance it with various abilities."}
  lux
  (lux (control monad)
       (data (struct [list #+ Monad<List> "" Fold<List> "List/" Monad<List>])
             maybe)
       [compiler #+ with-gensyms Monad<Lux>]
       (macro ["s" syntax #+ syntax: Syntax]
              [ast])
       ))

## [Syntax]
(def: body^
  (Syntax (List AST))
  (s;tuple (s;many s;any)))

(syntax: #export (_> [tokens (s;at-least +2 s;any)])
  {#;doc (doc "Ignores the piped argument, and begins a new pipe."
              (|> 20
                  (i.* 3)
                  (i.+ 4)
                  (_> 0 i.inc)))}
  (case (list;reverse tokens)
    (^ (list& _ r-body))
    (wrap (list (` (|> (~@ (list;reverse r-body))))))

    _
    (undefined)))

(syntax: #export (@> [name (s;default "@" s;local-symbol)]
                     [body body^]
                     prev)
  {#;doc (doc "Gives the name '@' to the piped-argument, within the given expression."
              (|> 5
                  (@> [(i.+ @ @)]))

              (|> 5
                  (@> X [(i.+ X X)])))}
  (wrap (list (fold (lambda [next prev]
                      (` (let% [(~ (ast;symbol ["" name])) (~ prev)]
                           (~ next))))
                    prev
                    body))))

(syntax: #export (?> [branches (s;many (s;seq body^ body^))]
                     [?else (s;opt body^)]
                     prev)
  {#;doc (doc "Branching for pipes."
              "Both the tests and the bodies are piped-code, and must be given inside a tuple."
              "If a last else-pipe isn't given, the piped-argument will be used instead."
              (|> 5
                  (?> [i.even?] [(i.* 2)]
                      [i.odd?] [(i.* 3)]
                      [(_> -1)])))}
  (with-gensyms [g!temp]
    (wrap (list (` (let% [(~ g!temp) (~ prev)]
                     (cond (~@ (do Monad<List>
                                 [[test then] branches]
                                 (list (` (|> (~ g!temp) (~@ test)))
                                       (` (|> (~ g!temp) (~@ then))))))
                           (~ (case ?else
                                (#;Some else)
                                (` (|> (~ g!temp) (~@ else)))

                                _
                                g!temp)))))))))

(syntax: #export (!> [test body^] [then body^] prev)
  {#;doc (doc "Loops for pipes."
              "Both the testing and calculating steps are pipes and must be given inside tuples."
              (|> 1
                  (!> [(i.< 10)]
                      [i.inc])))}
  (with-gensyms [g!temp]
    (wrap (list (` (loop [(~ g!temp) (~ prev)]
                     (if (|> (~ g!temp) (~@ test))
                       ((~' recur) (|> (~ g!temp) (~@ then)))
                       (~ g!temp))))))))

(syntax: #export (%> monad [steps (s;some body^)] prev)
  {#;doc (doc "Monadic pipes."
              "Each steps in the monadic computation is a pipe and must be given inside a tuple."
              (|> 5
                  (%> Id/Monad
                      [(i.* 3)]
                      [(i.+ 4)]
                      [i.inc])))}
  (with-gensyms [g!temp]
    (case (list;reverse steps)
      (^ (list& last-step prev-steps))
      (let [step-bindings (do Monad<List>
                            [step (list;reverse prev-steps)]
                            (list g!temp (` (|> (~ g!temp) (~@ step)))))]
        (wrap (list (` (do (~ monad)
                         [(~ g!temp) (~ prev)
                          (~@ step-bindings)]
                         (|> (~ g!temp) (~@ last-step)))))))

      _
      (wrap (list prev)))))

(syntax: #export (~> [body body^] prev)
  {#;doc (doc "Non-updating pipes."
              "Will generate piped computations, but their results won't be used in the larger scope."
              (|> 5
                  (~> [int-to-nat %n log!])
                  (i.* 10)))}
  (do @
    [g!temp (compiler;gensym "")]
    (wrap (list (` (let [(~ g!temp) (~ prev)]
                     (exec (|> (~ g!temp) (~@ body))
                       (~ g!temp))))))))

(syntax: #export (&> [paths (s;many body^)] prev)
  {#;doc (doc "Parallel branching for pipes."
              "Allows to run multiple pipelines for a value and gives you a tuple of the outputs."
              (|> 5
                  (&> [(i.* 10)]
                      [i.dec (i./ 2)]
                      [Int/encode]))
              "Will become: [50 2 \"5\"]")}
  (do @
    [g!temp (compiler;gensym "")]
    (wrap (list (` (let [(~ g!temp) (~ prev)]
                     [(~@ (List/map (lambda [body] (` (|> (~ g!temp) (~@ body))))
                                    paths))]))))))

(syntax: #export (case> [branches (s;many (s;seq s;any s;any))] prev)
  {#;doc (doc "Pattern-matching for pipes."
              "The bodies of each branch are NOT pipes; just regular values."
              (|> 5
                  (case> 0 "zero"
                         1 "one"
                         2 "two"
                         3 "three"
                         4 "four"
                         5 "five"
                         6 "six"
                         7 "seven"
                         8 "eight"
                         9 "nine"
                         _ "???")))}
  (let [(^open "List/") Monad<List>]
    (wrap (list (` (case (~ prev)
                     (~@ (List/join (List/map (lambda [[pattern body]] (list pattern body))
                                              branches)))))))))