From be4bb6f0a906a155c74158abcbf6ef0321057072 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 15 Jul 2019 08:38:16 +1200
Subject: [PATCH] Fix parser freezes, blocking issue for Rhapsode.

---
 src/Data/CSS/Syntax/StyleSheet.hs  | 12 ++++++++----
 src/Data/CSS/Syntax/StylishUtil.hs | 11 +++++++----
 stylish-haskell.cabal              |  2 +-
 test/Test.hs                       | 15 +++++++++++++++
 4 files changed, 31 insertions(+), 9 deletions(-)

diff --git a/src/Data/CSS/Syntax/StyleSheet.hs b/src/Data/CSS/Syntax/StyleSheet.hs
index 0a83d5d..edb0cbe 100644
--- a/src/Data/CSS/Syntax/StyleSheet.hs
+++ b/src/Data/CSS/Syntax/StyleSheet.hs
@@ -1,7 +1,9 @@
 module Data.CSS.Syntax.StyleSheet (
         parse, TrivialStyleSheet(..),
         StyleSheet(..), skipAtRule,
-        StyleRule(..)
+        StyleRule(..),
+        -- for testing
+        scanValue
     ) where
 
 import Data.CSS.Syntax.Tokens
@@ -73,6 +75,7 @@ skipAtRule (Semicolon:tokens) = tokens
 skipAtRule (LeftCurlyBracket:tokens) = skipBlock tokens
 
 skipAtRule (LeftParen:tokens) = skipAtRule $ skipBlock tokens
+skipAtRule (Function _:tokens) = skipAtRule $ skipBlock tokens
 skipAtRule (LeftSquareBracket:tokens) = skipAtRule $ skipBlock tokens
 -- To ensure parens are balanced, should already be handled.
 skipAtRule (RightCurlyBracket:tokens) = RightCurlyBracket:tokens
@@ -85,9 +88,10 @@ skipAtRule [] = []
 scanValue (Semicolon:tokens) = ([], tokens)
 scanValue (Whitespace:tokens) = scanValue tokens
 
-scanValue (LeftCurlyBracket:tokens) = scanInner tokens scanValue
-scanValue (LeftParen:tokens) = scanInner tokens scanValue
-scanValue (LeftSquareBracket:tokens) = scanInner tokens scanValue
+scanValue tokens@(LeftCurlyBracket:_) = scanInner tokens scanValue
+scanValue tokens@(LeftParen:_) = scanInner tokens scanValue
+scanValue tokens@(Function _:_) = scanInner tokens scanValue
+scanValue tokens@(LeftSquareBracket:_) = scanInner tokens scanValue
 -- To ensure parens are balanced, should already be handled.
 scanValue (RightCurlyBracket:tokens) = ([], RightCurlyBracket:tokens)
 scanValue (RightParen:tokens) = ([], RightParen:tokens)
diff --git a/src/Data/CSS/Syntax/StylishUtil.hs b/src/Data/CSS/Syntax/StylishUtil.hs
index 3995f4f..2441a22 100644
--- a/src/Data/CSS/Syntax/StylishUtil.hs
+++ b/src/Data/CSS/Syntax/StylishUtil.hs
@@ -23,12 +23,15 @@ scanBlock (RightCurlyBracket:tokens) = ([RightCurlyBracket], tokens)
 scanBlock (RightParen:tokens) = ([RightParen], tokens)
 scanBlock (RightSquareBracket:tokens) = ([RightSquareBracket], tokens)
 
-scanBlock (LeftCurlyBracket:tokens) = scanInner tokens scanBlock
-scanBlock (LeftParen:tokens) = scanInner tokens scanBlock
-scanBlock (LeftSquareBracket:tokens) = scanInner tokens scanBlock
+scanBlock tokens@(LeftCurlyBracket:_) = scanInner tokens scanBlock
+scanBlock tokens@(LeftParen:_) = scanInner tokens scanBlock
+scanBlock tokens@(Function _:_) = scanInner tokens scanBlock
+scanBlock tokens@(LeftSquareBracket:_) = scanInner tokens scanBlock
 
 scanBlock tokens = capture scanBlock tokens
 
 skipBlock tokens = snd $ scanBlock tokens
 
-scanInner tokens cb = concatP (++) scanBlock cb tokens
+scanInner (token:tokens) cb = concatP gather scanBlock cb tokens
+    where gather x y = token : x ++ y
+scanInner [] _ = error "Expected a token to capture."
diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal
index c3a634b..7ef776b 100644
--- a/stylish-haskell.cabal
+++ b/stylish-haskell.cabal
@@ -10,7 +10,7 @@ name:                stylish-haskell
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.2.1
+version:             0.2.2
 
 -- A short (one-line) description of the package.
 synopsis:            Apply CSS styles to a document tree.
diff --git a/test/Test.hs b/test/Test.hs
index 572ad25..bfa8d82 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -276,7 +276,22 @@ spec = do
             parse emptyStyle "output::before {content: 'Output'; pitch: high}"
                 `shouldBe` TrivialStyleSheet [
                     StyleRule (Element [Tag "output"]) []
+                ] -- Turned out to just be incorrect parsing
+            parse emptyStyle "input, output {content: attr(value)}"
+                `shouldBe` TrivialStyleSheet [
+                    StyleRule (Element [Tag "output"]) [
+                        ("content", [Function "attr", Ident "value", RightParen])
+                    ],
+                    StyleRule (Element [Tag "input"]) [
+                        ("content", [Function "attr", Ident "value", RightParen])
+                    ]
                 ]
+        it "paren balancing" $ do
+            scanValue [RightParen] `shouldBe` ([], [RightParen])
+            scanValue [LeftParen] `shouldBe` ([LeftParen], [])
+            scanValue [Function "fn", LeftParen] `shouldBe` ([Function "fn", LeftParen], [])
+            scanValue [Function "fn", Ident "arg", LeftParen] `shouldBe`
+                ([Function "fn", Ident "arg", LeftParen], [])
 
 styleIndex :: StyleIndex
 styleIndex = new
-- 
2.30.2