(define colour-bases {:orange {:s 95 :h 25} :cyan {:s 94 :h 188} :sky {:s 89 :h 199} :pink {:s 81 :h 330} :zinc {:s 5 :h 240} :amber {:s 92 :h 38} :neutral {:s 0 :h 0} :lime {:s 78 :h 84} :violet {:s 70 :h 263} :fuchsia {:s 84 :h 292} :stone {:s 6 :h 25} :black {:s 0 :h 0} :teal {:s 80 :h 173} :gray {:s 9 :h 220} :red {:s 72 :h 0} :rose {:s 89 :h 350} :blue {:s 91 :h 217} :emerald {:s 84 :h 160} :green {:s 71 :h 142} :yellow {:s 96 :h 48} :purple {:s 81 :h 271} :indigo {:s 84 :h 239} :white {:s 0 :h 0} :slate {:s 16 :h 215}})

(define
  colour-with-alpha
  (fn
    (name shade alpha)
    (let
      ((base (get colour-bases name)))
      (if
        (nil? base)
        name
        (let
          ((h (get base "h"))
            (s (get base "s"))
            (l (shade-to-lightness shade)))
          (str "hsl(" h "," s "%," (round l) "%," alpha ")"))))))

(define lerp (fn (a b t) (+ a (* t (- b a)))))

(define
  shade-to-lightness
  (fn
    (shade)
    (cond
      (<= shade 50)
      (lerp 100 97 (/ shade 50))
      (<= shade 100)
      (lerp 97 93 (/ (- shade 50) 50))
      (<= shade 200)
      (lerp 93 87 (/ (- shade 100) 100))
      (<= shade 300)
      (lerp 87 77 (/ (- shade 200) 100))
      (<= shade 400)
      (lerp 77 64 (/ (- shade 300) 100))
      (<= shade 500)
      (lerp 64 53 (/ (- shade 400) 100))
      (<= shade 600)
      (lerp 53 45 (/ (- shade 500) 100))
      (<= shade 700)
      (lerp 45 38 (/ (- shade 600) 100))
      (<= shade 800)
      (lerp 38 30 (/ (- shade 700) 100))
      (<= shade 900)
      (lerp 30 21 (/ (- shade 800) 100))
      (<= shade 950)
      (lerp 21 13 (/ (- shade 900) 50))
      :else 13)))

(define
  colour
  (fn
    (name shade)
    (let
      ((base (get colour-bases name)))
      (if
        (nil? base)
        name
        (if
          (= name "white")
          "#ffffff"
          (if
            (= name "black")
            "#000000"
            (let
              ((h (get base "h"))
                (s (get base "s"))
                (l (shade-to-lightness shade)))
              (str "hsl(" h "," s "%," (round l) "%)"))))))))

(define tw-colour-props {:ring "--tw-ring-color" :outline "outline-color" :bg "background-color" :accent "accent-color" :border "border-color" :stroke "stroke" :text "color" :fill "fill"})

(define tw-breakpoints {:sm "640px" :xl "1280px" :md "768px" :lg "1024px" :2xl "1536px"})

(define tw-states {:focus ":focus" :before "::before" :first ":first-child" :disabled ":disabled" :required ":required" :even ":nth-child(even)" :hover ":hover" :focus-visible ":focus-visible" :last ":last-child" :visited ":visited" :odd ":nth-child(odd)" :active ":active" :focus-within ":focus-within" :checked ":checked" :placeholder "::placeholder" :after "::after"})

(define tw-selector-states {:group-hover ".group:hover " :peer-disabled ".peer:disabled~" :dark ".dark " :peer-hover ".peer:hover~" :group-focus-within ".group:focus-within " :peer-checked ".peer:checked~" :group-focus ".group:focus " :group-active ".group:active " :peer-invalid ".peer:invalid~" :peer-required ".peer:required~" :peer-focus ".peer:focus~"})

(define tw-container-sizes {:xs "320px" :3xl "768px" :7xl "1280px" :sm "384px" :xl "576px" :md "448px" :6xl "1152px" :5xl "1024px" :lg "512px" :2xl "672px" :4xl "896px"})

(define
  tw-spacing-value
  (fn
    (v)
    (cond
      (= v "auto")
      "auto"
      (= v "px")
      "1px"
      (= v "0")
      "0px"
      (= v "0.5")
      "0.125rem"
      (= v "1.5")
      "0.375rem"
      (= v "2.5")
      "0.625rem"
      (= v "3.5")
      "0.875rem"
      :else (let
        ((n (parse-int v nil)))
        (if (nil? n) nil (str (* n 0.25) "rem"))))))

(define
  tw-template
  (fn
    (tmpl v)
    (let
      ((i (index-of tmpl "{v}")))
      (if
        (< i 0)
        tmpl
        (let
          ((result (str (substring tmpl 0 i) v (substring tmpl (+ i 3) (len tmpl)))))
          (let
            ((j (index-of result "{v}")))
            (if
              (< j 0)
              result
              (str
                (substring result 0 j)
                v
                (substring result (+ j 3) (len result))))))))))

(define tw-shadow-sizes {:sm "0 1px 2px 0 rgb(0 0 0 / 0.05)" :xl "0 20px 25px -5px rgb(0 0 0 / 0.1), 0 8px 10px -6px rgb(0 0 0 / 0.1)" :md "0 4px 6px -1px rgb(0 0 0 / 0.1), 0 2px 4px -2px rgb(0 0 0 / 0.1)" :inner "inset 0 2px 4px 0 rgb(0 0 0 / 0.05)" :lg "0 10px 15px -3px rgb(0 0 0 / 0.1), 0 4px 6px -4px rgb(0 0 0 / 0.1)" :2xl "0 25px 50px -12px rgb(0 0 0 / 0.25)" :none "0 0 #0000" : "0 1px 3px 0 rgb(0 0 0 / 0.1), 0 1px 2px -1px rgb(0 0 0 / 0.1)"})

(define tw-rounded-sizes {:3xl "1.5rem" :sm "0.125rem" :xl "0.75rem" :full "9999px" :md "0.375rem" :lg "0.5rem" :2xl "1rem" :none "0" : "0.25rem"})

(define tw-border-widths {:0 "0px" :2 "2px" :8 "8px" :4 "4px" : "1px"})

(define tw-arbitrary-props {:outline-color "outline-color" :max-h "max-height" :mt "margin-top" :max-w "max-width" :inset-x "inset-inline" :font-size "font-size" :leading "line-height" :columns "columns" :size "width" :bg "background-color" :delay "transition-delay" :m "margin" :top "top" :left "left" :grid-cols "grid-template-columns" :my "margin-block" :border "border-width" :pb "padding-bottom" :order "order" :gap "gap" :basis "flex-basis" :mx "margin-inline" :rounded "border-radius" :ml "margin-left" :grid-rows "grid-template-rows" :mr "margin-right" :font "font-family" :border-color "border-color" :mb "margin-bottom" :pl "padding-left" :aspect "aspect-ratio" :gap-y "row-gap" :inset "inset" :indent "text-indent" :accent "accent-color" :gap-x "column-gap" :opacity "opacity" :w "width" :stroke "stroke" :px "padding-inline" :pr "padding-right" :right "right" :text "color" :p "padding" :min-h "min-height" :tracking "letter-spacing" :bottom "bottom" :inset-y "inset-block" :z "z-index" :min-w "min-width" :fill "fill" :pt "padding-top" :py "padding-block" :h "height" :duration "transition-duration" :shadow "box-shadow"})

(define
  tw-resolve-arbitrary
  (fn
    (token)
    (let
      ((bracket-start (index-of token "[")))
      (if
        (or (nil? bracket-start) (< bracket-start 1))
        nil
        (let
          ((bracket-end (index-of token "]")))
          (if
            (nil? bracket-end)
            nil
            (let
              ((prefix (substring token 0 (- bracket-start 1)))
                (raw-val (substring token (+ bracket-start 1) bracket-end)))
              (let
                ((val (replace raw-val "_" " "))
                  (prop (get tw-arbitrary-props prefix)))
                (if (nil? prop) nil (str prop ":" val))))))))))

(define
  tw-resolve-style
  (fn
    (token)
    (let
      ((parts (split token "-"))
        (head (first parts))
        (rest (slice parts 1)))
      (cond
        (and
          (get tw-colour-props head)
          (>= (len rest) 2)
          (let
            ((shade-str (last rest)) (slash-pos (index-of shade-str "/")))
            (let
              ((shade-part (if (and slash-pos (>= slash-pos 0)) (substring shade-str 0 slash-pos) shade-str)))
              (and
                (not (nil? (parse-int shade-part nil)))
                (not
                  (nil?
                    (get
                      colour-bases
                      (join "-" (slice rest 0 (- (len rest) 1))))))))))
        (let
          ((css-prop (get tw-colour-props head))
            (shade-str (last rest))
            (slash-pos (index-of shade-str "/"))
            (cname (join "-" (slice rest 0 (- (len rest) 1)))))
          (let
            ((shade-part (if (and slash-pos (>= slash-pos 0)) (substring shade-str 0 slash-pos) shade-str))
              (alpha-part
                (if
                  (and slash-pos (>= slash-pos 0))
                  (substring shade-str (+ slash-pos 1) (len shade-str))
                  nil)))
            (let
              ((shade (parse-int shade-part 0)))
              (if
                alpha-part
                (str
                  css-prop
                  ":"
                  (colour-with-alpha
                    cname
                    shade
                    (/ (parse-int alpha-part 100) 100)))
                (str css-prop ":" (colour cname shade))))))
        (and
          (get tw-colour-props head)
          (= (len rest) 1)
          (or
            (= (first rest) "white")
            (= (first rest) "black")
            (= (first rest) "transparent")
            (= (first rest) "current")
            (= (first rest) "inherit")))
        (let
          ((css-prop (get tw-colour-props head))
            (val
              (case
                (first rest)
                "white"
                "#ffffff"
                "black"
                "#000000"
                "transparent"
                "transparent"
                "current"
                "currentColor"
                "inherit"
                "inherit")))
          (str css-prop ":" val))
        (= head "rounded")
        (cond
          (empty? rest)
          (str "border-radius:" (get tw-rounded-sizes ""))
          (and
            (= (len rest) 1)
            (not (nil? (get tw-rounded-sizes (first rest)))))
          (str "border-radius:" (get tw-rounded-sizes (first rest)))
          (and
            (>= (len rest) 1)
            (or
              (= (first rest) "t")
              (= (first rest) "b")
              (= (first rest) "l")
              (= (first rest) "r")))
          (let
            ((size (if (>= (len rest) 2) (get tw-rounded-sizes (nth rest 1)) (get tw-rounded-sizes "")))
              (dir (first rest)))
            (if
              (nil? size)
              nil
              (case
                dir
                "t"
                (str
                  "border-top-left-radius:"
                  size
                  ";border-top-right-radius:"
                  size)
                "b"
                (str
                  "border-bottom-left-radius:"
                  size
                  ";border-bottom-right-radius:"
                  size)
                "l"
                (str
                  "border-top-left-radius:"
                  size
                  ";border-bottom-left-radius:"
                  size)
                "r"
                (str
                  "border-top-right-radius:"
                  size
                  ";border-bottom-right-radius:"
                  size)
                :else nil)))
          :else nil)
        (= head "border")
        (cond
          (empty? rest)
          "border-width:1px"
          (and
            (= (len rest) 1)
            (not (nil? (get tw-border-widths (first rest)))))
          (str "border-width:" (get tw-border-widths (first rest)))
          (and
            (= (len rest) 1)
            (or
              (= (first rest) "t")
              (= (first rest) "b")
              (= (first rest) "l")
              (= (first rest) "r")
              (= (first rest) "x")
              (= (first rest) "y")))
          (let
            ((side (first rest)))
            (case
              side
              "t"
              "border-top-width:1px"
              "b"
              "border-bottom-width:1px"
              "l"
              "border-left-width:1px"
              "r"
              "border-right-width:1px"
              "x"
              "border-left-width:1px;border-right-width:1px"
              "y"
              "border-top-width:1px;border-bottom-width:1px"
              :else nil))
          (and
            (= (len rest) 2)
            (not (nil? (get tw-border-widths (nth rest 1)))))
          (let
            ((side (first rest)) (w (get tw-border-widths (nth rest 1))))
            (case
              side
              "t"
              (str "border-top-width:" w)
              "b"
              (str "border-bottom-width:" w)
              "l"
              (str "border-left-width:" w)
              "r"
              (str "border-right-width:" w)
              :else nil))
          :else nil)
        (= head "shadow")
        (let
          ((size-key (if (empty? rest) "" (join "-" rest))))
          (let
            ((val (get tw-shadow-sizes size-key)))
            (if (nil? val) nil (str "box-shadow:" val))))
        (and (= head "opacity") (= (len rest) 1))
        (let
          ((n (parse-int (first rest) nil)))
          (if (nil? n) nil (str "opacity:" (/ n 100))))
        (and
          (= head "ring")
          (>= (len rest) 2)
          (not (nil? (parse-int (last rest) nil)))
          (not
            (nil?
              (get colour-bases (join "-" (slice rest 0 (- (len rest) 1)))))))
        (let
          ((cname (join "-" (slice rest 0 (- (len rest) 1))))
            (shade (parse-int (last rest) 0)))
          (str "--tw-ring-color:" (colour cname shade)))
        (and (= head "ring") (or (empty? rest) (= (len rest) 1)))
        (let
          ((w (if (empty? rest) "3px" (let ((n (parse-int (first rest) nil))) (if (nil? n) nil (str n "px"))))))
          (if
            (nil? w)
            nil
            (str
              "box-shadow:0 0 0 "
              w
              " var(--tw-ring-color, rgb(59 130 246 / 0.5))")))
        (= head "outline")
        (cond
          (and (= (len rest) 1) (= (first rest) "none"))
          "outline:2px solid transparent;outline-offset:2px"
          (empty? rest)
          "outline-style:solid"
          :else nil)
        (= head "transition")
        (cond
          (empty? rest)
          "transition-property:color,background-color,border-color,text-decoration-color,fill,stroke,opacity,box-shadow,transform,filter,backdrop-filter;transition-timing-function:cubic-bezier(0.4,0,0.2,1);transition-duration:150ms"
          (= (first rest) "colors")
          "transition-property:color,background-color,border-color,text-decoration-color,fill,stroke;transition-timing-function:cubic-bezier(0.4,0,0.2,1);transition-duration:150ms"
          (= (first rest) "all")
          "transition-property:all;transition-timing-function:cubic-bezier(0.4,0,0.2,1);transition-duration:150ms"
          (= (first rest) "none")
          "transition-property:none"
          (= (first rest) "opacity")
          "transition-property:opacity;transition-timing-function:cubic-bezier(0.4,0,0.2,1);transition-duration:150ms"
          (= (first rest) "shadow")
          "transition-property:box-shadow;transition-timing-function:cubic-bezier(0.4,0,0.2,1);transition-duration:150ms"
          (= (first rest) "transform")
          "transition-property:transform;transition-timing-function:cubic-bezier(0.4,0,0.2,1);transition-duration:150ms"
          :else nil)
        (and (= head "duration") (= (len rest) 1))
        (str "transition-duration:" (first rest) "ms")
        (= head "ease")
        (let
          ((val (join "-" rest)))
          (case
            val
            "linear"
            "transition-timing-function:linear"
            "in"
            "transition-timing-function:cubic-bezier(0.4,0,1,1)"
            "out"
            "transition-timing-function:cubic-bezier(0,0,0.2,1)"
            "in-out"
            "transition-timing-function:cubic-bezier(0.4,0,0.2,1)"
            :else nil))
        (and (= head "cursor") (= (len rest) 1))
        (str "cursor:" (first rest))
        (and (= head "cursor") (= (len rest) 2))
        (str "cursor:" (join "-" rest))
        (and
          (= head "pointer")
          (= (len rest) 2)
          (= (first rest) "events"))
        (str "pointer-events:" (nth rest 1))
        (and (= head "select") (= (len rest) 1))
        (str "user-select:" (first rest))
        (and (= head "appearance") (= (len rest) 1))
        (str "appearance:" (first rest))
        (or
          (= token "underline")
          (= token "overline")
          (= token "line-through"))
        (str "text-decoration-line:" token)
        (and (= (len parts) 2) (= head "no") (= (first rest) "underline"))
        "text-decoration-line:none"
        (and (= head "scale") (= (len rest) 1))
        (let
          ((n (parse-int (first rest) nil)))
          (if (nil? n) nil (str "transform:scale(" (/ n 100) ")")))
        (and (= head "rotate") (= (len rest) 1))
        (str "transform:rotate(" (first rest) "deg)")
        (= head "animate")
        (cond
          (= (first rest) "spin")
          "animation:spin 1s linear infinite"
          (= (first rest) "ping")
          "animation:ping 1s cubic-bezier(0,0,0.2,1) infinite"
          (= (first rest) "pulse")
          "animation:pulse 2s cubic-bezier(0.4,0,0.6,1) infinite"
          (= (first rest) "bounce")
          "animation:bounce 1s infinite"
          (= (first rest) "none")
          "animation:none"
          :else nil)
        :else nil))))

(define
  tw-process-token
  (fn
    (token)
    (let
      ((important (starts-with? token "!"))
        (clean-token
          (if
            (starts-with? token "!")
            (substring token 1 (len token))
            token)))
      (let
        ((colon-parts (split clean-token ":"))
          (n (len (split clean-token ":")))
          (bp nil)
          (state nil)
          (sel-prefix nil)
          (container nil)
          (base nil))
        (cond
          (= n 1)
          (set! base (first colon-parts))
          (= n 2)
          (do
            (let
              ((prefix (first colon-parts)))
              (set! base (nth colon-parts 1))
              (cond
                (get tw-breakpoints prefix)
                (set! bp prefix)
                (get tw-selector-states prefix)
                (set! sel-prefix (get tw-selector-states prefix))
                (starts-with? prefix "@")
                (set! container (substring prefix 1 (len prefix)))
                true
                (set! state prefix))))
          (= n 3)
          (do
            (let
              ((p1 (first colon-parts)) (p2 (nth colon-parts 1)))
              (set! base (nth colon-parts 2))
              (cond
                (get tw-breakpoints p1)
                (set! bp p1)
                (get tw-selector-states p1)
                (set! sel-prefix (get tw-selector-states p1))
                (starts-with? p1 "@")
                (set! container (substring p1 1 (len p1)))
                true
                (set! bp p1))
              (if
                (get tw-selector-states p2)
                (set! sel-prefix (get tw-selector-states p2))
                (set! state p2))))
          true
          (set! base clean-token))
        (let
          ((negative (and base (starts-with? base "-")))
            (actual-base
              (if
                (and base (starts-with? base "-"))
                (substring base 1 (len base))
                base)))
          (let
            ((css (or (tw-resolve-style actual-base) (tw-resolve-layout actual-base) (tw-resolve-type actual-base) (tw-resolve-arbitrary actual-base))))
            (if
              (nil? css)
              nil
              (let
                ((css-str (if (dict? css) (get css :css) css))
                  (sel-suffix
                    (if (dict? css) (or (get css :suffix) "") "")))
                (let
                  ((neg-css (if negative (replace css-str ":" ":-") css-str))
                    (final-css
                      (if important (str neg-css " !important") neg-css))
                    (cls
                      (str
                        "sx-"
                        (replace (replace clean-token ":" "-") "." "d")))
                    (pseudo
                      (if
                        state
                        (or (get tw-states state) (str ":" state))
                        ""))
                    (selector
                      (if
                        sel-prefix
                        (str sel-prefix "." cls pseudo sel-suffix)
                        (str "." cls pseudo sel-suffix))))
                  (let
                    ((rule (cond bp (str "@media(min-width:" (get tw-breakpoints bp) "){" selector "{" final-css "}}") container (let ((csize (get tw-container-sizes container))) (if csize (str "@container(min-width:" csize "){" selector "{" final-css "}}") (str "@container{" selector "{" final-css "}}"))) true (str selector "{" final-css "}"))))
                    {:rule rule :cls cls}))))))))))

(defcomp
  ~tw
  (&key tokens)
  (let
    ((token-list (filter (fn (t) (not (= t ""))) (split (or tokens "") " ")))
      (results (map tw-process-token token-list))
      (valid (filter (fn (r) (not (nil? r))) results))
      (classes (map (fn (r) (get r "cls")) valid))
      (rules (map (fn (r) (get r "rule")) valid))
      (_ (for-each (fn (rule) (collect! "cssx" rule)) rules)))
    (if (empty? classes) nil (make-spread {:class (join " " classes) :data-tw (or tokens "")}))))

(defcomp
  ~tw/flush
  ()
  (let
    ((rules (collected "cssx")))
    (clear-collected! "cssx")
    (when (not (empty? rules)) (style :data-sx-css true (join "" rules)))))