11 files changed, 280 insertions(+), 169 deletions(-)

M README.md
D Stylish/Parse.hs
D Stylish/Parse/Selector.hs
D Stylish/Parse/Utils.hs
R Stylish.hs => src/Stylish.hs
A src/Stylish/Parse.hs
A src/Stylish/Parse/Selector.hs
A src/Stylish/Parse/Utils.hs
R Stylish/Style.hs => src/Stylish/Style.hs
M stylish-haskell.cabal
A test/Test.hs

@@ 1,4 1,14 @@
 # Stylish Haskell
 Generic CSS style engine for Haskell, intended to aid the development of new browser engines.
 
-Stylish Haskell implements CSS selection and cascade (but not inheritance) independant of the CSS at-rules and properties understood by the caller.
+Stylish Haskell implements CSS selection and cascade (but not inheritance) independant of the CSS at-rules and properties understood by the caller. It is intended to ease the development of new browser engines, independant of their output targets.
+
+## Why Haskell?
+No matter what you think about Haskell and other functional languages, there are great reasons to choose it for this project.
+
+The primary reason is that the biggest challenge in implementing a CSS engine is in defining all the various CSS properties, and as such it needs to be trivial to define each individual property. Haskell's pattern matching syntax is perfect for this, and it's laziness is useful.
+
+Though beyond that Haskell makes just as trivial to assemble functions as it does datastructures, which comes in very handy for parsing and interpreting programming languages like CSS selectors.
+
+## API
+So far I've only implemented a CSS parser via the function `Stylish.Parse.parse` which returns a variant of the passed in `StyleSheet`. `StyleSheet` is a typeclass implementing the logic for parsing CSS atrules and storing style rules.

@@ 1,102 0,0 @@
-module Stylish.Parse (
-        parse,
-        skipAtRule,
-        StyleSheet, addRule, addAtRule,
-        StyleRule,
-        Selector(..), SimpleSelector(..), PropertyTest(..)
-    ) where
-
-import Data.CSS.Syntax.Tokens
-import Stylish.Parse.Selector
-import Parse.Utils
-
---------
----- Output type class
---------
-class StyleSheet s where
-    addRule :: s -> StyleRule -> s
-    addAtRule :: s -> Text -> [Token] -> (s, [Token])
-    addAtRule self _ tokens = (self, skipAtRule tokens)
-
-data StyleRule = StyleRule [Selector] [(Text, [Token])]
-
---------
----- Basic parsing
---------
-parse :: StyleSheet s => s -> Text -> s
-parse stylesheet source = parse' stylesheet tokenize source
-
--- Things to skip.
-parse' stylesheet Whitespace:tokens = parse' stylesheet tokens
-parse' stylesheet CDO:tokens = parse' stylesheet tokens
-parse' stylesheet CDC:tokens = parse' stylesheet tokens
-parse' stylesheet Comma:tokens = parse' stylesheet tokens -- TODO issue warnings.
-
-parse' stylesheet [] = stylesheet
-
-parse' stylesheet AtKeyword(kind):tokens = parse' stylesheet' tokens'
-    where (stylesheet', tokens') = addAtRule stylesheet kind tokens
-parse' stylesheet tokens = parse' addRule stylesheet StyleRule selectors properties tokens'
-    where (selectors, block) = parseSelectors tokens
-        (properties, tokens') = parseProperties block
-parse' stylesheet tokens = parse' (addRule stylesheet rule) tokens'
-    where (rule, tokens') = concatP (StyleRule) (parseSelector) (parseProperties)
-
---------
----- Property parsing
---------
-parseProperties LeftCurlyBracket:tokens = parseProperties' tokens
-parseProperties Whitespace:tokens = parseProperties tokens
-
-parseProperties' Whitespace:tokens = parseProperties' tokens
-parseProperties' (Ident name):tokens
-    | Colon:tokens' <- skipSpace tokens =
-        concatP (appendProp) (scanValue) (parseProperties') tokens'
-    where appendProp value tail = (name, value):tail
-parseProperties' RightCurlyBracket:tokens = [], tokens
-parseProperties' tokens = parseProperties' skipValue tokens
-
---------
----- Skipping/Scanning utilities
---------
-skipAtRule Semicolon:tokens = tokens
-skipAtRule LeftCurlyBracket:tokens = skipBlock tokens
-
-skipAtRule LeftParen:tokens = skipAtRule skipBlock tokens
-skipAtRule LeftSquareBracket:tokens = skipAtRule skipBlock tokens
--- To ensure parens are balanced, should already be handled.
-skipAtRule RightCurlyBracket:tokens = RightCurlyBracket:tokens
-skipAtRule RightParen:tokens = RightParen:tokens
-skipAtRule RightSquareBracket:tokens = RightSquareBracket:tokens
-
-skipAtRule _:tokens = skipAtRule tokens
-
-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
-scanInner tokens cb = concatP (++) (scanBlock) (cb)
--- To ensure parens are balanced, should already be handled.
-scanValue RightCurlyBracket:tokens = ([], RightCurlyBracket:tokens)
-scanValue RightParen:tokens = ([], RightParen:tokens)
-scanValue RightSquareBracket:tokens = ([], RightSquareBracket:tokens)
-
-scanValue tokens = capture scanValue tokens
-
-scanValue tokens = snd scanValue tokens
-
--- TODO assert closing tags are correct
---    But what should the error recovery be?
-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 RightSquareBracket:tokens = scanInner tokens scanBlock
-
-scanBlock tokens = capture scanBlock tokens
-
-skipBlock tokens = snd scanBlock tokens

@@ 1,49 0,0 @@
-module Stylish.Parse.Selector(
-        Selector(..), SimpleSelector(..), PropertyTest(..),
-        parseSelectors
-    ) where
-
-import Data.CSS.Syntax.Tokens
-import Utils
-
-data Selector = Selector [SimpleSelector]
-data SimpleSelector = Tag Text | Id Text | Class Text | Property Text PropertyTest |
-    Child | Descendant | Adjacent | Sibling
-data PropertyTest = Exists | Equals Text | Suffix Text | Prefix Text | Substring Text |
-    Include Text | Dash Text
-
-parseSelectors :: [Token] -> (Selector, [Token])
-parseSelectors tokens = concatP (:) (parseSelector) (parseSelectorsTail) skipSpace tokens
-parseSelectorsTail Comma:tokens = parseSelectors token
-parseSelectorsTail tokens = ([], tokens)
-
-parseSelector' op tokens = (op:selector, tokens')
-    where (selector, tokens') = parseSelector tokens
-
-parseSelector Ident tag:tokens = parseSelector' Tag tag tokens
-parseSelector Hash _ id:tokens = parseSelector' Id id tokens
-parseSelector Delim '.':Ident class_:tokens = parseSelector' Class class_ tokens
-parseSelector LeftSquareBracket:Ident prop:tokens =
-        concatP (appendPropertySel) (parsePropertySel) (parseSelector) tokens
-    where appendPropertySel test selector = (Property prop test):selector
-
-parseSelector Whitespace:tokens = parseCombinator skipSpace tokens
-parseSelector Delim c:tokens = parseCombinator Delim c:tokens
-parseSelector tokens = ([], tokens)
-
-parseCombinator Delim '>':tokens = parseSelector' Child skipSpace tokens
-parseCombinator Delim '~':tokens = parseSelector' Sibling skipSpace tokens
-parseCombinator Delim '+':tokens = parseSelector' Adjacent skipSpace tokens
-parseCombinator tokens = parseSelector' Descendant tokens
-
-parsePropertySel RightSquareBracket:tokens = (Exists, tokens)
-parsePropertySel Delim '=':tokens = parsePropertyVal (Equals) tokens
-parsePropertySel SuffixMatch:tokens = parsePropertyVal (Suffix) tokens
-parsePropertySel PrefixMatch:tokens = parsePropertyVal (Prefix) tokens
-parsePropertySel SubstringMatch:tokens = parsePropertyVal (Substring) tokens
-parsePropertySel IncludeMatch:tokens = parsePropertyVal (Include) tokens
-parsePropertySel DashMatch:tokens = parsePropertyVal (Dash) tokens
-parsePropertySel tokens = (Exists, skipBlock tokens)
-
-parsePropertyVal wrapper Ident val:RightSquareBracket:tokens = (wrapper val, tokens)
-parsePropertyVal wrapper String val:RightSquareBracket:tokens = (wrapper val, tokens)

@@ 1,15 0,0 @@
-module Stylish.Parse.Utils(
-        concatP, capture, skipSpace
-    ) where
-
-import Data.CSS.Syntax.Tokens
-
-concatP join left right tokens = (join x y, remainder)
-    where (x, tokens') = left tokens
-        (y, remainder) = right tokens'
-
-capture cb token:tokens = (token:captured, tokens')
-    where (captured, tokens') = cb tokens
-
-skipSpace Whitespace:tokens = skipSpace tokens
-skipSpace tokens = tokens

@@ 0,0 1,91 @@
+module Stylish.Parse (
+        parse, TrivialStyleSheet(..),
+        skipAtRule,
+        StyleSheet, addRule, addAtRule,
+        StyleRule(..),
+        Selector(..), SimpleSelector(..), PropertyTest(..)
+    ) where
+
+import Data.CSS.Syntax.Tokens
+import Stylish.Parse.Selector
+import Stylish.Parse.Utils
+
+import Data.Text.Internal (Text(..))
+
+--------
+---- Output type class
+--------
+class StyleSheet s where
+    addRule :: s -> StyleRule -> s
+    addAtRule :: s -> Text -> [Token] -> (s, [Token])
+    addAtRule self _ tokens = (self, skipAtRule tokens)
+
+data StyleRule = StyleRule [Selector] [(Text, [Token])] deriving (Show, Eq)
+
+data TrivialStyleSheet = TrivialStyleSheet [StyleRule] deriving (Show, Eq)
+instance StyleSheet TrivialStyleSheet where
+    addRule (TrivialStyleSheet self) rule = TrivialStyleSheet $ rule:self
+
+--------
+---- Basic parsing
+--------
+parse :: StyleSheet s => s -> Text -> s
+parse stylesheet source = parse' stylesheet $ tokenize source
+
+-- Things to skip.
+parse' stylesheet (Whitespace:tokens) = parse' stylesheet tokens
+parse' stylesheet (CDO:tokens) = parse' stylesheet tokens
+parse' stylesheet (CDC:tokens) = parse' stylesheet tokens
+parse' stylesheet (Comma:tokens) = parse' stylesheet tokens -- TODO issue warnings.
+
+parse' stylesheet [] = stylesheet
+
+parse' stylesheet (AtKeyword kind:tokens) = parse' stylesheet' tokens'
+    where (stylesheet', tokens') = addAtRule stylesheet kind tokens
+parse' stylesheet tokens = parse' (addRule stylesheet rule) tokens'
+    where (rule, tokens') = concatP StyleRule parseSelectors parseProperties tokens
+
+--------
+---- Property parsing
+--------
+parseProperties (LeftCurlyBracket:tokens) = parseProperties' tokens
+parseProperties (Whitespace:tokens) = parseProperties tokens
+
+parseProperties' (Whitespace:tokens) = parseProperties' tokens
+parseProperties' (Ident name:tokens)
+    | Colon:tokens' <- skipSpace tokens =
+        concatP appendProp scanValue parseProperties' tokens'
+    where appendProp value tail = (name, value):tail
+parseProperties' (RightCurlyBracket:tokens) = ([], tokens)
+parseProperties' tokens = parseProperties' (skipValue tokens)
+
+--------
+---- Skipping/Scanning utilities
+--------
+skipAtRule :: [Token] -> [Token]
+skipAtRule (Semicolon:tokens) = tokens
+skipAtRule (LeftCurlyBracket:tokens) = skipBlock tokens
+
+skipAtRule (LeftParen:tokens) = skipAtRule $ skipBlock tokens
+skipAtRule (LeftSquareBracket:tokens) = skipAtRule $ skipBlock tokens
+-- To ensure parens are balanced, should already be handled.
+skipAtRule (RightCurlyBracket:tokens) = RightCurlyBracket:tokens
+skipAtRule (RightParen:tokens) = RightParen:tokens
+skipAtRule (RightSquareBracket:tokens) = RightSquareBracket:tokens
+
+skipAtRule (_:tokens) = skipAtRule tokens
+
+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
+-- To ensure parens are balanced, should already be handled.
+scanValue (RightCurlyBracket:tokens) = ([], RightCurlyBracket:tokens)
+scanValue (RightParen:tokens) = ([], RightParen:tokens)
+scanValue (RightSquareBracket:tokens) = ([], RightSquareBracket:tokens)
+
+scanValue tokens = capture scanValue tokens
+
+skipValue tokens = snd $ scanValue tokens

@@ 0,0 1,63 @@
+module Stylish.Parse.Selector(
+        Selector(..), SimpleSelector(..), PropertyTest(..),
+        parseSelectors
+    ) where
+
+import Data.CSS.Syntax.Tokens
+import Stylish.Parse.Utils
+
+import Data.Text.Internal (Text(..))
+
+type Selector = [SimpleSelector]
+data SimpleSelector = Tag Text | Id Text | Class Text | Property Text PropertyTest |
+    Child | Descendant | Adjacent | Sibling
+    deriving (Show, Eq)
+data PropertyTest = Exists | Equals Text | Suffix Text | Prefix Text | Substring Text |
+    Include Text | Dash Text
+    deriving (Show, Eq)
+
+parseSelectors :: [Token] -> ([Selector], [Token])
+parseSelectors tokens = concatP (:) parseSelector parseSelectorsTail $ skipSpace tokens
+parseSelectorsTail (Comma:tokens) = parseSelectors tokens
+parseSelectorsTail tokens = ([], tokens)
+
+parseSelector' op tokens = (op:selector, tokens')
+    where (selector, tokens') = parseSelector tokens
+
+parseSelector :: [Token] -> (Selector, [Token])
+parseSelector (Delim '*':tokens) = parseSelector tokens
+parseSelector (Ident tag:tokens) = parseSelector' (Tag tag) tokens
+parseSelector (Hash _ id:tokens) = parseSelector' (Id id) tokens
+parseSelector (Delim '.':Ident class_:tokens) = parseSelector' (Class class_) tokens
+parseSelector (LeftSquareBracket:Ident prop:tokens) =
+        concatP appendPropertySel parsePropertySel parseSelector tokens
+    where appendPropertySel test selector = Property prop test : selector
+
+parseSelector (Whitespace:tokens) = parseCombinator $ skipSpace tokens
+parseSelector (Delim c:tokens) | c `elem` ">~+" = parseCombinator $ Delim c:tokens
+parseSelector tokens = ([], tokens)
+
+parseCombinator (Delim '>':tokens) = parseSelector' Child $ skipSpace tokens
+parseCombinator (Delim '~':tokens) = parseSelector' Sibling $ skipSpace tokens
+parseCombinator (Delim '+':tokens) = parseSelector' Adjacent $ skipSpace tokens
+-- Take special care to avoid adding a trailing Descendant when not needed.
+parseCombinator tokens@(LeftCurlyBracket:_) = ([], tokens)
+parseCombinator tokens@(RightCurlyBracket:_) = ([], tokens)
+parseCombinator tokens@(RightSquareBracket:_) = ([], tokens)
+parseCombinator tokens@(Comma:_) = ([], tokens)
+
+parseCombinator tokens@(RightParen:_) = ([], tokens)
+
+parseCombinator tokens = parseSelector' Descendant tokens
+
+parsePropertySel (RightSquareBracket:tokens) = (Exists, tokens)
+parsePropertySel (Delim '=':tokens) = parsePropertyVal (Equals) tokens
+parsePropertySel (SuffixMatch:tokens) = parsePropertyVal (Suffix) tokens
+parsePropertySel (PrefixMatch:tokens) = parsePropertyVal (Prefix) tokens
+parsePropertySel (SubstringMatch:tokens) = parsePropertyVal (Substring) tokens
+parsePropertySel (IncludeMatch:tokens) = parsePropertyVal (Include) tokens
+parsePropertySel (DashMatch:tokens) = parsePropertyVal (Dash) tokens
+parsePropertySel tokens = (Exists, skipBlock tokens)
+
+parsePropertyVal wrapper (Ident val:RightSquareBracket:tokens) = (wrapper val, tokens)
+parsePropertyVal wrapper (String val:RightSquareBracket:tokens) = (wrapper val, tokens)

@@ 0,0 1,34 @@
+module Stylish.Parse.Utils(
+        concatP, capture, skipSpace,
+        scanBlock, skipBlock, scanInner
+    ) where
+
+import Data.CSS.Syntax.Tokens
+
+concatP join left right tokens = (join x y, remainder)
+    where
+        (x, tokens') = left tokens
+        (y, remainder) = right tokens'
+
+capture cb (token:tokens) = (token:captured, tokens')
+   where (captured, tokens') = cb tokens
+capture _ [] = ([], [])
+
+skipSpace (Whitespace:tokens) = skipSpace tokens
+skipSpace tokens = tokens
+
+-- TODO assert closing tags are correct
+--    But what should the error recovery be?
+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 = capture scanBlock tokens
+
+skipBlock tokens = snd $ scanBlock tokens
+
+scanInner tokens cb = concatP (++) scanBlock cb tokens

@@ 57,11 57,18 @@ library
   -- other-extensions:    
   
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.9 && <4.10, css-syntax
+  build-depends:       base >=4.9 && <4.10, css-syntax, text
   
   -- Directories containing source files.
-  -- hs-source-dirs:      
+  hs-source-dirs:      src
   
   -- Base language which the package is written in.
   default-language:    Haskell2010
   
+test-suite test-stylish
+  hs-source-dirs:       src test
+  default-language:     Haskell2010
+  type:     exitcode-stdio-1.0
+  main-is:              Test.hs
+  other-modules:        Stylish.Parse
+  build-depends:       base >=4.9 && <4.10, css-syntax, text, hspec, QuickCheck

@@ 0,0 1,72 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Stylish.Parse
+import Data.CSS.Syntax.Tokens
+
+main = hspec spec
+
+spec = do
+    describe "Canary" $ do
+        it "Test framework works" $ do
+            True `shouldBe` True
+    describe "Parsing" $ do
+        it "Ignores @rules" $ do
+            parse emptyStyle "@encoding 'utf-8';" `shouldBe` emptyStyle
+            parse emptyStyle "  @encoding 'utf-8';" `shouldBe` emptyStyle
+            parse emptyStyle "@encoding 'utf-8';  " `shouldBe` emptyStyle
+            parse emptyStyle "@media print { a:link {color: green;} }" `shouldBe` emptyStyle
+            parse emptyStyle "  @media print { a:link {color: green;} }" `shouldBe` emptyStyle
+            parse emptyStyle "@media print { a:link {color: green;} }  " `shouldBe` emptyStyle
+
+            parse emptyStyle "@encoding 'utf-8'; a {color:green}" `shouldBe` linkStyle
+            parse emptyStyle "a {color:green}@encoding 'utf-8';" `shouldBe` linkStyle
+            parse emptyStyle "@media print{a{color:black;}}a {color:green}" `shouldBe` linkStyle
+            parse emptyStyle "a {color:green} @media print {a{color:black;}}" `shouldBe` linkStyle
+        it "Parses style rules" $ do
+            -- Syntax examples from "Head First HTML & CSS with XHTML"
+            parse emptyStyle "bedroom { drapes: blue; carpet: wool shag; }" `shouldBe` TrivialStyleSheet [
+                StyleRule [[Tag "bedroom"]] [
+                    ("drapes", [Ident "blue"]),
+                    ("carpet", [Ident "wool", Ident "shag"])
+                ]]
+            parse emptyStyle "  bathroom{tile :1in white;drapes :pink}" `shouldBe` TrivialStyleSheet [
+                StyleRule [[Tag "bathroom"]] [
+                    ("tile", [Dimension "1" (NVInteger 1) "in", Ident "white"]),
+                    ("drapes", [Ident "pink"])
+                ]]
+        it "Parses selectors" $ do
+            parse emptyStyle ".class {}" `shouldBe` TrivialStyleSheet [
+                    StyleRule [[Class "class"]] []
+                ]
+            parse emptyStyle "*.class {}" `shouldBe` TrivialStyleSheet [
+                    StyleRule [[Class "class"]] []
+                ]
+            parse emptyStyle "#id {}" `shouldBe` TrivialStyleSheet [
+                    StyleRule [[Id "id"]] []
+                ]
+            parse emptyStyle "[attr] {}" `shouldBe` TrivialStyleSheet [
+                    StyleRule [[Property "attr" Exists]] []
+                ]
+            parse emptyStyle "a , b {}" `shouldBe` TrivialStyleSheet [
+                    StyleRule [[Tag "a"], [Tag "b"]] []
+                ]
+            parse emptyStyle "a b {}" `shouldBe` TrivialStyleSheet [
+                    StyleRule [[Tag "a", Descendant, Tag "b"]] []
+                ]
+            parse emptyStyle "a > b {}" `shouldBe` TrivialStyleSheet [
+                    StyleRule [[Tag "a", Child, Tag "b"]] []
+                ]
+            parse emptyStyle "a ~ b {}" `shouldBe` TrivialStyleSheet [
+                    StyleRule [[Tag "a", Sibling, Tag "b"]] []
+                ]
+            parse emptyStyle "a + b {}" `shouldBe` TrivialStyleSheet [
+                    StyleRule [[Tag "a", Adjacent, Tag "b"]] []
+                ]
+
+emptyStyle = TrivialStyleSheet []
+linkStyle = TrivialStyleSheet [
+        StyleRule [[Tag "a"]] [("color", [Ident "green"])]
+    ]