(.require
 [library
  [lux (.except)
   [abstract
    [equivalence (.only Equivalence)]
    [order (.only Order)]
    [enum (.only Enum)]
    [codec (.only Codec)]
    [monad (.only Monad do)]]
   [control
    ["<>" parser (.only)]
    ["[0]" pipe]
    ["[0]" try (.only Try)]
    ["[0]" exception (.only Exception)]]
   [data
    ["[0]" text (.use "[1]#[0]" monoid)
     ["<[1]>" \\parser (.only Parser)]]]
   [math
    [number
     ["n" nat (.use "[1]#[0]" decimal)]]]
   [meta
    [type
     ["[0]" nominal (.except def)]]]]]
 [/
  ["[0]" duration (.only Duration)]])

(with_template [<name> <singular> <plural>]
  [(def .public <name>
     Nat
     (.nat (duration.ticks <singular> <plural>)))]

  [milli_seconds duration.milli_second duration.second]
  [seconds duration.second duration.minute]
  [minutes duration.minute duration.hour]
  [hours duration.hour duration.day]
  )

(def limit
  Nat
  (.nat (duration.millis duration.day)))

(exception.def .public (time_exceeds_a_day time)
  (Exception Nat)
  (exception.report
   (list ["Time (in milli-seconds)" (n#encoded time)]
         ["Maximum (in milli-seconds)" (n#encoded (-- limit))])))

(def separator ":")

(def section_parser
  (Parser Nat)
  (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)))

(def millis_parser
  (Parser Nat)
  (<>.either (|> (<text>.at_most 3 <text>.decimal)
                 (<>.codec n.decimal)
                 (<>.after (<text>.this ".")))
             (at <>.monad in 0)))

(with_template [<maximum> <parser> <exception> <sub_parser>]
  [(exception.def .public (<exception> value)
     (Exception Nat)
     (exception.report
      (list ["Value" (n#encoded value)]
            ["Minimum" (n#encoded 0)]
            ["Maximum" (n#encoded (-- <maximum>))])))

   (def <parser>
     (Parser Nat)
     (do <>.monad
       [value <sub_parser>]
       (if (n.< <maximum> value)
         (in value)
         (<>.of_try (exception.except <exception> [value])))))]

  [..hours hour_parser invalid_hour ..section_parser]
  [..minutes minute_parser invalid_minute ..section_parser]
  [..seconds second_parser invalid_second ..section_parser]
  )

(nominal.def .public Time
  Nat

  (def .public midnight
    Time
    (abstraction 0))
  
  (def .public (of_millis milli_seconds)
    (-> Nat (Try Time))
    (if (n.< ..limit milli_seconds)
      {try.#Success (abstraction milli_seconds)}
      (exception.except ..time_exceeds_a_day [milli_seconds])))

  (def .public millis
    (-> Time Nat)
    (|>> representation))

  (def .public equivalence
    (Equivalence Time)
    (implementation
     (def (= param subject)
       (n.= (representation param) (representation subject)))))

  (def .public order
    (Order Time)
    (implementation
     (def equivalence ..equivalence)

     (def (< param subject)
       (n.< (representation param) (representation subject)))))

  (`` (def .public enum
        (Enum Time)
        (implementation
         (def order ..order)

         (def succ
           (|>> representation ++ (n.% ..limit) abstraction))

         (def pred
           (|>> representation
                (pipe.when
                  0 ..limit
                  millis millis)
                --
                abstraction)))))

  (def .public parser
    (Parser Time)
    (let [millis (is (-> Duration Nat)
                     (|>> duration.millis .nat))
          hour (millis duration.hour)
          minute (millis duration.minute)
          second (millis duration.second)
          millis (millis duration.milli_second)]
      (do [! <>.monad]
        [utc_hour ..hour_parser
         _ (<text>.this ..separator)
         utc_minute ..minute_parser
         _ (<text>.this ..separator)
         utc_second ..second_parser
         utc_millis ..millis_parser]
        (in (abstraction
             (all n.+
                  (n.* utc_hour hour)
                  (n.* utc_minute minute)
                  (n.* utc_second second)
                  (n.* utc_millis millis)))))))
  )

(def (padded value)
  (-> Nat Text)
  (if (n.< 10 value)
    (text#composite "0" (n#encoded value))
    (n#encoded value)))

(def (positive space duration)
  (-> Duration Duration Duration)
  (if (duration.negative? duration)
    (duration.composite space duration)
    duration))

(def (millis_format millis)
  (-> Nat Text)
  (cond (n.= 0 millis)   ""
        (n.< 10 millis)  (all text#composite ".00" (n#encoded millis))
        (n.< 100 millis) (all text#composite ".0" (n#encoded millis))
        ... (n.< 1,000 millis)
        (all text#composite "." (n#encoded millis))))

(type .public Clock
  (Record
   [#hour Nat
    #minute Nat
    #second Nat
    #milli_second Nat]))

(def .public (clock time)
  (-> Time Clock)
  (let [time (|> time ..millis .int duration.of_millis)
        [hours time] [(duration.ticks duration.hour time) (duration.framed duration.hour time)]
        [minutes time] [(duration.ticks duration.minute time) (duration.framed duration.minute time)]
        [seconds millis] [(duration.ticks duration.second time) (duration.framed duration.second time)]]
    [#hour (.nat hours)
     #minute (.nat minutes)
     #second (.nat seconds)
     #milli_second (|> millis
                       (..positive duration.second)
                       duration.millis
                       .nat)]))

(def .public (time clock)
  (-> Clock (Try Time))
  (|> (all duration.composite
           (duration.up (the #hour clock) duration.hour)
           (duration.up (the #minute clock) duration.minute)
           (duration.up (the #second clock) duration.second)
           (duration.of_millis (.int (the #milli_second clock))))
      duration.millis
      .nat
      ..of_millis))

(def (format time)
  (-> Time Text)
  (let [(open "_[0]") (..clock time)]
    (all text#composite
         (..padded _#hour)
         ..separator (..padded _#minute)
         ..separator (..padded _#second)
         (..millis_format _#milli_second)
         )))

(def .public codec
  (Codec Text Time)
  (implementation
   (def encoded ..format)
   (def decoded (<text>.result ..parser))))