~alcinnz/haskell-stylist

9e14bcfe44ee71d1aa76548c9e04c7d91039218e — Adrian Cochrane 4 years ago 70713fc
Parse CSS counters.
2 files changed, 65 insertions(+), 1 deletions(-)

A src/Data/CSS/Preprocessor/Text.hs
M stylist.cabal
A src/Data/CSS/Preprocessor/Text.hs => src/Data/CSS/Preprocessor/Text.hs +64 -0
@@ 0,0 1,64 @@
{-# LANGUAGE OverloadedStrings #-}
-- | Lowers certain CSS properties to plain text.
module Data.CSS.Preprocessor.Text(TextStyle, resolve) where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.CSS.Style (PropertyParser(..))
import Data.Text
import Data.Maybe (fromMaybe)

-- | `PropertyParser` decorator that parses & lowers certain CSS properties to plain text.
data TextStyle p = TextStyle {
    inner :: p,
    content :: [Token],

    counterReset :: [(Text, Integer)],
    counterIncrement :: [(Text, Integer)],
    counterSet :: [(Text, Integer)]
}

instance PropertyParser p => PropertyParser (TextStyle p) where
    temp = TextStyle {
            inner = temp,
            content = [],
            counterReset = [],
            counterIncrement = [],
            counterSet = []
        }
    inherit parent = TextStyle {
            inner = inherit $ inner parent,
            content = [],
            counterReset = [],
            counterIncrement = [],
            counterSet = []
        }

    shorthand self "content" value = shorthand (inner self) "content" $ removeCounters value
    shorthand _ key value
        | key `elem` ["counter-reset", "counter-increment", "counter-set"],
            Just _ <- parseCounters 0 value = [(key, value)]
    shorthand self key value = shorthand (inner self) key value

    longhand _ self "content" value = Just $ self {content = value}
    longhand _ self "counter-reset" value = (\v -> self {counterReset = v}) <$> parseCounters 0 value
    longhand _ self "counter-increment" value = (\v -> self {counterIncrement = v}) <$> parseCounters 1 value
    longhand _ self "counter-set" value = (\v -> self {counterSet = v}) <$> parseCounters 0 value
    longhand parent self key value = (\v -> self {inner = v}) <$> longhand (inner parent ) (inner self) key value

removeCounters :: [Token] -> [Token]
removeCounters (Function "counter":Ident _:RightParen:toks) = String "" : removeCounters toks
removeCounters (Function "counters":Ident _:Comma:String _:toks) = String "" : removeCounters toks
removeCounters (tok:toks) = tok : removeCounters toks
removeCounters [] = []

parseCounters :: Integer -> [Token] -> Maybe [(Text, Integer)]
parseCounters _ [Ident "none"] = Just []
parseCounters _ [] = Just []
parseCounters x (Ident counter : Number _ (NVInteger count') : toks) =
    (:) (counter, count') <$> parseCounters x toks
parseCounters x (Ident counter : toks) = (:) (counter, x) <$> parseCounters x toks
parseCounters _ _ = Nothing

resolve :: PropertyParser p => TextStyle p -> p
resolve TextStyle {inner = inner', content = content'} =
    fromMaybe inner' $ longhand temp inner' "content" content'

M stylist.cabal => stylist.cabal +1 -1
@@ 56,7 56,7 @@ library
  exposed-modules:     Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector,
                       Data.CSS.Style,
                       Data.CSS.Preprocessor.Conditions, Data.CSS.Preprocessor.Conditions.Expr,
                       Data.CSS.Preprocessor.Assets
                       Data.CSS.Preprocessor.Assets, Data.CSS.Preprocessor.Text
  
  -- Modules included in this library but not exported.
  other-modules:       Data.CSS.Syntax.StylishUtil,