From 620c530c2e1346c26068eaa6e7d6997d74a2ac4e Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sun, 30 Apr 2023 14:42:13 +1200
Subject: [PATCH] Add new support APIs to Stylist Traits, releasing v0.1.2!

Expose pseudoelements to PropertyParsers.
Add utility for parsing unordered shorthands.
---
 stylist-traits/src/Stylist.hs       | 41 ++++++++++++++++++++++++++---
 stylist-traits/stylist-traits.cabal | 11 +++++---
 2 files changed, 46 insertions(+), 6 deletions(-)

diff --git a/stylist-traits/src/Stylist.hs b/stylist-traits/src/Stylist.hs
index f8d206f..203bc1a 100644
--- a/stylist-traits/src/Stylist.hs
+++ b/stylist-traits/src/Stylist.hs
@@ -1,14 +1,16 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Stylist(cssPriorityAgent, cssPriorityUser, cssPriorityAuthor,
     PropertyParser(..), TrivialPropertyParser(..),
     StyleSheet(..), TrivialStyleSheet(..), Props,
     Element(..), Attribute(..),
-    elementPath, compileAttrTest, matched, attrTest, hasWord, hasLang) where
+    elementPath, compileAttrTest, matched, attrTest, hasWord, hasLang,
+    parseUnorderedShorthand, parseUnorderedShorthand', parseOperands) where
 
 import Data.Text (Text, unpack)
-import Data.CSS.Syntax.Tokens (Token)
+import Data.CSS.Syntax.Tokens (Token(..))
 import Data.List
 
-import Stylist.Parse (StyleSheet(..), TrivialStyleSheet(..))
+import Stylist.Parse (StyleSheet(..), TrivialStyleSheet(..), scanBlock)
 import Stylist.Parse.Selector
 
 -- | Set the priority for a CSS stylesheet being parsed.
@@ -29,6 +31,7 @@ class PropertyParser a where
     shorthand :: a -> Text -> [Token] -> [(Text, [Token])]
     shorthand self key value | Just _ <- longhand self self key value = [(key, value)]
         | otherwise = []
+    -- | Mutates self to store the given CSS property, if it's syntax is valid.
     -- longhand parent self name value
     longhand :: a -> a -> Text -> [Token] -> Maybe a
 
@@ -39,6 +42,12 @@ class PropertyParser a where
     setVars :: Props -> a -> a
     setVars _ = id
 
+    -- | Mutates self to store the given pseudoelement styles,
+    -- passing a callback so you can alter the parent &
+    -- (for interactive pseudoclasses) base styles.
+    pseudoEl :: a -> Text -> (a -> Maybe a -> a) -> a
+    pseudoEl self _ _ = self
+
 -- | "key: value;" entries to be parsed into an output type.
 type Props = [(Text, [Token])]
 
@@ -98,3 +107,29 @@ attrTest namespace name test ElementNode { attributes = attrs } = any predicate
         predicate attr@(Attribute ns' _ _) | Just ns <- namespace = ns == ns' && predicate' attr
             | otherwise = predicate' attr
         predicate' (Attribute _ name' value') = name == name' && compileAttrTest test value'
+
+parseUnorderedShorthand :: PropertyParser a =>
+        a -> [Text] -> [Token] -> [(Text, [Token])]
+parseUnorderedShorthand self properties toks
+    | Just _ <- lookup "" ret = [] -- Error recovery!
+    | otherwise = ret
+  where
+    ret = parseUnorderedShorthand' self properties $ parseOperands toks
+parseUnorderedShorthand' :: PropertyParser a =>
+        a -> [Text] -> [[Token]] -> [(Text, [Token])]
+parseUnorderedShorthand' self properties (arg:args) = inner properties []
+  where
+    inner (prop:props) props'
+        | Just _ <- longhand self self prop arg =
+            parseUnorderedShorthand' self (props' ++ props) args
+        | otherwise = inner props (prop:props')
+    inner [] _ = [("", [])] -- Error caught & handled by public API.
+parseUnorderedShorthand' self (prop:props) [] = -- Shorthands have long effects!
+    (prop, [Ident "initial"]):parseUnorderedShorthand' self props []
+parseUnorderedShorthand' _ [] [] = []
+
+parseOperands :: [Token] -> [[Token]]
+parseOperands (Function name:toks) = let (args, toks') = scanBlock toks
+    in (Function name:args):parseOperands toks'
+parseOperands (tok:toks) = [tok]:parseOperands toks
+parseOperands [] = []
diff --git a/stylist-traits/stylist-traits.cabal b/stylist-traits/stylist-traits.cabal
index 40f2679..7b03755 100644
--- a/stylist-traits/stylist-traits.cabal
+++ b/stylist-traits/stylist-traits.cabal
@@ -10,7 +10,7 @@ name:                stylist-traits
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.1.1.0
+version:             0.1.2.0
 
 -- A short (one-line) description of the package.
 synopsis:            Traits, datatypes, & parsers for Haskell Stylist
@@ -19,7 +19,7 @@ synopsis:            Traits, datatypes, & parsers for Haskell Stylist
 description:         Decoupling layer for Haskell Stylist, so other modules don't have to pull in the full CSS engine in order to integrate it.
 
 -- URL for the project homepage or repository.
-homepage:            https://rhapsode.adrian.geek.nz/
+homepage:            https://argonaut-constellation.org/
 
 -- The license under which the package is released.
 license:             GPL-3
@@ -32,7 +32,9 @@ author:              Adrian Cochrane
 
 -- An email address to which users can send suggestions, bug reports, and
 -- patches.
-maintainer:          alcinnz@lavabit.com
+maintainer:          ~alcinnz/haskell-stylist@todo.argonaut-constellation.org
+
+bug-reports:         https://todo.argonaut-constellation.org/~alcinnz/harfbuzz-pure
 
 -- A copyright notice.
 -- copyright:
@@ -48,6 +50,9 @@ extra-source-files:  CHANGELOG.md
 -- Constraint on the version of Cabal needed to build this package.
 cabal-version:       >=1.10
 
+source-repository head
+    type:            git
+    location:        https://git.argonaut-constellation.org/~alcinnz/haskell-stylist
 
 library
   -- Modules exported by the library.
-- 
2.30.2