(;module: {#;doc "Rational arithmetic."}
  lux
  (lux [math]
       (control [eq #+ Eq]
                [order]
                number
                codec
                monad
                ["p" parser])
       (data [number "n/" Codec<Text,Nat>]
             [text "Text/" Monoid<Text>]
             text/format
             ["E" error]
             [product]
             [maybe])
       [macro]
       (macro [code]
              ["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 (r/* param input)
  (-> Ratio Ratio Ratio)
  (normalize [(n/* (get@ #numerator param)
                   (get@ #numerator input))
              (n/* (get@ #denominator param)
                   (get@ #denominator input))]))

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

(def: #export (r/+ 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 (r/- 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 (r/% param input)
  (-> Ratio Ratio Ratio)
  (let [quot (n// (n/* (get@ #denominator input)
                       (get@ #numerator param))
                  (n/* (get@ #denominator param)
                       (get@ #numerator input)))]
    (r/- (update@ #numerator (n/* quot) param)
         input)))

(def: #export (r/= 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)))))]

  [r/<  n/<]
  [r/<= n/<=]
  [r/>  n/>]
  [r/>= n/>=]
  )

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

  [r/min r/<]
  [r/max r/>]
  )

(struct: #export _ (Eq Ratio)
  (def: = r/=))

(struct: #export _ (order;Order Ratio)
  (def: eq Eq<Ratio>)
  (def: < r/<)
  (def: <= r/<=)
  (def: > r/>)
  (def: >= r/>=))

(struct: #export _ (Number Ratio)
  (def: + r/+)
  (def: - r/-)
  (def: * r/*)
  (def: / r//)
  (def: % r/%)
  (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) maybe;assume product;right))

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

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

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

(syntax: #export (ratio numerator [?denominator (p;maybe s;any)])
  {#;doc (doc "Rational literals."
              (ratio numerator denominator)
              "The denominator can be omitted if it's 1."
              (ratio numerator))}
  (wrap (list (` (normalize {#;;numerator (~ numerator)
                             #;;denominator (~ (maybe;default (' +1)
                                                              ?denominator))})))))