css-selectors 0.2.1.0 → 0.3.0.0
raw patch · 5 files changed
+201/−14 lines, 5 filesdep +binarydep +bytestringdep +zlib
Dependencies added: binary, bytestring, zlib
Files
- CHANGELOG.md +6/−0
- README.md +6/−0
- css-selectors.cabal +5/−1
- src/Css3/Selector/Core.hs +134/−0
- test/Spec.hs +50/−13
CHANGELOG.md view
@@ -2,6 +2,12 @@ For a full list of changes, see the history on [GitHub](https://github.com/hapytex/css-selectors). +## Version 0.3.0.0++The css items are now an instance of `Binary` and can be serialized and deserialized; and compressed. One+can use this to store the css selector to a file. The format is *not* a standardized one: it is just defined+to store the selector effectively.+ ## Version 0.2.1.0 Move from modules from `Css.*` to `Css3.*`, and implementations of `shrink` for the css selectors data types.
README.md view
@@ -129,6 +129,12 @@ is often useful, since javascript itself has no syntax for css selectors, and often strings are used to represent these. +## `Binary` instances++The css-elements are all a member of the `Binary` typeclass, that converts the+css selector to a compact binary format. This is *not* standard format. This is+more to write a css-selector to a binary format and back.+ ## `Arbitrary` css selectors One can generate arbitrary CSS selectors (and their subcomponents). It is
css-selectors.cabal view
@@ -1,5 +1,5 @@ name: css-selectors-version: 0.2.1.0+version: 0.3.0.0 synopsis: Parsing, rendering and manipulating css selectors in Haskell. description: A library for parsing, manipulating, and rendering css selectors (not css files,@@ -43,13 +43,16 @@ base >=4.7 && <5 , aeson >=1.0 && <2 , array >=0.5.3.0 && <0.5.4.0+ , binary >=0.2 && <0.8.8.0 , blaze-markup >=0.8 && <0.9+ , bytestring >=0.9 , data-default >=0.7 && <0.8 , Decimal >=0.5.1 && <0.5.2 , QuickCheck >=2.13 && <2.14 , shakespeare >=2.0 && <3.0 , template-haskell >=2.12.0 && <2.16.0 , text >=1.1 && <1.3+ , zlib >=0.5 build-tools: alex , happy@@ -61,6 +64,7 @@ main-is: Spec.hs build-depends: base+ , binary >=0.2 && <0.8.8.0 , css-selectors , text , test-framework
src/Css3/Selector/Core.hs view
@@ -34,15 +34,21 @@ , Hash(..), (.#) -- * Specificity , SelectorSpecificity(..), specificity, specificityValue+ -- * Read and write binary content+ , encode, decode, compressEncode, compressEncodeWith, decompressDecode ) where -- based on https://www.w3.org/TR/2018/REC-selectors-3-20181106/#w3cselgrammar +import Codec.Compression.GZip(CompressParams, compress, compressWith, decompress)+ import Control.Applicative(liftA2) import Css3.Selector.Utils(encodeIdentifier, encodeText, toIdentifier) import Data.Aeson(Value(String), ToJSON(toJSON))+import Data.Binary(Binary(put, get), Get, Put, decode, encode, getWord8, putWord8)+import Data.ByteString.Lazy(ByteString) import Data.Data(Data) import Data.Default(Default(def)) import Data.Function(on)@@ -109,6 +115,32 @@ normalize = id {-# MINIMAL toCssSelector, toSelectorGroup, specificity', toPattern #-} +-- | Convert the given item to a compressed 'ByteString'. This can be used to write to and read from a file for example.+-- The econding format is not an official format: it is constructed based on the structure of the Haskell types. That+-- stream is then passed through a gzip implementation.+compressEncode :: (Binary a, ToCssSelector a)+ => a -- ^ The object to turn into a compressed 'ByteString'.+ -> ByteString -- ^ A compressed binary representation of the given object.+compressEncode = compress . encode++-- | Convert the given item to a compressed 'ByteString'. This can be used to write to and read from a file for example.+-- The econding format is not an official format: it is constructed based on the structure of the Haskell types. That+-- stream is then passed through a gzip implementation.+compressEncodeWith :: (Binary a, ToCssSelector a)+ => CompressParams -- ^ The parameters that determine how to compress the 'ByteString'.+ -> a -- ^ The object to turn into a compressed 'ByteString'.+ -> ByteString -- ^ A compressed binary representation of the given object.+compressEncodeWith level = compressWith level . encode++-- | Convert the given item to a compressed 'ByteString'. This can be used to write to and read from a file for example.+-- The econding format is not an official format: it is constructed based on the structure of the Haskell types. That+-- stream is then passed through a gzip implementation.+decompressDecode :: (Binary a, ToCssSelector a)+ => ByteString -- ^ A compressed binary representation of a 'ToCssSelector' type.+ -> a -- ^ The corresponding decompressed and decoded logic.+decompressDecode = decode . decompress++ -- | Calculate the specificity of a 'ToCssSelector' type object. This is done by -- calculating the 'SelectorSpecificity' object, and then calculating the value -- of that object.@@ -573,6 +605,108 @@ instance Default AttributeCombinator where def = Exact++-- Binary instance+_putEnum :: Enum a => a -> Put+_putEnum = putWord8 . fromIntegral . fromEnum++_getEnum :: Enum a => Get a+_getEnum = toEnum . fromIntegral <$> getWord8++instance Binary SelectorSpecificity where+ put (SelectorSpecificity a b c) = put a >> put b >> put c+ get = SelectorSpecificity <$> get <*> get <*> get++instance Binary Selector where+ put (Selector c) = putWord8 0 >> put c+ put (Combined c sc cs) = putWord8 1 >> put c >> put sc >> put cs+ get = do+ w <- getWord8+ case w of+ 0 -> Selector <$> get+ 1 -> Combined <$> get <*> get <*> get+ _ -> fail "An error occured while deserializing a Selector object"++instance Binary SelectorCombinator where+ put = _putEnum+ get = _getEnum++instance Binary SelectorSequence where+ put (SimpleSelector ts) = putWord8 0 >> put ts+ put (Filter ss sf) = putWord8 1 >> put ss >> put sf+ get = do+ w <- getWord8+ case w of+ 0 -> SimpleSelector <$> get+ 1 -> Filter <$> get <*> get+ _ -> fail "An error occured while deserializing a Selector object."++instance Binary SelectorFilter where+ put (SHash h) = putWord8 0 >> put h+ put (SClass c) = putWord8 1 >> put c+ put (SAttrib a) = putWord8 2 >> put a+ get = do+ w <- getWord8+ case w of+ 0 -> SHash <$> get+ 1 -> SClass <$> get+ 2 -> SAttrib <$> get+ _ -> fail "An error occurred when deserializing a SelectorFilter object."++instance Binary Attrib where+ put (Exist e) = putWord8 0 >> put e+ put (Attrib an ac av) = putWord8 1 >> put an >> put ac >> put av+ get = do+ w <- getWord8+ case w of+ 0 -> Exist <$> get+ 1 -> Attrib <$> get <*> get <*> get+ _ -> fail "An error occured when deserializing an Attrib object."++instance Binary Namespace where+ put NAny = putWord8 0+ put (Namespace t) = putWord8 1 >> put t+ get = do+ w <- getWord8+ case w of+ 0 -> pure NAny+ 1 -> Namespace <$> get+ _ -> fail "An error occurred when deserializing a Namespace object."++instance Binary ElementName where+ put EAny = putWord8 0+ put (ElementName t) = putWord8 1 >> put t+ get = do+ w <- getWord8+ case w of+ 0 -> pure EAny+ 1 -> ElementName <$> get+ _ -> fail "An error occurred when deserializing an ElementName."++instance Binary TypeSelector where+ put (TypeSelector ns en) = put ns >> put en+ get = TypeSelector <$> get <*> get++instance Binary AttributeName where+ put (AttributeName ns n) = put ns >> put n+ get = AttributeName <$> get <*> get++instance Binary AttributeCombinator where+ put = _putEnum+ get = _getEnum++instance Binary Hash where+ put (Hash h) = put h+ get = Hash <$> get++instance Binary Class where+ put (Class h) = put h+ get = Class <$> get++instance Binary SelectorGroup where+ put (SelectorGroup g) = put g+ get = SelectorGroup <$> get+ -- Lift instances _apply :: Name -> [Q Exp] -> Q Exp
test/Spec.hs view
@@ -1,6 +1,10 @@-import Css.Selector-import Css.Selector.Utils(encodeString, readCssString)+{-# LANGUAGE TypeApplications #-} +import Css3.Selector+import Css3.Selector.Utils(encodeString, readCssString)++import Data.Binary(Binary, encode, decode)+import Data.Function(on) import Data.Text(pack, unpack) import Test.Framework (defaultMain, testGroup)@@ -18,17 +22,17 @@ ], testGroup "Arbitrary css parsing" [ testProperty "Encode-decode css identity" encodeDecodeCss,- testProperty "Encode-decode css identity: selector group" (encodeDecodeCss' :: SelectorGroup -> Bool),- testProperty "Encode-decode css identity: selector" (encodeDecodeCss' :: Selector -> Bool),- testProperty "Encode-decode css identity: selector sequence" (encodeDecodeCss' :: SelectorSequence -> Bool),- testProperty "Encode-decode css identity: selector filter" (encodeDecodeCss' :: SelectorFilter -> Bool),- testProperty "Encode-decode css identity: namespace" (encodeDecodeCss' :: Namespace -> Bool),- testProperty "Encode-decode css identity: element name" (encodeDecodeCss' :: ElementName -> Bool),- testProperty "Encode-decode css identity: type selector" (encodeDecodeCss' :: TypeSelector -> Bool),- testProperty "Encode-decode css identity: attribute" (encodeDecodeCss' :: Attrib -> Bool),- testProperty "Encode-decode css identity: attribute name" (encodeDecodeCss' :: AttributeName -> Bool),- testProperty "Encode-decode css identity: class" (encodeDecodeCss' :: Class -> Bool),- testProperty "Encode-decode css identity: hash" (encodeDecodeCss' :: Hash -> Bool)+ testProperty "Encode-decode css identity: selector group" (encodeDecodeCss' @SelectorGroup),+ testProperty "Encode-decode css identity: selector" (encodeDecodeCss' @Selector),+ testProperty "Encode-decode css identity: selector sequence" (encodeDecodeCss' @SelectorSequence),+ testProperty "Encode-decode css identity: selector filter" (encodeDecodeCss' @SelectorFilter),+ testProperty "Encode-decode css identity: namespace" (encodeDecodeCss' @Namespace),+ testProperty "Encode-decode css identity: element name" (encodeDecodeCss' @ElementName),+ testProperty "Encode-decode css identity: type selector" (encodeDecodeCss' @TypeSelector),+ testProperty "Encode-decode css identity: attribute" (encodeDecodeCss' @Attrib),+ testProperty "Encode-decode css identity: attribute name" (encodeDecodeCss' @AttributeName),+ testProperty "Encode-decode css identity: class" (encodeDecodeCss' @Class),+ testProperty "Encode-decode css identity: hash" (encodeDecodeCss' @Hash) ], testGroup "SelectorSequences" [ testProperty "Adding and removing filters" addRemFilters@@ -40,7 +44,34 @@ testGroup "Build an expression or pattern" [ testProperty "Check build of pattern 1" buildPattern1, testProperty "Check build of pattern 2" buildPattern2+ ],+ testGroup "Convert to binary and back" [+ testProperty "Binary identity: selector group" (binaryEquivalent @SelectorGroup),+ testProperty "Binary identity: selector" (binaryEquivalent @Selector),+ testProperty "Binary identity: selector sequence" (binaryEquivalent @SelectorSequence),+ testProperty "Binary identity: selector filter" (binaryEquivalent @SelectorFilter),+ testProperty "Binary identity: namespace" (binaryEquivalent @Namespace),+ testProperty "Binary identity: element name" (binaryEquivalent @ElementName),+ testProperty "Binary identity: type selector" (binaryEquivalent @TypeSelector),+ testProperty "Binary identity: attribute" (binaryEquivalent @Attrib),+ testProperty "Binary identity: attribute name" (binaryEquivalent @AttributeName),+ testProperty "Binary identity: class" (binaryEquivalent @Class),+ testProperty "Binary identity: hash" (binaryEquivalent @Hash)+ ],+ testGroup "Check binary equality" [+ testProperty "Binary uniqness: selector group" (uniqnessEncoding @SelectorGroup),+ testProperty "Binary uniqness: selector" (uniqnessEncoding @Selector),+ testProperty "Binary uniqness: selector sequence" (uniqnessEncoding @SelectorSequence),+ testProperty "Binary uniqness: selector filter" (uniqnessEncoding @SelectorFilter),+ testProperty "Binary uniqness: namespace" (uniqnessEncoding @Namespace),+ testProperty "Binary uniqness: element name" (uniqnessEncoding @ElementName),+ testProperty "Binary uniqness: type selector" (uniqnessEncoding @TypeSelector),+ testProperty "Binary uniqness: attribute" (uniqnessEncoding @Attrib),+ testProperty "Binary uniqness: attribute name" (uniqnessEncoding @AttributeName),+ testProperty "Binary uniqness: class" (uniqnessEncoding @Class),+ testProperty "Binary uniqness: hash" (uniqnessEncoding @Hash) ]+ ] encodeDecode :: Char -> String -> Bool@@ -51,6 +82,12 @@ encodeDecodeCss :: SelectorGroup -> Bool encodeDecodeCss sg = sg == (parseCss . unpack . toCssSelector) sg++binaryEquivalent :: (Binary a, Eq a, ToCssSelector a) => a -> Bool+binaryEquivalent x = decode (encode x) == x++uniqnessEncoding :: (Binary a, Eq a, ToCssSelector a) => a -> a -> Bool+uniqnessEncoding ca cb = (encode ca == encode cb) == (ca == cb) encodeDecodeCss' :: ToCssSelector a => a -> Bool encodeDecodeCss' sg = (parseCss . unpack . toCssSelector . toSelectorGroup) sg == toSelectorGroup sg