diff options
Diffstat (limited to '')
| -rw-r--r-- | lux-mode/lux-mode.el | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/control/functor.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/css.lux | 159 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/css/property.lux | 231 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/css/selector.lux | 175 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/css/value.lux | 625 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/html.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text/encoding.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/lux/type/abstract.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/lux/type/quotient.lux | 38 | ||||
| -rw-r--r-- | stdlib/source/lux/world/internationalization/language.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/lux/world/internationalization/locale.lux | 30 | ||||
| -rw-r--r-- | stdlib/source/lux/world/internationalization/territory.lux | 19 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 8 |
14 files changed, 1198 insertions, 129 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 47983ed83..1babb75fe 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -246,7 +246,7 @@ Called by `imenu--generic-function'." ;; Type (type//syntax (altRE "|" "&" "->" "All" "Ex" "Rec" "primitive" "\\$" "type")) (type//checking (altRE ":" ":coerce" ":~" ":assume" ":of" ":cast" ":share")) - (type//abstract (altRE "abstract:" ":abstraction" ":representation" "\\^:representation")) + (type//abstract (altRE "abstract:" ":abstraction" ":representation" ":transmutation" "\\^:representation")) (type//unit (altRE "unit:" "scale:")) (type//poly (altRE "poly:" "derived:")) ;; Data diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux index 00a5c776b..415d57c93 100644 --- a/stdlib/source/lux/control/functor.lux +++ b/stdlib/source/lux/control/functor.lux @@ -27,6 +27,6 @@ (signature: #export (Contravariant f) (: (All [a b] - (-> (-> a b) - (-> (f b) (f a)))) + (-> (-> b a) + (-> (f a) (f b)))) map-1)) diff --git a/stdlib/source/lux/data/format/css.lux b/stdlib/source/lux/data/format/css.lux index fbdad1885..feb6fc8a9 100644 --- a/stdlib/source/lux/data/format/css.lux +++ b/stdlib/source/lux/data/format/css.lux @@ -1,97 +1,84 @@ (.module: - [lux #* + [lux (#- Name and) [data - ["." color (#+ Color)] + ["." color (#+ Color Pigment)] ["." number] ["." text - format] + format + ["." encoding (#+ Encoding)]] [collection - ["." list ("list/." Functor<List> Monoid<List>)]]]]) + ["." list ("list/." Functor<List> Monoid<List>)]]] + [type + abstract] + [world + [net (#+ URL)]]] + [/ + ["." selector (#+ Selector Combinator)] + ["." value (#+ Value)] + ["." property (#+ Property)]]) -(type: #export Selector - Text) +(abstract: #export Style + {#.doc "The style associated with a CSS selector."} -(type: #export Property Text) -(type: #export Value Text) + Text -(type: #export Style - {#.doc "The style associated with a CSS selector."} - (List [Property Value])) - -(type: #export Rule [Selector Style]) - -(type: #export Sheet (List Rule)) - -(type: #export CSS Text) - -(def: #export (inline style) - (-> Style Text) - (|> style - (list/map (function (_ [key val]) (format key ": " val))) - (text.join-with "; "))) - -(def: #export (css sheet) - (-> Sheet CSS) - (|> sheet - (list/map (function (_ [selector style]) - (if (list.empty? style) - "" - (format selector "{" (inline style) "}")))) - (text.join-with text.new-line))) - -(def: #export (rgb color) - (-> Color Value) - (let [[red green blue] (color.to-rgb color)] - (format "rgb(" (|> red .int %i) - "," (|> green .int %i) - "," (|> blue .int %i) - ")"))) - -(def: #export (rgba color alpha) - (-> Color Rev Value) - (let [[red green blue] (color.to-rgb color)] - (format "rgba(" (|> red .int %i) - "," (|> green .int %i) - "," (|> blue .int %i) - "," (if (r/= (:: number.Interval<Rev> top) alpha) - "1.0" - (format "0" (%r alpha))) - ")"))) - -(def: #export (rule selector style children) - (-> Selector Style Sheet Sheet) - (list& [selector style] - (list/map (function (_ [sub-selector sub-style]) - [(format selector sub-selector) sub-style]) - children))) - -(do-template [<name> <type>] - [(def: #export <name> - (-> <type> <type> <type>) - list/compose)] - - [merge Style] - [cascade Sheet] + (def: #export empty Style (:abstraction "")) + + (def: property-separator " ") + + (def: #export (with [property value]) + (All [brand] + (-> [(Property brand) (Value brand)] + (-> Style Style))) + (|>> :representation + (format (property.name property) ": " (value.value value) ";" ..property-separator) + :abstraction)) + + (def: #export inline + (-> Style Text) + (|>> :representation)) ) -(do-template [<name> <suffix>] - [(def: #export (<name> value) - (-> Frac Value) - (format (%f value) <suffix>))] - - [em "em"] - [ex "ex"] - [rem "rem"] - [ch "ch"] - [vw "vw"] - [vh "vh"] - [vmin "vmin"] - [vmax "vmax"] - [% "%"] - [cm "cm"] - [mm "mm"] - [in "in"] - [px "px"] - [pt "pt"] - [pc "pc"] +(abstract: #export CSS + {} + + Text + + (def: #export (rule selector style) + (-> Selector Style CSS) + (:abstraction (format (selector.selector selector) " " "{" (..inline style) "}"))) + + (def: #export (char-set encoding) + (-> Encoding CSS) + (:abstraction (format "@charset" " " (%t (encoding.name encoding)) ";"))) + + (def: css-separator text.new-line) + + (def: #export (and pre post) + (-> CSS CSS CSS) + (:abstraction (format (:representation pre) ..css-separator + (:representation post)))) + + (def: #export (alter combinator selector css) + (-> Combinator Selector CSS CSS) + (|> css + :representation + (text.split-all-with ..css-separator) + (list/map (|>> (format (selector.selector (combinator selector (selector.tag "")))))) + (text.join-with ..css-separator) + :abstraction)) + + (def: #export (dependent combinator selector style inner) + (-> Combinator Selector Style CSS CSS) + (..and (..rule selector style) + (..alter combinator selector inner))) + + (do-template [<name> <combinator>] + [(def: #export <name> + (-> Selector Style CSS CSS) + (..dependent <combinator>))] + + [scope selector.in] + [complex selector.sub] + ) ) diff --git a/stdlib/source/lux/data/format/css/property.lux b/stdlib/source/lux/data/format/css/property.lux new file mode 100644 index 000000000..b6a97cea4 --- /dev/null +++ b/stdlib/source/lux/data/format/css/property.lux @@ -0,0 +1,231 @@ +(.module: + [lux (#- All Cursor) + [data + ["." color (#+ Color)] + ["." number] + ["." text + format] + [collection + ["." list ("list/." Functor<List> Monoid<List>)]]] + [type + abstract] + ["." macro + ["." code] + ["s" syntax (#+ syntax:)]] + [world + [net (#+ URL)]]] + [// + [value (#+ All + Length Thickness Time + Location Area + Slice + Alignment Direction + Animation Animation-Fill + Column-Fill Column-Span + Iteration Count + Play + Timing Visibility Attachment + Blend Span Image + Angle Repeat Border + Collapse Break Caption + Clear + Content + Cursor + Shadow Clip)]]) + +(syntax: (text-identifier {identifier s.text}) + (wrap (list (code.local-identifier identifier)))) + +(abstract: #export (Property brand) + {} + + Text + + (def: #export name + (-> (Property Any) Text) + (|>> :representation)) + + (do-template [<brand> <alias>+ <property>+] + [(`` (do-template [<alias> <property>] + [(def: #export <alias> + (Property <brand>) + (:abstraction <property>))] + + (~~ (macro.multi <alias>+)))) + + (with-expansions [<rows> (macro.multi <property>+)] + (do-template [<property>] + [(`` (def: #export (~~ (text-identifier <property>)) + (Property <brand>) + (:abstraction <property>)))] + + <rows>))] + + [All + [] + [["all"]]] + + [Length + [] + [["border-image-outset"] + ["border-image-width"] + ["bottom"] + ["column-gap"] + ["column-width"]]] + + [Time + [] + [["animation-delay"] + ["animation-duration"]]] + + [Slice + [] + [["border-image-slice"]]] + + [Color + [[text-color "color"]] + [["background-color"] + ["border-color"] + ["border-bottom-color"] + ["border-left-color"] + ["border-right-color"] + ["border-top-color"] + ["caret-color"] + ["column-rule-color"]]] + + [Alignment + [] + [["align-content"] + ["align-items"] + ["align-self"]]] + + [Direction + [] + [["animation-direction"]]] + + [Animation + [] + [["animation-name"]]] + + [Animation-Fill + [] + [["animation-fill-mode"]]] + + [Column-Fill + [] + [["column-fill"]]] + + [Column-Span + [] + [["column-span"]]] + + [Iteration + [] + [["animation-iteration-count"]]] + + [Count + [] + [["column-count"]]] + + [Play + [] + [["animation-play-state"]]] + + [Timing + [] + [["animation-timing-function"]]] + + [Visibility + [] + [["backface-visibility"]]] + + [Attachment + [] + [["background-attachment"]]] + + [Blend + [] + [["background-blend-mode"]]] + + [Image + [] + [["background-image"] + ["border-image-source"]]] + + [Span + [] + [["background-clip"] + ["background-origin"] + ["box-sizing"]]] + + [Location + [] + [["background-position"]]] + + [Repeat + [] + [["background-repeat"] + ["border-image-repeat"]]] + + [Area + [] + [["background-size"] + ["border-radius"] + ["border-bottom-left-radius"] + ["border-bottom-right-radius"] + ["border-top-left-radius"] + ["border-top-right-radius"] + ["border-spacing"]]] + + [Border + [] + [["border-style"] + ["border-bottom-style"] + ["border-left-style"] + ["border-right-style"] + ["border-top-style"] + ["column-rule-style"]]] + + [Thickness + [] + [["border-width"] + ["border-bottom-width"] + ["border-left-width"] + ["border-right-width"] + ["border-top-width"] + ["column-rule-width"]]] + + [Collapse + [] + [["border-collapse"]]] + + [Break + [] + [["box-decoration-break"]]] + + [Caption + [] + [["caption-side"]]] + + [Clear + [] + [["clear"]]] + + [Shadow + [] + [["box-shadow"]]] + + [Clip + [] + [["clip"]]] + + [Content + [] + [["counter-reset"] + ["counter-increment"]]] + + [Cursor + [] + [["cursor"]]] + ) + ) diff --git a/stdlib/source/lux/data/format/css/selector.lux b/stdlib/source/lux/data/format/css/selector.lux new file mode 100644 index 000000000..f5a33e833 --- /dev/null +++ b/stdlib/source/lux/data/format/css/selector.lux @@ -0,0 +1,175 @@ +(.module: + [lux (#- and id is? not) + [data + ["." text + format]] + [type + abstract] + [world + [internationalization + ["." locale (#+ Locale)]]]]) + +(type: #export Tag Text) +(type: #export ID Text) +(type: #export Class Text) +(type: #export Attribute Text) + +(abstract: #export Selector + {} + + Text + + (def: #export selector + (-> Selector Text) + (|>> :representation)) + + (def: #export any + Selector + (:abstraction "*")) + + (def: #export tag + (-> Tag Selector) + (|>> :abstraction)) + + (do-template [<name> <type> <prefix>] + [(def: #export <name> + (-> <type> Selector) + (|>> (format <prefix>) :abstraction))] + + [id ID "#"] + [class Class "."] + ) + + (type: #export Combinator + (-> Selector Selector Selector)) + + (do-template [<name> <combinator>] + [(def: #export (<name> left right) + Combinator + (:abstraction (format (:representation left) + <combinator> + (:representation right))))] + + [and ","] + [in " "] + [sub ">"] + [after "+"] + [later "~"] + ) + + (def: #export (with attribute) + (-> Attribute Selector) + (:abstraction (format "[" attribute "]"))) + + (do-template [<name> <check>] + [(def: #export (<name> attribute value base) + (-> Attribute Text Selector Selector) + (:abstraction (format (:representation base) "[" attribute <check> value "]")))] + + [is? "="] + [has? "~="] + [has-start? "|="] + [starts? "^="] + [ends? "$="] + [contains? "*="] + ) + + (do-template [<name> <pseudo>] + [(def: #export (<name> base) + (-> Selector Selector) + (:abstraction (format (:representation base) <pseudo>)))] + + [active ":active"] + [after! "::after"] + [before! "::before"] + + [checked ":checked"] + [default ":default"] + [disabled ":disabled"] + [empty ":empty"] + [enabled ":enabled"] + [first-child ":first-child"] + [first-letter "::first-letter"] + [first-line "::first-line"] + [first-of-type ":first-of-type"] + [focused ":focus"] + [hovered ":hover"] + [in-range ":in-range"] + [indeterminate ":indeterminate"] + [invalid ":invalid"] + [last-child ":last-child"] + [last-of-type ":last-of-type"] + [link ":link"] + [only-of-type ":only-of-type"] + [only-child ":only-child"] + [optional ":optional"] + [out-of-range ":out-of-range"] + [placeholder "::placeholder"] + [read-only ":read-only"] + [read-write ":read-write"] + [required ":required"] + [root ":root"] + [selection "::selection"] + [target ":target"] + [valid ":valid"] + [visited ":visited"] + ) + + (def: #export (language locale base) + (-> Locale Selector Selector) + (|> locale + locale.code + (text.enclose ["(" ")"]) + (format (:representation base) ":lang") + :abstraction)) + + (def: #export not + (-> Selector Selector) + (|>> :representation + (text.enclose ["(" ")"]) + (format ":not") + :abstraction)) + + (abstract: #export Index + {} + + Text + + (def: #export simple + (-> Nat Index) + (|>> %n :abstraction)) + + (do-template [<name> <index>] + [(def: #export <name> Index (:abstraction <index>))] + + [odd "odd"] + [even "even"] + ) + + (type: #export Formula + {#constant Int + #variable Int}) + + (def: #export (formula input) + (-> Formula Index) + (let [(^slots [#constant #variable]) input] + (:abstraction (format (if (i/< +0 variable) + (%i variable) + (%n (.nat variable))) + (%i constant))))) + + (do-template [<name> <pseudo>] + [(def: #export (<name> index base) + (-> Index Selector Selector) + (|> (:representation index) + (text.enclose ["(" ")"]) + (format (:representation Selector base) <pseudo>) + (:abstraction Selector)))] + + [nth-child ":nth-child"] + [nth-last-child ":nth-last-child"] + [nth-last-of-type ":nth-last-of-type"] + [nth-of-type ":nth-of-type"] + ) + ) + ) diff --git a/stdlib/source/lux/data/format/css/value.lux b/stdlib/source/lux/data/format/css/value.lux new file mode 100644 index 000000000..8f485f429 --- /dev/null +++ b/stdlib/source/lux/data/format/css/value.lux @@ -0,0 +1,625 @@ +(.module: + [lux (#- All Cursor and) + [data + ["." color (#+ Color Pigment)] + ["." maybe] + ["." number] + ["." text + format] + [collection + ["." list ("list/." Functor<List>)]]] + [type + abstract] + ["." macro + ["." code] + ["s" syntax (#+ syntax:)]] + [world + [net (#+ URL)]]]) + +(syntax: (text-identifier {identifier s.text}) + (wrap (list (code.local-identifier identifier)))) + +(template: (enumeration: <abstraction> <representation> <out> <sample>+) + (abstract: #export <abstraction> + {} + + <representation> + + (def: #export <out> + (-> <abstraction> <representation>) + (|>> :representation)) + + (`` (do-template [<name> <value>] + [(def: #export <name> <abstraction> (:abstraction <value>))] + + (~~ (macro.multi <sample>+)) + )))) + +(template: (multi: <multi> <type> <separator>) + (def: #export (<multi> pre post) + (-> (Value <type>) (Value <type>) (Value <type>)) + (:abstraction (format (:representation pre) + <separator> + (:representation post))))) + +(abstract: #export (Value brand) + {} + + Text + + (def: #export value + (-> (Value Any) Text) + (|>> :representation)) + + (do-template [<name> <value>] + [(def: #export <name> Value (:abstraction <value>))] + + [initial "initial"] + [inherit "inherit"] + ) + + (do-template [<brand> <alias>+ <value>+] + [(abstract: #export <brand> {} Any) + + (`` (do-template [<name> <value>] + [(def: #export <name> + (Value <brand>) + (:abstraction <value>))] + + (~~ (macro.multi <alias>+)))) + + (with-expansions [<rows> (macro.multi <value>+)] + (do-template [<value>] + [(`` (def: #export (~~ (text-identifier <value>)) + (Value <brand>) + (:abstraction <value>)))] + + <rows>))] + + [All + [] + [["unset"]]] + + [Length + [] + []] + + [Time + [] + []] + + [Thickness + [] + [["medium"] + ["thin"] + ["thick"]]] + + [Slice + [] + [["fill"]]] + + [Alignment + [[auto-alignment "auto"]] + [["stretch"] + ["center"] + ["flex-start"] + ["flex-end"] + ["baseline"] + ["space-between"] + ["space-around"]]] + + [Direction + [[normal-direction "normal"]] + [["reverse"] + ["alternate"] + ["alternate-reverse"]]] + + [Animation + [] + []] + + [Animation-Fill + [[fill-forwards "forwards"] + [fill-backwards "backwards"] + [fill-both "both"]] + []] + + [Column-Fill + [] + [["balance"] + ["auto"]]] + + [Column-Span + [] + [["all"]]] + + [Iteration + [] + [["infinite"]]] + + [Count + [] + []] + + [Play + [] + [["paused"] + ["running"]]] + + [Timing + [] + [["linear"] + ["ease"] + ["ease-in"] + ["ease-out"] + ["ease-in-out"] + ["step-start"] + ["step-end"]]] + + [Visibility + [[invisible "hidden"]] + [["visible"]]] + + [Attachment + [] + [["scroll"] + ["fixed"] + ["local"]]] + + [Blend + [[normal-blend "normal"]] + [["multiply"] + ["screen"] + ["overlay"] + ["darken"] + ["lighten"] + ["color-dodge"] + ["saturation"] + ["color"] + ["luminosity"]]] + + [Span + [] + [["border-box"] + ["padding-box"] + ["content-box"]]] + + [Image + [[no-image "none"]] + []] + + [Repeat + [[stretch-repeat "stretch"]] + [["repeat"] + ["repeat-x"] + ["repeat-y"] + ["no-repeat"] + ["space"] + ["round"]]] + + [Location + [[left-top "left top"] + [left-center "left center"] + [left-bottom "left bottom"] + [right-top "right top"] + [right-center "right center"] + [right-bottom "right bottom"] + [center-top "center top"] + [center-center "center center"] + [center-bottom "center bottom"]] + []] + + [Area + [] + [["cover"] + ["contain"]]] + + [Border + [] + [["hidden"] + ["dotted"] + ["dashed"] + ["solid"] + ["double"] + ["groove"] + ["ridge"] + ["inset"] + ["outset"]]] + + [Collapse + [] + [["separate"] + ["collapse"]]] + + [Break + [] + [["slice"] + ["clone"]]] + + [Caption + [] + [["top"] + ["bottom"]]] + + [Clear + [[clear-left "left"] + [clear-right "right"] + [clear-both "both"]] + []] + + [Counter + [] + []] + + [Content + [] + [["open-quote"] + ["close-quote"] + ["no-open-quote"] + ["no-close-quote"]]] + + [Cursor + [[horizontal-text "text"]] + [["alias"] + ["all-scroll"] + ["cell"] + ["context-menu"] + ["col-resize"] + ["copy"] + ["crosshair"] + ["default"] + ["e-resize"] + ["ew-resize"] + ["grab"] + ["grabbing"] + ["help"] + ["move"] + ["n-resize"] + ["ne-resize"] + ["nesw-resize"] + ["ns-resize"] + ["nw-resize"] + ["nwse-resize"] + ["no-drop"] + ["none"] + ["not-allowed"] + ["pointer"] + ["progress"] + ["row-resize"] + ["s-resize"] + ["se-resize"] + ["sw-resize"] + ["vertical-text"] + ["w-resize"] + ["wait"] + ["zoom-in"] + ["zoom-out"]]] + + [Shadow + [] + []] + + [Clip + [] + []] + ) + + (def: value-separator ",") + + (def: (apply name inputs) + (-> Text (List Text) Value) + (|> inputs + (text.join-with ..value-separator) + (text.enclose ["(" ")"]) + (format name) + :abstraction)) + + (enumeration: Step Text + step + [[start "start"] + [end "end"]]) + + (def: #export (steps intervals step) + (-> Nat Step (Value Timing)) + (..apply "steps" (list (%n intervals) (..step step)))) + + (def: #export (cubic-bezier p0 p1 p2 p3) + (-> Frac Frac Frac Frac (Value Timing)) + (|> (list p0 p1 p2 p3) + (list/map %f) + (..apply "cubic-bezier"))) + + (def: #export iteration + (-> Nat (Value Iteration)) + (|>> %n :abstraction)) + + (def: #export count + (-> Nat (Value Count)) + (|>> %n :abstraction)) + + (def: #export animation + (-> Text (Value Animation)) + (|>> :abstraction)) + + (def: #export (rgb color) + (-> Color (Value Color)) + (let [[red green blue] (color.to-rgb color)] + (..apply "rgb" (list (%n red) + (%n green) + (%n blue))))) + + (def: #export (rgba pigment) + (-> Pigment (Value Color)) + (let [(^slots [#color.color #color.alpha]) pigment + [red green blue] (color.to-rgb color)] + (..apply "rgba" (list (%n red) + (%n green) + (%n blue) + (if (r/= (:: number.Interval<Rev> top) alpha) + "1.0" + (format "0" (%r alpha))))))) + + (do-template [<name> <suffix>] + [(def: #export (<name> value) + (-> Frac (Value Length)) + (:abstraction (format (%f value) <suffix>)))] + + [em "em"] + [ex "ex"] + [rem "rem"] + [ch "ch"] + [vw "vw"] + [vh "vh"] + [vmin "vmin"] + [vmax "vmax"] + [% "%"] + [cm "cm"] + [mm "mm"] + [in "in"] + [px "px"] + [pt "pt"] + [pc "pc"] + ) + + (def: (%int value) + (Format Int) + (if (i/< +0 value) + (%i value) + (%n (.nat value)))) + + (do-template [<name> <suffix>] + [(def: #export (<name> value) + (-> Int (Value Time)) + (:abstraction (format (if (i/< +0 value) + (%i value) + (%n (.nat value))) + <suffix>)))] + + + [seconds "s"] + [milli-seconds "ms"] + ) + + (def: #export thickness + (-> (Value Length) (Value Thickness)) + (|>> :transmutation)) + + (def: #export slice-number/1 + (-> Nat (Value Slice)) + (|>> %n :abstraction)) + + (def: slice-separator " ") + + (def: #export (slice-number/2 horizontal vertical) + (-> Nat Nat (Value Slice)) + (:abstraction (format (%n horizontal) ..slice-separator + (%n vertical)))) + + (def: percent-limit Nat (.inc 100)) + + (def: (percentage value) + (-> Nat Text) + (format (%n (n/% percent-limit value)) "%")) + + (def: #export slice-percent/1 + (-> Nat (Value Slice)) + (|>> percentage :abstraction)) + + (def: #export (slice-percent/2 horizontal vertical) + (-> Nat Nat (Value Slice)) + (:abstraction (format (..percentage horizontal) ..slice-separator + (..percentage vertical)))) + + (def: length-separator " ") + + (do-template [<name> <type>] + [(def: #export (<name> horizontal vertical) + (-> (Value Length) (Value Length) (Value <type>)) + (:abstraction (format (:representation horizontal) + ..length-separator + (:representation vertical))))] + + [location Location] + [area Area] + ) + + (def: #export (area/1 length) + (-> (Value Length) (Value Area)) + (..area length length)) + + (def: #export image + (-> URL (Value Image)) + (|>> %t + (list) + (..apply "url"))) + + (abstract: #export Stop + {} + + Text + + (def: #export stop + (-> (Value Color) Stop) + (|>> (:representation Value) (:abstraction Stop))) + + (def: stop-separator " ") + + (def: #export (single-stop length color) + (-> (Value Length) (Value Color) Stop) + (:abstraction (format (:representation Value color) ..stop-separator + (:representation Value length)))) + + (def: #export (double-stop start end color) + (-> (Value Length) (Value Length) (Value Color) Stop) + (:abstraction (format (:representation Value color) ..stop-separator + (:representation Value start) ..stop-separator + (:representation Value end)))) + + (abstract: #export Hint + {} + + Text + + (def: #export hint + (-> (Value Length) Hint) + (|>> (:representation Value) (:abstraction Hint))) + + (def: (with-hint [hint stop]) + (-> [(Maybe Hint) Stop] Text) + (case hint + #.None + (:representation Stop stop) + + (#.Some hint) + (format (:representation Hint hint) ..value-separator (:representation Stop stop)))))) + + (type: #export (List/1 a) + [a (List a)]) + + (abstract: #export Angle + {} + + Text + + (def: #export (turn value) + (-> Rev Angle) + (:abstraction (format (%r value) "turn"))) + + (def: degree-limit Nat 360) + + (def: #export (degree value) + (-> Nat Angle) + (:abstraction (format (%n (n/% ..degree-limit value)) "deg"))) + + (do-template [<name> <degree>] + [(def: #export <name> Angle (..degree <degree>))] + + [to-top 0] + [to-right 90] + [to-bottom 180] + [to-left 270] + ) + + (do-template [<name> <function>] + [(def: #export (<name> angle start next) + (-> Angle Stop (List/1 [(Maybe Hint) Stop]) (Value Image)) + (let [[now after] next] + (..apply <function> (list& (:representation Angle angle) + (with-hint now) + (list/map with-hint after)))))] + + [linear-gradient "linear-gradient"] + [repeating-linear-gradient "repeating-linear-gradient"] + ) + ) + + (enumeration: Shape Text + shape + [[ellipse "ellipse"] + [circle "circle"]]) + + (enumeration: Extent Text + extent + [[closest-side "closest-side"] + [closest-corner "closest-corner"] + [farthest-side "farthest-side"] + [farthest-corner "farthest-corner"]]) + + (do-template [<name> <function>] + [(def: #export (<name> shape extent location start next) + (-> Shape (Maybe Extent) (Value Location) + Stop (List/1 [(Maybe Hint) Stop]) + (Value Image)) + (let [after-extent (format "at " (:representation location)) + with-extent (case extent + (#.Some extent) + (format (..extent extent) " " after-extent) + + #.None + after-extent) + where (format (..shape shape) " " with-extent) + [now after] next] + (..apply <function> (list& (..shape shape) + (with-hint now) + (list/map with-hint after)))))] + + [radial-gradient "radial-gradient"] + [repeating-radial-gradient "repeating-radial-gradient"] + ) + + (def: default-length (px +0.0)) + + (def: #export (shadow horizontal vertical blur spread color inset?) + (-> (Value Length) (Value Length) + (Maybe (Value Length)) (Maybe (Value Length)) + (Value Color) Bit + (Value Shadow)) + (let [with-inset (if inset? + (list "inset") + (list))] + (|> (list& (:representation horizontal) + (:representation vertical) + (|> blur (maybe.default ..default-length) :representation) + (|> spread (maybe.default ..default-length) :representation) + (:representation color) + with-inset) + (text.join-with " ") + :abstraction))) + + (type: #export Rectangle + {#top (Value Length) + #right (Value Length) + #bottom (Value Length) + #left (Value Length)}) + + (def: #export (clip rectangle) + (-> Rectangle (Value Clip)) + (`` (..apply "rect" (list (~~ (do-template [<side>] + [(:representation (get@ <side> rectangle))] + + [#top] [#right] [#bottom] [#left])))))) + + (def: #export counter + (-> Text (Value Counter)) + (|>> :abstraction)) + + (def: #export current-count + (-> (Value Counter) (Value Content)) + (|>> :representation (list) (..apply "counter"))) + + (def: #export text + (-> Text (Value Content)) + (|>> %t :abstraction)) + + (def: #export attribute + (-> Text (Value Content)) + (|>> (list) (..apply "attr"))) + + (def: #export media + (-> URL (Value Content)) + (|>> (list) (..apply "url"))) + + (multi: multi-image Image ",") + (multi: multi-shadow Shadow ",") + (multi: multi-content Content " ") + ) diff --git a/stdlib/source/lux/data/format/html.lux b/stdlib/source/lux/data/format/html.lux index 7eb26bf5a..4adb63b7a 100644 --- a/stdlib/source/lux/data/format/html.lux +++ b/stdlib/source/lux/data/format/html.lux @@ -13,12 +13,13 @@ [world [net (#+ URL)]]] [// - ["." css (#+ CSS)] + ["." css (#+ CSS) + ["." selector]] ["." xml (#+ XML)]]) -(type: #export Tag Text) - -(type: #export ID Text) +(type: #export Tag selector.Tag) +(type: #export ID selector.ID) +(type: #export Class selector.Class) (type: #export Attributes {#.doc "Attributes for an HTML tag."} diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index 6e617e75b..00b5b719b 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -15,13 +15,13 @@ ## https://docs.oracle.com/javase/8/docs/technotes/guides/intl/encoding.doc.html -(abstract: #export Char-Set +(abstract: #export Encoding {} Text - (do-template [<name> <charset>] - [(def: #export <name> Char-Set (:abstraction <charset>))] + (do-template [<name> <encoding>] + [(def: #export <name> Encoding (:abstraction <encoding>))] [ascii "ASCII"] @@ -169,7 +169,7 @@ ) (def: #export name - (-> Char-Set Text) + (-> Encoding Text) (|>> :representation)) ) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index a8be42a00..ccb6b9e18 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -196,6 +196,9 @@ primitives (list (` ((~! ..pop!))))))))) +(syntax: #export (:transmutation value) + (wrap (list (` (..:abstraction (..:representation (~ value))))))) + (syntax: #export (^:representation {name (s.form s.local-identifier)} body {branches (p.some s.any)}) diff --git a/stdlib/source/lux/type/quotient.lux b/stdlib/source/lux/type/quotient.lux index 994383744..46f485720 100644 --- a/stdlib/source/lux/type/quotient.lux +++ b/stdlib/source/lux/type/quotient.lux @@ -22,31 +22,27 @@ (-> (-> t c) (Class t c q)))) (|>> :abstraction)) - (def: expose - (All [t c q] (-> (Class t c q) (-> t c))) - (|>> :representation)) - ) - -(abstract: #export (Quotient t c q) - {} + (abstract: #export (Quotient t c q) + {} - {#value t - #label c} + {#value t + #label c} - (def: #export (quotient class value) - (All [t c q] - (-> (Class t c q) t - (Quotient t c q))) - (:abstraction {#value value - #label ((expose class) value)})) + (def: #export (quotient class value) + (All [t c q] + (-> (Class t c q) t + (Quotient t c q))) + (:abstraction {#value value + #label ((:representation Class class) value)})) - (do-template [<name> <output> <slot>] - [(def: #export <name> - (All [t c q] (-> (Quotient t c q) <output>)) - (|>> :representation (get@ <slot>)))] + (do-template [<name> <output> <slot>] + [(def: #export <name> + (All [t c q] (-> (Quotient t c q) <output>)) + (|>> :representation (get@ <slot>)))] - [value t #value] - [label c #label] + [value t #value] + [label c #label] + ) ) ) diff --git a/stdlib/source/lux/world/internationalization/language.lux b/stdlib/source/lux/world/internationalization/language.lux index 97a5f7463..3075eba16 100644 --- a/stdlib/source/lux/world/internationalization/language.lux +++ b/stdlib/source/lux/world/internationalization/language.lux @@ -1,5 +1,10 @@ (.module: [lux #* + [control + [equivalence (#+ Equivalence)] + [hash (#+ Hash)]] + [data + ["." text]] [type abstract] ["." macro]]) @@ -509,4 +514,15 @@ ["zun" zuni []] ["zza" zaza [[dimili] [dimli] [kirdki] [kirmanjki] [zazaki]]] ) + + (structure: #export _ (Equivalence Language) + (def: (= reference sample) + (is? reference sample))) + + (structure: #export _ (Hash Language) + (def: eq Equivalence<Language>) + + (def: hash + (|>> :representation + (:: text.Hash<Text> hash)))) ) diff --git a/stdlib/source/lux/world/internationalization/locale.lux b/stdlib/source/lux/world/internationalization/locale.lux index b37c9be5c..3c63f4dca 100644 --- a/stdlib/source/lux/world/internationalization/locale.lux +++ b/stdlib/source/lux/world/internationalization/locale.lux @@ -1,9 +1,12 @@ (.module: [lux #* + [control + [equivalence (#+ Equivalence)] + [hash (#+ Hash)]] [data - [text + ["." text format - ["." encoding (#+ Char-Set)]]] + ["." encoding (#+ Encoding)]]] [type abstract] ["." macro]] @@ -17,10 +20,10 @@ Text (def: territory-separator "_") - (def: char-set-separator ".") + (def: encoding-separator ".") - (def: #export (locale language territory char-set) - (-> Language (Maybe Territory) (Maybe Char-Set) Locale) + (def: #export (locale language territory encoding) + (-> Language (Maybe Territory) (Maybe Encoding) Locale) (:abstraction (format (language.language language) (case territory (#.Some territory) @@ -28,9 +31,9 @@ #.None "") - (case char-set - (#.Some char-set) - (format ..char-set-separator (encoding.name char-set)) + (case encoding + (#.Some encoding) + (format ..encoding-separator (encoding.name encoding)) #.None "")))) @@ -38,4 +41,15 @@ (def: #export code (-> Locale Text) (|>> :representation)) + + (structure: #export _ (Equivalence Locale) + (def: (= reference sample) + (:: text.Equivalence<Text> = (:representation reference) (:representation sample)))) + + (structure: #export _ (Hash Locale) + (def: eq Equivalence<Locale>) + + (def: hash + (|>> :representation + (:: text.Hash<Text> hash)))) ) diff --git a/stdlib/source/lux/world/internationalization/territory.lux b/stdlib/source/lux/world/internationalization/territory.lux index 9094fcae6..ece06b9d6 100644 --- a/stdlib/source/lux/world/internationalization/territory.lux +++ b/stdlib/source/lux/world/internationalization/territory.lux @@ -1,9 +1,10 @@ (.module: [lux #* + [control + [equivalence (#+ Equivalence)] + [hash (#+ Hash)]] [data - [text - format - ["." encoding (#+ Char-Set)]]] + ["." text]] [type abstract] ["." macro]]) @@ -292,4 +293,16 @@ ["ZM" "ZMB" 894 "Zambia" zambia []] ["ZW" "ZWE" 716 "Zimbabwe" zimbabwe []] ) + + (structure: #export _ (Equivalence Territory) + (def: (= reference sample) + (is? reference sample))) + + (structure: #export _ (Hash Territory) + (def: eq Equivalence<Territory>) + + (def: hash + (|>> :representation + (get@ #long) + (:: text.Hash<Text> hash)))) ) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 6d99d905a..4a6036842 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -2,7 +2,15 @@ [lux #* [cli (#+ program:)] ["." test] + + ## These modules do not need to be tested. + [type + [variance (#+)]] + ## TODO: Test these modules + [data + [format + [css (#+)]]] ## [control ## ["._" contract] ## ["._" concatenative] |