4 files changed, 35 insertions(+), 9 deletions(-)

M src/Data/CSS/Style/Selector/Index.hs
M src/Data/CSS/Syntax/Selector.hs
M src/Data/CSS/Syntax/StylishUtil.hs
M stylish-haskell.cabal

@@ 35,18 35,21 @@ rulesForElement self element = Prelude.map inner $ lookupRules self element
 
 ---
 
+simpleSelector :: Selector -> [SimpleSelector]
 simpleSelector (Element s) = s
 simpleSelector (Child _ s) = s
 simpleSelector (Descendant _ s) = s
 simpleSelector (Adjacent _ s) = s
 simpleSelector (Sibling _ s) = s
 
-addRuleForSelector self@(StyleIndex index _) rule selector
-  | Just key <- selectorKey selector = self {
+addRuleForSelector :: StyleIndex -> StyleRule' -> [SimpleSelector] -> StyleIndex
+addRuleForSelector self@(StyleIndex index _) rule sel
+  | Just key <- selectorKey sel = self {
         indexed = insert key (rule : lookup' key index) index
     }
   | otherwise = self {unindexed = rule : unindexed self}
 
+selectorKey :: [SimpleSelector] -> Maybe SimpleSelector
 selectorKey (tok@(Tag _) : _) = Just tok
 selectorKey (tok@(Id _) : _) = Just tok
 selectorKey (tok@(Class _) : _) = Just tok


@@ 56,6 59,7 @@ selectorKey [] = Nothing
 
 ----
 
+testsForAttributes :: [Attribute] -> [SimpleSelector]
 testsForElement :: Element -> [SimpleSelector]
 testsForElement element =
     (Tag $ name element) : (testsForAttributes $ attributes element)


@@ 65,14 69,14 @@ testsForAttributes (Attribute "class" value:attrs) =
 testsForAttributes (Attribute "id" value:attrs) =
     (Prelude.map (\s -> Id $ pack s) $ words value) ++
         (Property "id" Exists : testsForAttributes attrs)
-testsForAttributes (Attribute name _:attrs) =
-    Property name Exists : testsForAttributes attrs
+testsForAttributes (Attribute elName _:attrs) =
+    Property elName Exists : testsForAttributes attrs
 testsForAttributes [] = []
 
 -- Implement hashable for SimpleSelector here because it proved challenging to automatically derive it.
 instance Hashable SimpleSelector where
     hashWithSalt seed (Tag tag) = seed `hashWithSalt` (0::Int) `hashWithSalt` unpack tag
-    hashWithSalt seed (Id id) = seed `hashWithSalt` (1::Int) `hashWithSalt` unpack id
+    hashWithSalt seed (Id i) = seed `hashWithSalt` (1::Int) `hashWithSalt` unpack i
     hashWithSalt seed (Class class_) = seed `hashWithSalt` (2::Int) `hashWithSalt` unpack class_
     hashWithSalt seed (Property prop test) =
         seed `hashWithSalt` (3::Int) `hashWithSalt` unpack prop `hashWithSalt` test

@@ 19,31 19,39 @@ data PropertyTest = Exists | Equals Text | Suffix Text | Prefix Text | Substring
     Include Text | Dash Text
     deriving (Show, Eq)
 
-parseSelectors :: [Token] -> ([Selector], [Token])
+parseSelectors :: Parser [Selector]
 parseSelectors tokens = concatP (:) parseCompound parseSelectorsTail $ skipSpace tokens
+parseSelectorsTail :: Parser [Selector]
 parseSelectorsTail (Comma:tokens) = parseSelectors tokens
 parseSelectorsTail tokens = ([], tokens)
+parseCompound :: Parser Selector
 parseCompound tokens = parseCombinators (Element selector) tokens'
     where (selector, tokens') = parseSelector tokens
 
+parseSelector' :: SimpleSelector -> Parser [SimpleSelector]
 parseSelector' op tokens = (op:selector, tokens')
     where (selector, tokens') = parseSelector tokens
 
+parseSelector :: Parser [SimpleSelector]
 parseSelector (Delim '*':tokens) = parseSelector tokens
 parseSelector (Ident tag:tokens) = parseSelector' (Tag tag) tokens
-parseSelector (Hash _ id:tokens) = parseSelector' (Id id) tokens
+parseSelector (Hash _ i:tokens) = parseSelector' (Id i) 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 tokens = ([], tokens)
 
+parseCombinators' :: Selector -> Parser Selector
 parseCombinators' selector tokens = parseCombinators selector' tokens'
     where (selector', tokens') = parseCombinator selector tokens
+parseCombinators :: Selector -> Parser Selector
 parseCombinators selector (Whitespace:tokens) = parseCombinators' selector tokens
-parseCombinators selector tokens@(Delim c:_) = parseCombinators' selector tokens
+parseCombinators selector tokens@(Delim _:_) = parseCombinators' selector tokens
 parseCombinators selector tokens = (selector, tokens)
 
+parseCombinator' :: (Selector -> [SimpleSelector] -> Selector)
+                    -> Selector -> Parser Selector
 parseCombinator' cb selector tokens = (cb selector selector', tokens')
     where (selector', tokens') = parseSelector $ skipSpace tokens
 parseCombinator :: Selector -> [Token] -> (Selector, [Token])


@@ 62,6 70,7 @@ parseCombinator selector [] = (selector, [])
 
 parseCombinator selector tokens = parseCombinator' Descendant selector tokens
 
+parsePropertySel :: Parser PropertyTest
 parsePropertySel (RightSquareBracket:tokens) = (Exists, tokens)
 parsePropertySel (Delim '=':tokens) = parsePropertyVal (Equals) tokens
 parsePropertySel (SuffixMatch:tokens) = parsePropertyVal (Suffix) tokens


@@ 71,5 80,7 @@ parsePropertySel (IncludeMatch:tokens) = parsePropertyVal (Include) tokens
 parsePropertySel (DashMatch:tokens) = parsePropertyVal (Dash) tokens
 parsePropertySel tokens = (Exists, skipBlock tokens)
 
+parsePropertyVal :: (Text -> PropertyTest) -> Parser PropertyTest
 parsePropertyVal wrapper (Ident val:RightSquareBracket:tokens) = (wrapper val, tokens)
 parsePropertyVal wrapper (String val:RightSquareBracket:tokens) = (wrapper val, tokens)
+parsePropertyVal _ tokens = (Exists, skipBlock tokens)

@@ 1,22 1,28 @@
 module Data.CSS.Syntax.StylishUtil(
         concatP, capture, skipSpace,
-        scanBlock, skipBlock, scanInner
+        scanBlock, skipBlock, scanInner,
+        Parser
     ) where
 
 import Data.CSS.Syntax.Tokens
 
+type Parser x = [Token] -> (x, [Token])
+concatP :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
 concatP join left right tokens = (join x y, remainder)
     where
         (x, tokens') = left tokens
         (y, remainder) = right tokens'
 
+capture :: Parser [Token] -> Parser [Token]
 capture cb (token:tokens) = (token:captured, tokens')
    where (captured, tokens') = cb tokens
 capture _ [] = ([], [])
 
+skipSpace :: [Token] -> [Token]
 skipSpace (Whitespace:tokens) = skipSpace tokens
 skipSpace tokens = tokens
 
+scanBlock :: Parser [Token]
 -- TODO assert closing tags are correct
 --    But what should the error recovery be?
 scanBlock (RightCurlyBracket:tokens) = ([RightCurlyBracket], tokens)


@@ 30,8 36,10 @@ scanBlock tokens@(LeftSquareBracket:_) = scanInner tokens scanBlock
 
 scanBlock tokens = capture scanBlock tokens
 
+skipBlock :: [Token] -> [Token]
 skipBlock tokens = snd $ scanBlock tokens
 
+scanInner :: [Token] -> Parser [Token] -> ([Token], [Token])
 scanInner (token:tokens) cb = concatP gather scanBlock cb tokens
     where gather x y = token : x ++ y
 scanInner [] _ = error "Expected a token to capture."

@@ 66,6 66,8 @@ library
   
   -- Base language which the package is written in.
   default-language:    Haskell2010
+
+  ghc-options: -Wall
   
 test-suite test-stylish
   hs-source-dirs:       src test


@@ 74,3 76,4 @@ test-suite test-stylish
   main-is:              Test.hs
   other-modules:        Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector, Data.CSS.Style
   build-depends:       base >=4.9 && <4.10, css-syntax, text, unordered-containers, hashable, hspec, QuickCheck
+  ghc-options: -Wall