From b26bb3d190dcd3f81b5acc6c288afc3645dc1420 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Tue, 11 Jun 2019 19:29:49 +1200 Subject: [PATCH] Implement basic parser. TODO test. --- Stylish.hs | 8 +++ Stylish/Parse.hs | 102 ++++++++++++++++++++++++++++++++++++++ Stylish/Parse/Selector.hs | 49 ++++++++++++++++++ Stylish/Parse/Utils.hs | 15 ++++++ Stylish/Select.hs | 18 ------- Stylish/Style.hs | 25 ++++++++++ stylish-haskell.cabal | 4 +- 7 files changed, 201 insertions(+), 20 deletions(-) create mode 100644 Stylish.hs create mode 100644 Stylish/Parse.hs create mode 100644 Stylish/Parse/Selector.hs create mode 100644 Stylish/Parse/Utils.hs delete mode 100644 Stylish/Select.hs create mode 100644 Stylish/Style.hs diff --git a/Stylish.hs b/Stylish.hs new file mode 100644 index 0000000..890df1d --- /dev/null +++ b/Stylish.hs @@ -0,0 +1,8 @@ +module Stylish( + parse, + StyleSheet, addRule, addAtRule, + StyleRule, + Selector, Combinator, SimpleSelector, AttrTest + ) where + +import Stylish.Parse diff --git a/Stylish/Parse.hs b/Stylish/Parse.hs new file mode 100644 index 0000000..ea84a6c --- /dev/null +++ b/Stylish/Parse.hs @@ -0,0 +1,102 @@ +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 diff --git a/Stylish/Parse/Selector.hs b/Stylish/Parse/Selector.hs new file mode 100644 index 0000000..fd6ad6b --- /dev/null +++ b/Stylish/Parse/Selector.hs @@ -0,0 +1,49 @@ +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) diff --git a/Stylish/Parse/Utils.hs b/Stylish/Parse/Utils.hs new file mode 100644 index 0000000..fbeeeb7 --- /dev/null +++ b/Stylish/Parse/Utils.hs @@ -0,0 +1,15 @@ +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 diff --git a/Stylish/Select.hs b/Stylish/Select.hs deleted file mode 100644 index f6bd2e8..0000000 --- a/Stylish/Select.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Stylish.Select( - DocumentNode(..), - DocumentAttribute(..) - ) where - -data DocumentNode = DocumentNode { - parent :: DocumentNode, - prev :: DocumentNode, - name :: Text, - namespace :: Text, - attributes :: [DocumentAttribute] -- Sorted alphabetically by name. -} - -data DocumentAttribute = DocumentAttribute { - name :: Text, --- namespace :: Text, -- TODO - value :: Text -} diff --git a/Stylish/Style.hs b/Stylish/Style.hs new file mode 100644 index 0000000..a428813 --- /dev/null +++ b/Stylish/Style.hs @@ -0,0 +1,25 @@ +module Stylish.Style( + style, + Style(..), + Element(..), + Attribute(..), + ) where + +style :: Style a => Stylist a -> Element -> a +-- Stylist consists of internal types, implements StyleSheet. + +class Style s where + initial :: s + shorthand :: Text -> [Token] -> [(Text, [Token])] + shorthand name value + | Just _ <- longhand initial initial name value = (name, value) + | otherwise = [] + longhand :: s -> s -> Text -> [Token] -> Maybe s + +data Element = Element { + prev :: Maybe Element, + parent :: Maybe Element, + name :: Text, + attrs :: [Attribute] +} +data Attribute = Attr Text Text diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 6175a45..6f19542 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -48,7 +48,7 @@ cabal-version: >=1.10 library -- Modules exported by the library. - -- exposed-modules: Stylish.Select + -- exposed-modules: Stylish.Parse -- Modules included in this library but not exported. -- other-modules: @@ -57,7 +57,7 @@ library -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base >=4.9 && <4.10 + build-depends: base >=4.9 && <4.10, css-syntax -- Directories containing source files. -- hs-source-dirs: -- 2.30.2