##  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:
  lux
  (lux [math]
       (control eq
                [ord]
                number
                codec
                monad)
       (data [number "n/" Number<Nat> Codec<Text,Nat>]
             [text "Text/" Monoid<Text>]
             text/format
             error
             [product])
       [compiler]
       (macro [ast]
              ["s" syntax #+ syntax: Syntax])))

(type: #export Ratio
  {#numerator Nat
   #denominator Nat})

(def: #hidden (normalize (^slots [#numerator #denominator]))
  (-> Ratio Ratio)
  (let [common (math;gcd numerator denominator)]
    {#numerator (n./ common numerator)
     #denominator (n./ common denominator)}))

(def: #export (q.* param input)
  (-> Ratio Ratio Ratio)
  (normalize [(n.* (get@ #numerator param)
                   (get@ #numerator input))
              (n.* (get@ #denominator param)
                   (get@ #denominator input))]))

(def: #export (q./ param input)
  (-> Ratio Ratio Ratio)
  (normalize [(n.* (get@ #denominator param)
                   (get@ #numerator input))
              (n.* (get@ #numerator param)
                   (get@ #denominator input))]))

(def: #export (q.+ param input)
  (-> Ratio Ratio Ratio)
  (normalize [(n.+ (n.* (get@ #denominator input)
                        (get@ #numerator param))
                   (n.* (get@ #denominator param)
                        (get@ #numerator input)))
              (n.* (get@ #denominator param)
                   (get@ #denominator input))]))

(def: #export (q.- param input)
  (-> Ratio Ratio Ratio)
  (normalize [(n.- (n.* (get@ #denominator input)
                        (get@ #numerator param))
                   (n.* (get@ #denominator param)
                        (get@ #numerator input)))
              (n.* (get@ #denominator param)
                   (get@ #denominator input))]))

(def: #export (q.% param input)
  (-> Ratio Ratio Ratio)
  (let [quot (n./ (n.* (get@ #denominator input)
                       (get@ #numerator param))
                  (n.* (get@ #denominator param)
                       (get@ #numerator input)))]
    (q.- (update@ #numerator (n.* quot) param)
         input)))

(def: #export (q.= param input)
  (-> Ratio Ratio Bool)
  (and (n.= (get@ #numerator param)
            (get@ #numerator input))
       (n.= (get@ #denominator param)
            (get@ #denominator input))))

(do-template [<name> <op>]
  [(def: #export (<name> param input)
     (-> Ratio Ratio Bool)
     (and (<op> (n.* (get@ #denominator input)
                     (get@ #numerator param))
                (n.* (get@ #denominator param)
                     (get@ #numerator input)))))]

  [q.<  n.<]
  [q.<= n.<=]
  [q.>  n.>]
  [q.>= n.>=]
  )

(do-template [<name> <comp>]
  [(def: #export (<name> left right)
     (-> Ratio Ratio Ratio)
     (if (<comp> left right)
       right
       left))]

  [q.min q.<]
  [q.max q.>]
  )

(struct: #export _ (Eq Ratio)
  (def: = q.=))

(struct: #export _ (ord;Ord Ratio)
  (def: eq Eq<Ratio>)
  (def: < q.<)
  (def: <= q.<=)
  (def: > q.>)
  (def: >= q.>=))

(struct: #export _ (Number Ratio)
  (def: ord Ord<Ratio>)
  (def: + q.+)
  (def: - q.-)
  (def: * q.*)
  (def: / q./)
  (def: % q.%)
  (def: (negate (^slots [#numerator #denominator]))
    {#numerator denominator
     #denominator numerator})
  (def: abs id)
  (def: (signum x)
    {#numerator +1
     #denominator +1}))

(def: separator Text ":")

(def: part-encode
  (-> Nat Text)
  (|>. n/encode (text;split +1) (default (undefined)) product;right))

(def: part-decode
  (-> Text (Error Nat))
  (|>. (format "+") n/decode))

(struct: #export _ (Codec Text Ratio)
  (def: (encode (^slots [#numerator #denominator]))
    ($_ Text/append (part-encode numerator) separator (part-encode denominator)))

  (def: (decode input)
    (case (text;split-with separator input)
      (#;Some [num denom])
      (do Monad<Error>
        [numerator (part-decode num)
         denominator (part-decode denom)]
        (wrap (normalize {#numerator numerator
                          #denominator denominator})))
      
      #;None
      (#;Left (Text/append "Invalid syntax for ratio: " input)))))

(syntax: #export (ratio numerator denominator)
  (wrap (list (` (normalize {#;;numerator (~ numerator)
                             #;;denominator (~ denominator)})))))