packages feed

css-parser-0.0.1: test/Spec.hs

-- cabal test   --test-option=--quickcheck-tests=10 --test-option=--quickcheck-max-size=22 --test-option=--hide-successes
-- cabal test   --test-option=--quickcheck-tests=11  --test-option=--quickcheck-max-size=20    --test-option=--quickcheck-verbose --test-option=--quickcheck-replay="(SMGen 1498744052230560514 7024820165127764247,10)"
module Main where

import CssParser
    ( CssShow(toCssText),
      P(Ok, Failed),
      CssFile,
      getToken,
      alex,
      parseCssP,
      parseCss )
import CssParser.Test.Arbitrary.File ()
import CssParser.Test.Arbitrary.Media ()
import CssParser.Utils (encodeString, readCssString, encodeIdentifier, readIdentifier)
import Data.Text (pack)
import Data.Text.Lazy qualified as TL
import Prelude
import Test.Tasty ( defaultMain, testGroup, TestTree )
import Test.Tasty.HUnit ( testCase, (@=?) )
import Test.Tasty.QuickCheck
    ( (===), {-label,-} withMaxSize, withMaxSuccess, Property, testProperty )

main :: IO ()
main = defaultMain tests

tests :: TestTree
tests = testGroup "CssParser"
  [ testGroup "Encode-decode"
    [ testProperty "Encode-decode identity 1" (encodeDecode '"')
    , testProperty "Encode-decode identity 2" (encodeDecode '\'')
    , testProperty "Encode-decode identifier" encodeDecodeId
    ]
  , testGroup "Examples"
    [ testGroup "Empty body"
      (fmap (\x -> cpt x (x <> " {}")) validSelectors)
    , testGroup "Nested1"
      (fmap (\x -> cpt x (x <> " {\n" <> x <> "{\t}\r}"))
        validSelectors)
    , testGroup "Layer"
      [ testGroup "Stmt"
        (fmap (\x -> cpt x (x <> ";")) layerStmt)
      ]
    , testGroup "Properties"
      (fmap (\x -> cpt x ("p { " <> x <> " }")) properties)
    , testGroup "At"
      (fmap (\x -> testCase x (True @=? checkParse x)) at)
    ]
  , testGroup "Arbitrary "
    [ testProperty "Alex" (throttle encodeDecodeAlex)
    , testProperty "Encode-decode CSS identity"
      -- cabal test with by default runs about a minute
      (throttle encodeDecodeCss)
    ]
  ]
  where
    throttle x =
      let l = 66 in
        withMaxSize l (withMaxSuccess l x)
    cpt m x = testCase m (True @=? checkParse (x <> " {}"))

encodeDecode :: Char -> String -> Bool
encodeDecode c b = readCssString (encodeString c b) == b

encodeDecodeId :: String -> Bool
encodeDecodeId b = readIdentifier (TL.unpack (encodeIdentifier (pack b))) == b

encodeDecodeAlex :: CssFile -> Property
encodeDecodeAlex cf =
  -- label cfCss $
    case alex cfCss of
      Left e -> error $ "Alex failed: " <> e <> "After:\n" <> cfCss
      Right v -> v === v
  where
   cfCss = TL.unpack $ toCssText cf


encodeDecodeCss :: CssFile -> Bool
encodeDecodeCss sg =
  case parseCssP sgTxt of
    Failed e ->
      error $ "Failed to parse:\n" <> sgTxt <>
      "\nTokens:\n" <>  show (fmap getToken <$> alex sgTxt) <>
      "\nError: " <> e
    Ok parsedSg
      | sg == parsedSg -> True
      | otherwise ->
        error $
          "CSS Input:\n" <> sgTxt <>
          "\nCSS Print:\n" <> TL.unpack (toCssText parsedSg) <>
          "\nParsed:\n" <> show parsedSg <>
          "\nSHOWED INPUT: "
  where
    sgTxt = TL.unpack $ toCssText sg

checkParse :: String -> Bool
checkParse x = y == y
  where y = parseCss x

at :: [String]
at =
  colorProfile <> fontFace <> fontFeatureValues <> fontPaletteValues <>
  container <> misc <> supports <> unknown <> media <> page <> layer <>
  atImport <> atFunction <> keyframe <> atProperty <> customMedia

colorProfile :: [String]
colorProfile =
  [ "@color-profile xx { src: url(\"https://example.org/SWOP2006_Coated5v2.icc\"); }"
  , "@color-profile y { src: url(example.org); src: url(example.com); }"
  ]

atProperty :: [String]
atProperty =
  [ "@property --ga { syntax: \"<angle>\"; initial-value: 0deg; inherits: false; }"
  ]

fontFace :: [String]
fontFace =
  [ "@font-face { src: local(\"x\"), format(\"z\") url(\"x.otf\"); unicode-range: U+11F?; }"
  , "@font-face {unicode-range:u+f003,u+f006}"
  , "/* */ @font-face { src: local(\"x\"); }"
  ]

fontFeatureValues :: [String]
fontFeatureValues =
  [ "@font-feature-values One Two { font-display: swap; @styleset { nice-style: 12; }}"
  ]

fontPaletteValues :: [String]
fontPaletteValues =
  [ "@font-palette-values --Ax {font-family: fa;}"
  , "@font-palette-values --Ax {font-family: fa; override-colors: 0 #00ffbb;}"
  , "@font-palette-values --Ax {font-family: fa; override-colors: 0 #fff;}"
  ]

container :: [String]
container =
  [ "@container not scroll-state(x: none) { }"
  , "@container foo (x: none) { }"
  , "@container foo  { }"
  , "@container foo (width > 100px) { }"
  , "@container style(--theme: one) or style(--theme: two) {}"
  ]

misc :: [String]
misc =
  [ "@position-try --x {x: 1px;}"
  , "@starting-style {}"
  , "@mixin input;"
  , "@define-mixin m1 { @mixin input; display: block; }"
  , "@custom-selector :--ti input[type='dt'], input[type='tm'];"
  , "[data-bs-theme=light]{--bs-btn-close-filter: }"
  , "a{a:muted, |*{}}"
  , "a{a:muted, a #f{}}"
  , "a{a:muted, a b{}}"
  , "a{a:muted, a + #y::first-line{}}"
  , "a{a:muted, a > .x::first-line{}}"
  , "a{src:muted, a b;}"
  , "a{src:muted, a b}"
  , "strong{color:currentColor}"
  , "@charset \"utf-8\"; /* */ /* */ @namespace \"x\"; "
  , "@namespace \"x\"; /* */ /* */ @namespace \"y\";"
  , "@layer a, b; /* */ /* */ @namespace \"y\";"
  , "@view-transition {}"
  , "@scope { x: 1rem; }"
  , "@scope { :scope {x: 1rem;} }"
  , "div { > p { --x: 1px; }}"
  , "div {>p{ --x: 1px; }}"
  , "div {p{ --x: 1px; }}"
  , "p{}/* */ "
  , "p{/* */ }"
  , "/* \n */p{ /* \n */ }"
  ]

supports :: [String]
supports =
  [ "@supports (transform-style: preserve-3d) or\n" <>
      "( (-moz-transform-style: preserve-3d) or (-webkit-transform-style: preserve-3d)  ) {  }"
  , "@supports not (transform-origin: 10em 10em 10em) {}"
  , "@supports (transform-origin: 5% 5%) { }"
  , "@supports not (not (transform-origin: 2px)) { }"
  , "@supports selector(h2 > p) and font-tech(color-COLRv1) or font-format(opentype) {}"
  , "@supports (display: grid) and (not (display: inline-grid)) { }"
  , "@supports (mask:url()){}"
  ]

unknown :: [String]
unknown =
  [ "@foobar{margin: 20px;}"
  , "@foobar {margin: 20px;}"
  , "@foobar aoeu {margin: 20px;}"
  , "@foobar aoeu{margin: 20px;}"
  , "@foobar \"oeu\" {margin: 20px;}"
  , "@foobar ao, eu {margin: 20px;}"
  ]

properties :: [String]
properties =
  [ "margin: 20px;"
  , "margin: 2.0px;"
  , "font-size: clamp(1mm / 2, 2mm * 2mm, 3mm + 1cm);"
  , "grid-template-columns: repeat(12, [col-start] 1fr);"
  , "padding-block: max(2 / 2 - 0.06rem);"
  , "padding-block: min((var(--c) - var(--t)) / 2 - 0.06rem, var(--t));"
  , "--uk: calc(-x);"
  , "--uk: .;"
  , "--xx: ( var(--v, 1.28572) * 1em );"
  , "filter:alpha(opacity=0)"
  , "grid-gap: 2;"
  , "fill:attr(data-x);"
  , "fill:attr(data-count type(<number>), 0);"
  , "fill:attr(data-width px, inherit);"
  , "fill:attr(data-width %);"
  , "fill:attr(data-something, \"default\");"
  , "fill:attr(data-size rem);"
  , "fill:attr(data-name raw-string);"
  , "fill:attr(id type(<custom-ident>));"
  , "fill:attr(data-count type(<number>));"
  , "all:U+0;"
  , "min-width: 0\\0;"
  , "font-feature-settings:\"kern\"1, \"liga\" 0;"
  , "margin: 1fr 2Hz 3kHz;"
  , "word-wrap: normal;"
  , "color:currentColor;"
  , "isolation:isolate;"
  , "--00-l: var(--bulma-white-00-l);"
  , "--bulma-table-cell-text-align:left;"
  , "border:ActiveText 2px solid;"
  , "border:ActiveText, solid;"
  , "border:ActiveText !important;"
  , "background-position:right -1rem center;"
  , "background-position:right;"
  , "-o-object-fit: contain !important;"
  , "cursor:not-allowed;"
  , "--bs-btn-font-family: ;"
  , "--x: hsla(var(--bulma-white-h), 1);"
  , "y: 1px; /* */ x: 100vh;"
  , "/* */ x: 100vh;"
  , "x: 100vh; /* */ "
  , "margin: 10e2px;"
  , "margin: -0.0px;"
  , "margin: -3.4e-2;"
  , "-moz-width: calc(2em * 5);"
  , "-webkit-width: calc( 2em / 5 );"
  , "width: calc(2em * 5);"
  , "width: calc(10px + 100px );"
  , "width: calc(1px+2px+3px);"
  , "width: calc( 10px+100px );"
  , "width: calc(100% - 30px);"
  , "width: calc(100%-30px);"
  , "width: calc( (var(--x) / var(--y) * 2) - x);" -- --f(3Q));"
  , "width: calc(var(--variable-width) + 20px);"
  , "margin: 1px !important;"
  , "font-family: -apple-system;"
  , "font-size: calc(var(--scale, 1) * 1em);"
  , "margin: 3cm, 1px !important ;"
  , "font-family: one, two, three,four , five;"
  , "--c: 0.0lvmax +0svmin; "
  , "--my-prop: 20px ;"
  , "padding: 12em 20mm;"
  , "padding: 12rem 25pt 2px 20mm;"
  , "margin-top: auto;"
  , "display: none;"
  , "forced-colors:active;"
  , "font-style: oblique 20deg 50deg;"
  , "transform: rotate(45deg);"
  , "transform: rotate(4grad);"
  , "transform: rotate(4turn);"
  , "transform: rotate(4rad);"
  , "border: 1px solid green;"
  , "mask:url();"
  , "x: url(\"https://example.org/SWOP2006_Coated5v2.icc\");"
  , "x: url(./file.jpg);"
  , "x: url(/file.jpg);"
  , "x: url(http://site.com:443/file.jpg);"
  , "x: url(http://site.com:443/file.jpg?yyy=oooo#aoeuao);"
  , "x: format(\"opentype\");"
  , "x: format(\"opentype\") tech(color);"
  , "container: x / y;"
  ]

page :: [String]
page =
  [ "@page {}"
  , "@page one {}"
  , "@page xxx:first{}"
  , "@page :blank eee {}"
  , "@page { @top-left {} }"
  ]

layerStmt :: [String]
layerStmt =
  [ "@layer ao-euth"
  , "@layer l1"
  , "@layer l1, and, oo "
  ]

layer :: [String]
layer =
  [ "@layer {}"
  , "@layer l1 {}"
  ]

keyframe :: [String]
keyframe =
  [ "@keyframes spinAround { from, to {transform:rotate(0deg);} to {transform: rotate(359deg);}}"
  , "@-webkit-keyframes spinAround { 0% {} 100% {}}"
  , "@keyframes x{from{transform:rotate(0deg)}to{transform:rotate(359deg)}}"
  , "@keyframes x{ from {transform:rotate(0deg)} /* * */ 2.2% {} /* * */ to {transform:rotate(1deg)} }"
  ]

atImport :: [String]
atImport =
  [ "@import \"my-imported-styles.css\";"
  , "@import url(\"chrome://communicator/skin/communicator.css\");"
  , "@import url(chrome://communicator/skin/communicator.css);"
  , "@import \"fine-print.css\" print;"
  , "@import \"bluish.css\" print, screen;"
  , "@import \"common.css\" screen;"
  , "@import \"landscape.css\" screen and (orientation: landscape); "
  , "@import \"grid.css\" supports(display: grid) screen and (width <= 400px);"
  , "@import \"flex.css\" supports((not (display: grid)) and (display: flex)) screen and (width <= 400px);"
  , "@import \"whatever.css\" supports((selector(h2 > p)) and (font-tech(color-COLRv1)));"
  , "@import \"theme.css\" layer(utilities);"
  , "@import \"theme.css\" layer();"
  , "@import \"style.css\" layer;"
  ]

atFunction :: [String]
atFunction =
  [ "@function --f() { result: 12px; }"
  , "@function --f(--x) { result: calc(var(--x) * 2); }"
  , "@function --f(--x, --y) returns type(<angle>+) { result: calc(var(--x)+var(--y)); }"
  , "@function --f(--x <length>) returns <length> { result: calc(var(--x) * 2); }"
  , "@function --f(--x type(<number> | <percentage>)) { result: calc(var(--x) * 2); }"
  , "@function --f(--x type(<angle>) : 0px) { result: calc(var(--x) / 2); }"
  , "@function --f(--x *) returns type(*) { result: calc(var(--x) * 2); }"
  , "@function --transparent(--color <color>, --alpha type(<number> | <percentage>))" ++
       "returns <color> { result: oklch(from var(--color) l c h / var(--alpha)); }"
  , "@function --narrow-wide(--narrow, --wide) { result: var(--wide);" ++
       "@media (width < 700px) { result: var(--narrow); } }"
  , "@function --outer(--outer-arg ){ --outer-local: 2; result:--inner();}"
  ]

media :: [String]
media =
  [ "@media screen and (width >= 900px) {}"
  , "@media not all and (hover: hover) {}"
  , "@media screen, print {}"
  , "@media screen or print {}"
  , "@media all {}"
  , "@media {} "
  , "@media (max-width: 320px){}"
  , "@media (-webkit-transform-3d) {}"
  , "@media (400px < width < 1000px) or (a) {}"
  , "@media not (f( 1) / y < x) {}"
  , "@media not (x > f( 1) / y) {}"
  , "@media not (f( 1) / y < x < f( 1) / y) {}"
  , "@media all and (-ms-high-contrast:active),(-ms-high-contrast:active) {}"
  , "@media only screen and (max-width : 600.99px) {}"
  ]

customMedia :: [String]
customMedia =
  [ "@custom-media --mobile-screen (width < 480px);"
  , "@custom-media --screen-or-print-1 screen, print or tty;"
  , "@custom-media --screen-or-print-2 screen or print;"
  , "@custom-media --medium-screen (min-width: 40em) and (max-width: 60em);"
  , "@custom-media --medium-screen ((min-width: 40em) and (max-width: 60em) and (max-height: calc(34rem - 0.02px)));"
  , "@custom-media --no-script not (script);"
  , "@custom-media --enabled true;"
  , "@custom-media --disabled false;"
  ]

-- Based on the w3c testkit: https://test.csswg.org/harness/suite/selectors-3_dev/
validSelectors :: [String]
validSelectors =
  [ "body > p"
  , "div ol>li p"
  , ".decoratorß-row"
  , ":global(.x)"
  , ":-webkit-any(input,select,textarea)"
  , "i:heading(0)"
  , "i:host(p)"
  , "i:state(p)"
  , ".progress::-webkit-progress-bar"
  , "input.is-skeleton:-moz-placeholder"
  , "*.pastoral"
  , ".pastoral¡"
  , ".media:not(:last-child)"
  , "h1.pastoral"
  , "p.pastoral.marine"
  , "h1#chapter1"
  , "#chapter1"
  , "*#z98y"
  , "math + p"
  , "/* ---- */ math +/* ]] */p/* (((- */ "
  , "<!--  ---- --> math +<!-- ]] -->p<!-- (((- --> "
  , "h1.opener + h2"
  , "h1 ~ pre"
  , "*"
  , "div :first-child"
  , "div *:first-child"
  , "body > h2:nth-of-type(n+2):nth-last-of-type(n+2)"
  , "body > h2:not(:first-of-type):not(:last-of-type)"
  , ":where(ol, ul, menu:focus)"
  , "h1:has(+ p)"
  , ":is(ol, ul) :is(ol, ul) ol"
  , "div:where(ol, ul) :where(ol, ul, menu:hover) ol"
  , "h1, h2, h3"
  , "h1"
  , "foo|h1"
  , "foo|*"
  , "|h1"
  , "*|h1"
  , "*[hreflang|=en]"
  , "[hreflang|=en]"
  , "*.warning"
  , ".warning"
  , "*#myid"
  , "#myid"
  , "ns|*"
  , "*|*"
  , "|*"
  , "*"
  , "[att]"
  , "[att=val]"
  , "[att=]"
  , "[att=-val]"
  , "[att~=val]"
  , "[att|=val]"
  , "h1[title]"
  , "span[class=\"example\"]"
  , "span[hello=\"Cleveland\"][goodbye=\"Columbus\"]"
  , "a[rel~=\"copyright\"]"
  , "a[href=\"http://www.w3.org/\"]"
  , "a[hreflang=fr]"
  , "a[hreflang|=\"en\"]"
  , ".button[disabled]"
  , "DIALOGUE[character=romeo]"
  , "DIALOGUE[character=juliet]"
  , "[att^=val]"
  , "[att$=val]"
  , "[att$=val i]"
  , "[att$=8val]"
  , "[att*=val]"
  , "[att*=-val]"
  , "object[type^=\"image/\"]"
  , "a[href$=\".html\"]"
  , "p[title*=\"hello\"]"
  , "[foo|att=val]"
  , "[*|att]"
  , "[|att]"
  , "[att]"
  , "EXAMPLE[radix=decimal]"
  , "EXAMPLE[radix=octal]"
  , "EXAMPLE"
  , "*.pastoral"
  , ".pastoral"
  , "H1.pastoral"
  , "p.pastoral.marine"
  , "h1#chapter1"
  , "#chapter1"
  , "*#z98y"
  , "a.external:visited"
  , "a:link"
  , "a:visited"
  , "a:hover"
  , "a:active"
  , "a:focus"
  , "a:focus:hover"
  , "p.note:target"
  , "*:target"
  , "*:target::before"
  , "html:lang(fr-be)"
  , "html:lang(de)"
  , ":lang(fr-be) > q"
  , ":lang(de) > q"
  , "[lang|=fr]"
  , ":lang(fr)"
  , "[lang|=fr]"
  , "tr:nth-child(2n+1)"
  , "tr:nth-child(odd)"
  , "tr:nth-child(2n+0)"
  , "tr:nth-child(even)"
  , ":nth-child(-n + 3 of li.important)"
  , ":nth-last-child(-n + 3 of li.important)"
  , ":nth-child(1 of .orbit)"
  , "p:nth-child(4n+1)"
  , "p:nth-child(4n+2)"
  , "p:nth-child(4n+3)"
  , "p:nth-child(4n+4)"
  , ":nth-child(10n-1)"
  , ":nth-child(10n+9)"
  , "foo:nth-child(0n+5)"
  , "foo:nth-child(5)"
  , "p"
  , "p::first-letter"
  , "span"
  , "h1 em"
  , "div * p"
  , "div p *[href]"
  , "body > p"
  , "div ol>li p"
  , "match + p"
  , "h1.opener + h2"
  , "h1 ~ pre"
  , "*"
  , "LI"
  , "UL LI"
  , "UL OL+LI"
  , "H1 + *[REL=up]"
  , "UL OL LI.red"
  , "LI.red.level"
  , "#x34y"
  , "#s12:not(FOO)"
  , "*"
  , "E"
  , "E[foo]"
  , "E[foo=\"bar\"]"
  , "E[foo=\"bar\" i]"
  , "E[foo=\"bar\" s]"
  , "E[foo~=\"bar\"]"
  , "E[foo^=\"bar\"]"
  , "E[foo$=\"bar\"]"
  , "E[foo*=\"bar\"]"
  , "E[foo|=\"en\"]"
  , "E:root"
  , "E:nth-child(n)"
  , "E:nth-last-child(n)"
  , "E:nth-of-type(n)"
  , "E:nth-last-of-type(n)"
  , "E:first-child"
  , "E:last-child"
  , "E:first-of-type"
  , "E:last-of-type"
  , "E:only-child"
  , "E:only-of-type"
  , "E:empty"
  , "E:link"
  , "E:visited"
  , "E:active"
  , "E:hover"
  , "E:focus"
  , "E:target"
  , "E:lang(fr)"
  , "E:enabled"
  , "E:disabled"
  , "E:checked"
  , "E::first-line"
  , "E::first-letter"
  , "E::before"
  , "E::after"
  , "E.warning"
  , "E#myid"
  , "E:not(s)"
  , "E F"
  , "E > F"
  , "E + F"
  , "E ~ F"
  , ".class"
  , ".class1.class2"
  , ".class1 .class2"
  , "#id"
  , "*"
  , "element"
  , "element.class"
  , "element,element"
  , "element element"
  , "element>element"
  , "element+element"
  , "element1~element2"
  , "[attribute]"
  , "[attribute=value]"
  , "[attribute~=value]"
  , "[attribute|=value]"
  , "[attribute^=value]"
  , "[attribute$=value]"
  , "[attribute*=value]"
  , ":active"
  , "::after"
  , "::before"
  , ":checked"
  , ":default"
  , ":disabled"
  , ":empty"
  , ":enabled"
  , ":first-child"
  , "::first-letter"
  , "::first-line"
  , ":first-of-type"
  , ":focus"
  , ":fullscreen"
  , ":hover"
  , ":in-range"
  , ":indeterminate"
  , ":invalid"
  , ":lang(language)"
  , ":last-child"
  , ":last-of-type"
  , ":link"
  , "::marker"
  , ":not(selector)"
  , ":nth-child(n)"
  , ":nth-last-child(n)"
  , ":nth-last-of-type(n)"
  , ":nth-of-type(n)"
  , ":only-of-type"
  , ":only-child"
  , ":optional"
  , ":out-of-range"
  , "::placeholder"
  , ":read-only"
  , ":read-write"
  , ":required"
  , ":root"
  , "::selection"
  , ":target"
  , ":valid"
  , ":visited"
  ]