(.module:
  [lux #*
   [abstract
    [equivalence (#+ Equivalence)]
    [order (#+ Order)]
    [enum (#+ Enum)]
    [codec (#+ Codec)]
    [monoid (#+ Monoid)]
    [monad (#+ do)]]
   [control
    ["." try]
    ["<>" parser
     ["<t>" text (#+ Parser)]]]
   [data
    ["." text ("#\." monoid)]]
   [math
    [number
     ["i" int]
     ["." nat ("#\." decimal)]]]
   [type
    abstract]]
  ["." // #_
   ["#." year]])

(abstract: #export Duration
  Int

  {#.doc "Durations have a resolution of milli-seconds."}

  (def: #export from_millis
    (-> Int Duration)
    (|>> :abstraction))

  (def: #export to_millis
    (-> Duration Int)
    (|>> :representation))

  (template [<op> <name>]
    [(def: #export (<name> param subject)
       (-> Duration Duration Duration)
       (:abstraction (<op> (:representation param) (:representation subject))))]

    [i.+ merge]
    [i.% frame]
    )

  (template [<op> <name>]
    [(def: #export (<name> scalar)
       (-> Nat Duration Duration)
       (|>> :representation (<op> (.int scalar)) :abstraction))]

    [i.* up]
    [i./ down]
    )

  (def: #export inverse
    (-> Duration Duration)
    (|>> :representation (i.* -1) :abstraction))

  (def: #export (query param subject)
    (-> Duration Duration Int)
    (i./ (:representation param) (:representation subject)))

  (structure: #export equivalence
    (Equivalence Duration)
    
    (def: (= param subject)
      (i.= (:representation param) (:representation subject))))

  (structure: #export order
    (Order Duration)
    
    (def: &equivalence ..equivalence)
    (def: (< param subject)
      (i.< (:representation param) (:representation subject))))

  (template [<op> <name>]
    [(def: #export <name>
       (-> Duration Bit)
       (|>> :representation (<op> +0)))]

    [i.> positive?]
    [i.< negative?]
    [i.= neutral?]
    )
  )

(def: #export empty
  (..from_millis +0))

(def: #export milli_second
  (..from_millis +1))

(template [<name> <scale> <base>]
  [(def: #export <name>
     (..up <scale> <base>))]

  [second  1,000 milli_second]
  [minute     60 second]
  [hour       60 minute]
  [day        24 hour]

  [week        7 day]
  [normal_year //year.days day]
  )

(def: #export leap_year
  (..merge ..day ..normal_year))

(structure: #export monoid
  (Monoid Duration)
  
  (def: identity ..empty)
  (def: compose ..merge))

(template [<value> <definition>]
  [(def: <definition> <value>)]

  ["D" day_suffix]
  ["h" hour_suffix]
  ["m" minute_suffix]
  ["s" second_suffix]
  ["ms" milli_second_suffix]

  ["+" positive_sign]
  ["-" negative_sign]
  )

(def: (encode duration)
  (if (\ ..equivalence = ..empty duration)
    ($_ text\compose
        ..positive_sign
        (nat\encode 0)
        ..milli_second_suffix)
    (let [signed? (negative? duration)
          [days time_left] [(query day duration) (frame day duration)]
          days (if signed?
                 (i.abs days)
                 days)
          time_left (if signed?
                      (..inverse time_left)
                      time_left)
          [hours time_left] [(query hour time_left) (frame hour time_left)]
          [minutes time_left] [(query minute time_left) (frame minute time_left)]
          [seconds time_left] [(query second time_left) (frame second time_left)]
          millis (to_millis time_left)]
      ($_ text\compose
          (if signed? ..negative_sign ..positive_sign)
          (if (i.= +0 days) "" (text\compose (nat\encode (.nat days)) ..day_suffix))
          (if (i.= +0 hours) "" (text\compose (nat\encode (.nat hours)) ..hour_suffix))
          (if (i.= +0 minutes) "" (text\compose (nat\encode (.nat minutes)) ..minute_suffix))
          (if (i.= +0 seconds) "" (text\compose (nat\encode (.nat seconds)) ..second_suffix))
          (if (i.= +0 millis) "" (text\compose (nat\encode (.nat millis)) ..milli_second_suffix))
          ))))

(def: parser
  (Parser Duration)
  (let [section (: (-> Text Text (Parser Nat))
                   (function (_ suffix false_suffix)
                     (|> (<t>.many <t>.decimal)
                         (<>.codec nat.decimal)
                         (<>.before (case false_suffix
                                      "" (<t>.this suffix)
                                      _ (<>.after (<>.not (<t>.this false_suffix))
                                                  (<t>.this suffix))))
                         (<>.default 0))))]
    (do <>.monad
      [sign (<>.or (<t>.this ..negative_sign)
                   (<t>.this ..positive_sign))
       days (section ..day_suffix "")
       hours (section hour_suffix "")
       minutes (section ..minute_suffix ..milli_second_suffix)
       seconds (section ..second_suffix "")
       millis (section ..milli_second_suffix "")
       #let [span (|> ..empty
                      (..merge (..up days ..day))
                      (..merge (..up hours ..hour))
                      (..merge (..up minutes ..minute))
                      (..merge (..up seconds ..second))
                      (..merge (..up millis ..milli_second)))]]
      (wrap (case sign
              (#.Left _) (..inverse span)
              (#.Right _) span)))))

(structure: #export codec
  (Codec Text Duration)

  (def: encode ..encode)
  (def: decode (<t>.run ..parser)))

(def: #export (difference from to)
  (-> Duration Duration Duration)
  (|> from ..inverse (..merge to)))

(structure: #export enum
  (Enum Duration)

  (def: &order ..order)
  (def: succ
    (..merge ..milli_second))
  (def: pred
    (..merge (..inverse ..milli_second))))