(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]
    {[0 #test]
     [/
      ["$." equivalence]]}]
   [data
    ["%" text/format (#+ format)]
    [number
     ["." frac ("#@." number)]]]
   ["." math
    ["r" random (#+ Random)]]]
  {1
   ["." / (#+ Color)]})

(def: #export color
  (Random Color)
  (|> ($_ r.and r.nat r.nat r.nat)
      (:: r.monad map /.from-rgb)))

(def: scale
  (-> Nat Frac)
  (|>> .int int-to-frac))

(def: square (-> Frac Frac) (math.pow +2.0))

(def: (distance from to)
  (-> Color Color Frac)
  (let [[fr fg fb] (/.to-rgb from)
        [tr tg tb] (/.to-rgb to)]
    (math.pow +0.5 ($_ f/+
                       (|> (scale tr) (f/- (scale fr)) square)
                       (|> (scale tg) (f/- (scale fg)) square)
                       (|> (scale tb) (f/- (scale fb)) square)))))

(def: error-margin Frac +1.8)

(def: black (/.from-rgb [0 0 0]))
(def: white (/.from-rgb [255 255 255]))

(template [<field>]
  [(def: (<field> color)
     (-> Color Frac)
     (let [[hue saturation luminance] (/.to-hsl color)]
       <field>))]

  [saturation]
  [luminance]
  )

(def: #export test
  Test
  (<| (_.context (%.name (name-of /._)))
      (do r.monad
        [any ..color
         colorful (|> color
                      (r.filter (function (_ color) (|> (distance color black) (f/>= +100.0))))
                      (r.filter (function (_ color) (|> (distance color white) (f/>= +100.0)))))
         mediocre (|> color
                      (r.filter (|>> saturation
                                     ((function (_ saturation)
                                        (and (f/>= +0.25 saturation)
                                             (f/<= +0.75 saturation)))))))
         ratio (|> r.safe-frac (r.filter (f/>= +0.5)))]
        ($_ _.and
            ($equivalence.spec /.equivalence ..color)
            (_.test "Can convert to/from HSL."
                    (|> any /.to-hsl /.from-hsl
                        (distance any)
                        (f/<= error-margin)))
            (_.test "Can convert to/from HSB."
                    (|> any /.to-hsb /.from-hsb
                        (distance any)
                        (f/<= error-margin)))
            (_.test "Can convert to/from CMYK."
                    (|> any /.to-cmyk /.from-cmyk
                        (distance any)
                        (f/<= error-margin)))
            (_.test "Can interpolate between 2 colors."
                    (and (f/<= (distance colorful black)
                               (distance (/.darker ratio colorful) black))
                         (f/<= (distance colorful white)
                               (distance (/.brighter ratio colorful) white))))
            (_.test "Can calculate complement."
                    (let [~any (/.complement any)
                          (^open "/@.") /.equivalence]
                      (and (not (/@= any ~any))
                           (/@= any (/.complement ~any)))))
            (_.test "Can saturate color."
                    (f/> (saturation mediocre)
                         (saturation (/.saturate ratio mediocre))))
            (_.test "Can de-saturate color."
                    (f/< (saturation mediocre)
                         (saturation (/.de-saturate ratio mediocre))))
            (_.test "Can gray-scale color."
                    (let [gray'ed (/.gray-scale mediocre)]
                      (and (f/= +0.0
                                (saturation gray'ed))
                           (|> (luminance gray'ed)
                               (f/- (luminance mediocre))
                               frac@abs
                               (f/<= error-margin)))))
            ))))