(.module:
  lux
  (lux (control [monad #+ do Monad]
                ["p" parser "p/" Monad<Parser>]
                [eq #+ Eq]
                [order #+ Order]
                [enum #+ Enum])
       (data text/format
             (number ["r" ratio]))
       [macro]
       (macro [code]
              ["s" syntax #+ syntax:]
              (syntax ["cs" common]
                      (common ["csr" reader]
                              ["csw" writer])))
       (type abstract)))

(abstract: #export (Qty unit)
  {}
  Int
  
  (def: #export in
    (All [unit] (-> Int (Qty unit)))
    (|>> @abstract))

  (def: #export out
    (All [unit] (-> (Qty unit) Int))
    (|>> @repr)))

(sig: #export (Scale s)
  (: (All [u] (-> (Qty u) (Qty (s u))))
     scale)
  (: (All [u] (-> (Qty (s u)) (Qty u)))
     de-scale)
  (: r.Ratio
     ratio))

(type: #export Pure
  (Qty []))

(type: #export (Per d n)
  (-> d n))

(type: #export (Inverse u)
  (|> Pure (Per u)))

(type: #export (Product p s)
  (|> s (Per (Inverse p))))

(def: #export pure
  (-> Int Pure)
  in)

(do-template [<name> <tag>]
  [(def: <name>
     (-> Text Text)
     (|>> (format "{" kind "@" module "}")
          (let [[module kind] (ident-for <tag>)])))]
  
  [unit-name  #..Unit]
  [scale-name #..Scale]
  )

(syntax: #export (unit: [export csr.export]
                   [name s.local-symbol]
                   [annotations (p.default cs.empty-annotations csr.annotations)])
  (wrap (list (` (type: (~+ (csw.export export)) (~ (code.local-symbol name))
                   (~ (csw.annotations annotations))
                   (primitive (~ (code.text (unit-name name))))))
              (` (def: (~+ (csw.export export)) (~ (code.local-symbol (format "@" name)))
                   (~ (code.local-symbol name))
                   (:!! [])))
              )))

(def: ratio^
  (s.Syntax r.Ratio)
  (s.tuple (do p.Monad<Parser>
             [numerator s.int
              _ (p.assert (format "Numerator must be positive: " (%i numerator))
                          (i/> 0 numerator))
              denominator s.int
              _ (p.assert (format "Denominator must be positive: " (%i denominator))
                          (i/> 0 denominator))]
             (wrap [(int-to-nat numerator) (int-to-nat denominator)]))))

(syntax: #export (scale: [export csr.export]
                   [name s.local-symbol]
                   [(^slots [#r.numerator #r.denominator]) ratio^]
                   [annotations (p.default cs.empty-annotations csr.annotations)])
  (let [g!scale (code.local-symbol name)]
    (wrap (list (` (type: (~+ (csw.export export)) ((~ g!scale) (~' u))
                     (~ (csw.annotations annotations))
                     (primitive (~ (code.text (scale-name name))) [(~' u)])))
                (` (struct: (~+ (csw.export export)) (~ (code.local-symbol (format "@" name)))
                     (..Scale (~ g!scale))
                     (def: (~' scale)
                       (|>> ..out
                            (i/* (~ (code.int (nat-to-int numerator))))
                            (i// (~ (code.int (nat-to-int denominator))))
                            ..in))
                     (def: (~' de-scale)
                       (|>> ..out
                            (i/* (~ (code.int (nat-to-int denominator))))
                            (i// (~ (code.int (nat-to-int numerator))))
                            ..in))
                     (def: (~' ratio)
                       [(~ (code.nat numerator)) (~ (code.nat denominator))])))
                ))))

(do-template [<name> <op>]
  [(def: #export (<name> param subject)
     (All [unit] (-> (Qty unit) (Qty unit) (Qty unit)))
     (|> subject out (<op> (out param)) in))]

  [u/+ i/+]
  [u/- i/-]
  )

(def: #export (u// param subject)
  (All [p s] (-> (Qty p) (Qty s) (|> (Qty s) (Per (Qty p)))))
  (function [input]
    (|> (out subject)
        (i/* (out input))
        (i// (out param))
        in)))

(def: #export (u/* param subject)
  (All [p s] (-> (Qty p) (Qty s) (Product (Qty p) (Qty s))))
  (function [input]
    (|> subject
        out
        (i/* (out (input param)))
        in)))

(def: #export (re-scale from to quantity)
  (All [si so u] (-> (Scale si) (Scale so) (Qty (si u)) (Qty (so u))))
  (let [[numerator denominator] (|> (:: to ratio) (r.r// (:: from ratio)))]
    (|> quantity
        out
        (i/* (nat-to-int numerator))
        (i// (nat-to-int denominator))
        in)))

(scale: #export Kilo [1         1_000])
(scale: #export Mega [1     1_000_000])
(scale: #export Giga [1 1_000_000_000])

(scale: #export Milli [        1_000 1])
(scale: #export Micro [    1_000_000 1])
(scale: #export Nano  [1_000_000_000 1])

(unit: #export Gram)
(unit: #export Meter)
(unit: #export Litre)
(unit: #export Second)

(struct: #export Eq<Unit> (All [unit] (Eq (Qty unit)))
  (def: (= reference sample)
    (i/= (out reference) (out sample))))

(struct: #export Order<Unit> (All [unit] (Order (Qty unit)))
  (def: eq Eq<Unit>)
  
  (do-template [<name> <func>]
    [(def: (<name> reference sample)
       (<func> (out reference) (out sample)))]

    [<  i/<]
    [<= i/<=]
    [>  i/>]
    [>= i/>=]))

(struct: #export Enum<Unit> (All [unit] (Enum (Qty unit)))
  (def: order Order<Unit>)
  (def: succ (|>> ..out i/inc ..in))
  (def: pred (|>> ..out i/dec ..in)))