1 files changed, 36 insertions(+), 1 deletions(-)

M src/Data/CSS/Preprocessor/Text.hs

@@ 12,6 12,8 @@ import Data.Maybe (fromMaybe)
 import qualified Data.HashMap.Lazy as M
 import Data.Function ((&))
 
+import Data.Char (isSpace)
+
 type Counters = [(Text, Integer)]
 -- | `PropertyParser` decorator that parses & lowers certain CSS properties to plain text.
 data TextStyle p = TextStyle {


@@ 90,8 92,9 @@ parseCounters x (Ident counter : Number _ (NVInteger count') : toks) =
 parseCounters x (Ident counter : toks) = (:) (counter, x) <$> parseCounters x toks
 parseCounters _ _ = Nothing
 
+-- | Returns inner `PropertyParser` with text properties applied.
 resolve :: PropertyParser p => StyleTree (TextStyle p) -> StyleTree p
-resolve = resolve' . applyCounters
+resolve = resolve' . collapseWS . applyCounters
 resolve' :: PropertyParser p => StyleTree (TextStyle p) -> StyleTree p
 resolve' = treeMap $ \TextStyle {inner = inner', content = content'} -> (
         fromMaybe inner' $ longhand temp inner' "content" content'


@@ 161,3 164,35 @@ applyCounters0 counterSource valueSource path node =
             incrementCounters path (counterIncrement node) &
             setCounters path (counterSet node)
     in (counters, node {content = renderCounters counters $ content node})
+
+--------
+---- white-space
+--------
+collapseWS :: StyleTree (TextStyle p) -> StyleTree (TextStyle p)
+collapseWS = treeOrder collapseWS0 True
+collapseWS0 :: Bool -> Bool -> Path -> TextStyle p -> (Bool, TextStyle p)
+collapseWS0 _ _ _ node@(TextStyle {whiteSpaceCollapse = False, newlineCollapse = False}) = (False, node)
+collapseWS0 _ inSpace _ node@(TextStyle {
+        content = content0,
+        whiteSpaceCollapse = wsCollapse,
+        newlineCollapse = nlCollapse
+    }) = (trailingSpace, node {content = content'})
+  where (trailingSpace, content') = collapseWSToks inSpace wsCollapse nlCollapse content0
+
+collapseWSToks :: Bool -> Bool -> Bool -> [Token] -> (Bool, [Token])
+collapseWSToks stripStart wsCollapse nlCollapse (String txt:toks) =
+    let (trailingSpace, str') = collapseWSStr stripStart wsCollapse nlCollapse $ Txt.unpack txt
+        (trailingSpace', toks') = collapseWSToks trailingSpace wsCollapse nlCollapse toks
+    in (trailingSpace', String (Txt.pack str'):toks')
+collapseWSToks _ wsCollapse nlCollapse (tok:toks) =
+    let (trailingSpace, toks') = collapseWSToks False wsCollapse nlCollapse toks
+    in (trailingSpace, tok:toks')
+collapseWSToks trailingWS _ _ [] = (trailingWS, [])
+
+collapseWSStr, collapseWSStr' :: Bool -> Bool -> Bool -> String -> (Bool, String)
+collapseWSStr _ wsCollapse False str@('\n':_) = collapseWSStr' True wsCollapse True str
+collapseWSStr True True nlCollapse (ch:str) | isSpace ch = collapseWSStr True True nlCollapse str
+collapseWSStr False True nlCollapse str@(ch:_) | isSpace ch = collapseWSStr' True True nlCollapse str
+collapseWSStr _ wsCollapse nlCollapse str = collapseWSStr' False wsCollapse nlCollapse str
+collapseWSStr' a b c (d:ds) = let (trailing, ds') = collapseWSStr a b c ds in (trailing, d:ds')
+collapseWSStr' a _ _ [] = (a, [])